program Mining Uses Gumps const IngotsStorage 4009FE36 IngotsType 1BF2

Anonymous
Text only
18 Jan 2015
program Mining;
Uses Gumps;

const
IngotsStorage=$4009FE36;
IngotsType=$1BF2;

HomeRuneBook=$4012B09A;
HomeRuneIndex=3;
RuneBookShift=5;

MiningType=$0F39;

TinkerType=$1EB8;
TKNumFirst=8;
TKNumSecond=23;

TKMinerNumFirst=8;
TKMinerNumSecond=72;

IronColor=$0000;
IronCount=$40;

WaitTime=500;
RecalTime=2000;
WaitCycles=7;
LagWait=10000;      //  CheckLag(LagWait); genera 'you see: backpack' en el journal del client , supongo como sistema de deteccion del lag

var
Terminated: Boolean;
CurrentRune: Byte;
CurrentBook,i: Integer;
GemTypes,OreTypes,Killers: array of Word;
RuneBooks: array of Cardinal;
MiningTool,TinkerTool: Cardinal;
cTime,cTime2: TDateTime;
direction,dist: Integer;


procedure EventMinerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(GetGumpsCount-1, TKMinerNumSecond) then Exit;
  if NumGumpButton(GetGumpsCount-1, TKMinerNumFirst) then Exit;
  CloseGump(true);
end;


procedure EventTinkerGump(Serial, GumpID, X, Y: Cardinal);
begin
  if NumGumpButton(GetGumpsCount-1, TKNumSecond) then Exit;
  if NumGumpButton(GetGumpsCount-1, TKNumFirst) then Exit;
  CloseGump(true);
end;


function CheckMiningTool: Boolean;
begin
  CheckLag(LagWait);
  FindType(MiningType, Backpack);
  if GetType(MiningTool) <> MiningType then MiningTool := FindItem;
  Result := FindCount > 0;
end;


function CheckTinkerTool: Boolean;
begin
  CheckLag(LagWait);
  FindType(TinkerType, Backpack);
  if GetType(TinkerTool) <> TinkerType then TinkerTool := FindItem;
  Result := FindCount > 1;
end;

function CheckPK: boolean;
var
ii,q:integer;
begin
  FindDistance:=25;
  for q:=0 to high(Killers) do
  for ii:=3 to 6 do
  if FindNotoriety(Killers[q],ii)>0 then begin
    Result:=True;
    AddToSystemJournal('PK' +GetName(FindItem)+' libro: '+IntToStr(CurrentBook+1)+' Rune: '+IntToStr(CurrentRune+1));
    FindDistance:=2;
    Exit;
  end;
  FindDistance:=2;
  if (Poisoned) or (HP<>MaxHP) then Result:=True;
end;
procedure CreateTKTools;
var
Counter: Cardinal;
begin
  SetEventProc(evIncomingGump, 'EventTinkerGump');
  UseObject(TinkerTool);
  Counter := 0;
  while True do begin
    if (Dead)
    or (not Connected)
    or (CheckTinkerTool) then begin
      SetEventProc(evIncomingGump, '');
      Break;
    end
    else Wait(1000);
    Inc(Counter);
    if Counter > WaitCycles then begin
      SetEventProc(evIncomingGump, '');
      Break;
    end;
  end;
end;

function CreateMiningTools: Boolean;
var
Counter: Cardinal;
begin
  SetEventProc(evIncomingGump, 'EventMinerGump');
  if not CheckTinkerTool then begin
    CreateTKTools;
  end;
  UseObject(TinkerTool);
  Counter := 0;
  while True do begin
    if (Dead)
    or (not Connected)
    or (CheckMiningTool) then Break;
    Inc(Counter);
    if Counter > WaitCycles then Break;
    Wait(1000);
  end;
  SetEventProc(evIncomingGump, '');
  CloseGump(true);
  Result := CheckMiningTool;
end;


procedure MoveOres;
var
CurOre: Integer;
begin
  CheckLag(LagWait);
  for CurOre := 0 to Length(OreTypes)-1 do begin
    if Dead or not Connected then Exit;
    CheckLag(LagWait);
    FindType(OreTypes[CurOre], Backpack);
    while FindCount > 0 do begin
      if Dead or not Connected then Exit;
      CheckLag(LagWait);
      MoveItem(Finditem, GetQuantity(Finditem), IngotsStorage, 0, 0, 0);
      Wait(WaitTime);
      FindType(OreTypes[CurOre], Backpack);
    end;
  end;
end;

procedure MoveGems;
var
CurGem: Integer;
begin
  CheckLag(LagWait);
  for CurGem := 0 to Length(GemTypes)-1 do begin
    if Dead or not Connected then Exit;
    CheckLag(LagWait);
    FindType(GemTypes[CurGem], Backpack);
    while FindCount > 0 do begin
      if Dead or not Connected then Exit;
      CheckLag(LagWait);
      MoveItem(Finditem, GetQuantity(Finditem), IngotsStorage, 0, 0, 0);
      Wait(WaitTime);
      FindType(GemTypes[CurGem], Backpack);
    end;
  end;
end;


procedure TakeIngots;
var
count: integer;
begin
  FindTypeEx(IngotsType, IronColor, Backpack, false);
  count:=FindQuantity;
  if count < IronCount then begin
    UseObject(IngotsStorage);
    wait(1500);
    FindTypeEx(IngotsType, IronColor, IngotsStorage, false);
    Grab(finditem, IronCount-count);
  end;
end;

function RecallRune(RuneBook: Cardinal; Rune: Byte):Boolean;
var
Counter: Byte;
X, Y: Word;
begin
  Result := False;
  X := GetX(Self);
  Y := GetY(Self);
  CheckLag(LagWait);
  Wait(WaitTime);
  if Dead or not Connected then Exit;
  cTime2:=Now;
  while (cTime2 < cTime)do begin
    cTime2:=Now;
    wait(100);
  end;
  UseObject(RuneBook);
  CheckLag(LagWait);
  cTime:=Now+0.00008;
  Counter := WaitCycles;
  while Counter > 0 do begin
    if IsGump then Break;
    Wait(WaitTime);
    CheckLag(LagWait);
    Inc(Counter);
  end;
  if IsGump then begin
    if NumGumpButton(GetGumpsCount-1, RuneBookShift + 6*Rune) then begin
      CheckLag(LagWait);
      Wait(RecalTime);
      CheckLag(LagWait);
      Result := (X <> GetX(Self)) or (Y <> GetY(Self));
    end else Result := False;
  end else Result := False;
end;


function GoBase: Boolean;
begin
  Result := RecallRune(HomeRuneBook, HomeRuneIndex);
end;


function NextRune: Boolean;
var
Counter: Cardinal;
begin
  Inc(CurrentRune);
  if CurrentRune > 15 then begin
    CurrentRune := 0 ;
    Inc(CurrentBook);
    if CurrentBook >= Length(RuneBooks) then CurrentBook := 0;
  end;
  for Counter := 0 to WaitCycles do begin   //bucle de recall is blocked etc
    if Dead or not Connected then Exit;
    Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
    if Result then Break;
    Inc(CurrentRune);
    Result := RecallRune(RuneBooks[CurrentBook], CurrentRune);
    if Result then Break;
    GoBase;
    Wait(10000);
  end;
end;


procedure CheckState; //check weight tools
begin
  if MaxWeight < Weight + 60 then begin
    while True do begin
      if Dead or not Connected then Exit;
      if GoBase() then Break;
      if GoBase() then Break; //gobase return boolean
      if not RecallRune(RuneBooks[CurrentBook], CurrentRune) then Wait(10000);
    end;
    MoveOres;
    MoveGems;
    TakeIngots;
    while True do begin
      if Dead or not Connected then Exit;
      if RecallRune(RuneBooks[CurrentBook], CurrentRune) then Break;   //recallrune return boolean
      if RecallRune(RuneBooks[CurrentBook], CurrentRune) then Break;
      if GoBase() then Continue;
      if not NextRune then Wait(10000);
    end;
  end;
  while not CheckMiningTool do begin    //wtf all functions return boolean ?¿
    if Dead or not Connected then Exit;
    CreateMiningTools;
  end;
end;


function TileX(): Integer;
var
x: Integer;
begin
dist := 1;

 case direction of
 1: x := GetX(Self())+dist;
 2: x := GetX(Self())+dist;
 3: x := GetX(Self())+0;
 4: x := GetX(Self())-dist;
 5: x := GetX(Self())-dist;
 6: x := GetX(Self())-dist;
 7: x := GetX(Self())+0;
 8: x := GetX(Self())+dist;
 end;
 Result := x;
end;

function TileY(): Integer;
var
y: Integer;
begin
dist:=1;

 case direction of
 1: y := GetY(Self())+0;
 2: y := GetY(Self())-dist;
 3: y := GetY(Self())-dist;
 4: y := GetY(Self())-dist;
 5: y := GetY(Self())+0;
 6: y := GetY(Self())+dist;
 7: y := GetY(Self())+dist;
 8: y := GetY(Self())+dist;
 end;
 Result := y;
end;

procedure checkhp();
begin
 if MaxHP>hp then begin
    if not(CheckPK) and (IsObjectExists(IngotsStorage)) then exit ;

    unequip(ArmsLayer);
   wait(600);
   unequip(EggsLayer);
   wait(600);
   unequip(GlovesLayer);
   wait(600);
   unequip(HatLayer);
   wait(600);
   unequip(LegsLayer);
   wait(600);
   unequip(NeckLayer);
   wait(600);
   unequip(TorsoLayer);
   wait(600);
   unequip(CloakLayer);
   wait(600);
   unequip(PantsLayer);
   wait(600);
 end;
end;
procedure Mine(X, Y: Integer);
var
StaticData: TStaticCell;
Tile: Word;
Z: ShortInt;
Finded: Boolean;
Counter: Byte;
StartTime: TDateTime;
i: Integer;
begin
  Finded := True;
  StaticData := ReadStaticsXY(X, Y, WorldNum);
  for i := 0 to StaticData.StaticCount - 1 do begin
    if i >= StaticData.StaticCount then Break;
    if (GetTileFlags(2, StaticData.Statics[i].Tile) and $200) = $200 then begin
      Tile := StaticData.Statics[i].Tile;
      Z := StaticData.Statics[i].Z;
      Finded := True;
      Break;
    end;
  end;

  CheckState();

  while Finded do begin
    if Dead or not Connected then Exit;
    if TargetPresent then CancelTarget;
    if Dead or not Connected then Exit;
    CheckLag(LagWait);
    Wait(WaitTime);



    if CheckPK then begin
        cTime:=Now-0.00008;
        GoBase;
        Inc(CurrentRune);
        Wait(WaitTime*1200);
        RecallRune(RuneBooks[CurrentBook], CurrentRune);
        CheckLag(LagWait);
        Wait(WaitTime);
    end;

    checkhp();

    UseObject(MiningTool);
    CheckLag(LagWait);
    WaitForTarget(LagWait);
    if TargetPresent then begin
      StartTime := Now;
      TargetToTile(Tile, X, Y, Z);
      Counter := WaitCycles;
      Finded := False;
      while (not Finded) and (Counter > 0) do begin
        CheckLag(LagWait);
        if InJournalBetweenTimes('t mine there|is too far away|cannot be seen|is no metal here to mine', StartTime, Now) > 0
        then
        Exit;
        if InJournalBetweenTimes('put it in your backpack|loosen some rocks but fail to find any useable ore|have worn out your tool', StartTime, Now) > 0
        then
        Finded := True;   // aja! finded es una variable!
        if Not Finded then Wait(200);
        Dec(Counter);
      end;
      CheckState();
    end;
  end;
end;

procedure MinePoint; //New

begin

 for direction :=1 to 8 do begin
  Mine( TileX ,TileY );  //mina x y
  end;
end;
                //main ini
begin

  cTime:=Now;
  for i:=0 to 5 do begin
    CloseSimpleGump(0);
    CloseSimpleGump(GetGumpsCount-1);
  end;
  RuneBooks := [$400C00DA];
  OreTypes := [$19B7, $19B8, $19B9, $19BA];
  GemTypes := [$3192, $3193, $3194, $3195, $3197, $3198, $0F25, $0F26,  $0F16, $0F19,  $0F21,  $0F15, $0F10,  $0F2D, $0F13];
  CurrentBook := 0;
  CurrentRune := 0;
  SetEventProc(evIncomingGump, '');
  while not Terminated do begin     //main loop
    if Dead then begin
      Terminated := True;
      Continue;
    end;
    if not Connected() then begin
      Connect();
      Wait(10000);
      Continue;
    end;
    NextRune;       //nextrune
    MinePoint;      //ini mine
  end;
end.
← newer dump
older dump →