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.