Ultima Online Antares

    BankRune = $40D8BC44;
    OstrovRune = $40D8BC43;
    Bank = $40AE8DB5;
    Xmin = 2436;
    Xmax = 2498;
    Ymin = 40;
    Ymax = 67;

Program Mining_BestUO;
uses
    SysUtils;
    
const
    BankRune = $40D8BC44;
    OstrovRune = $40D8BC43;
    Bank = $40AE8DB5;
    Xmin = 2436;
    Xmax = 2498;
    Ymin = 40;
    Ymax = 67;
    
    AxeType = $0E85;
    Log = $19B9;

var
    ii,s,b,c,pX,pY : integer;
    pZ : ShortInt;  
    cTime,cTime2 : TDateTime;
    mPathArr : TPathArray;
    NeedToDrop : Boolean;
    TyleType : Array [0..24] of Word;
    a : TFoundTilesArray;
    TileNum,TileX,TileY,TileZ : tStringList;
    
procedure recall(rune:cardinal);
var
    MyX,MyY,Waiti : integer;
    
begin
MyX := GetX(Self);
MyY := GetY(Self);
While (getX(Self)=MyX) and (GetY(Self)=MyY) do
begin
If TargetPresent Then CancelTarget;
Cast('Recall');
WaitForTarget(5000);
TargetToObject(rune);
Waiti := 0;
While (getX(Self)=MyX) and (GetY(Self)=MyY) and (Waiti < 20) Do
    begin
    Wait(500);
    Waiti := Waiti + 1;
    end;
Wait(650);
CheckLag(10000);
end;
end;


procedure checkrune(check_rune_id:cardinal);
var
    CheckRunecTime : TDateTime;
    RuneString,OldName : String;
    Zariadi : integer;
    
begin
CheckRunecTime := Now;
ClickOnObject(check_rune_id);
WaitJournalLine(CheckRunecTime,'(',10000);
If InJournalBetweenTimes('(',CheckRunecTime,Now)<>-1 then
begin
RuneString := Journal(InJournalBetweenTimes('(',CheckRunecTime,Now));
OldName := RuneString;
Delete(OldName,Ansipos('(',RuneString)-1,99);
Delete(OldName,1,Ansipos(':',RuneString)+1);
Delete(RuneString,1,Ansipos('(',RuneString));
Delete(RuneString,Ansipos(')',RuneString),1);
AddToSystemJournal('Зарядов осталось: '+OldName+': '+RuneString);
Zariadi := StrToInt(RuneString);
If Zariadi < 5 Then
    begin
    AddToSystemJournal('Мало зарядов.');
    If TargetPresent Then CancelTarget;
    Cast('Mark');
    WaitFortarget(5000);
    TargetToObject(check_rune_id);
    CheckLag(10000);
    Wait(650);
    end;
end;
end;

procedure CheckReags;
var
    reags : array of integer;
    ireags : integer;
    reagtype : string;
begin
reags := [$0F7A,$0F7B,$0F86];
For ireags:=0 To length(reags)-1 do
    begin
    FindType(reags[ireags],backpack);
    if FindQuantity<10 then
        begin
        FindType(reags[ireags],bank);
        Case reags[ireags] of
            $0F7A : reagtype := 'Black Perl';
            $0F7B : reagtype := 'Blood Moss';
            $0F86 : reagtype := 'Mandrake Root';
            end;
        AddToSystemJournal(reagtype+' в банке: '+IntToStr(FindQuantity));
        Grab(FindItem,10);
        Wait(650);
        CheckLag(10000);
        end;
    end;
end;

function CheckAxe : Boolean;
begin
Result := True;
If FindType(AxeType,BackPack)=0 Then
    begin
    AddToSystemJournal('Нужена кирка.');
    FindType(AxeType,Bank);
    If FindCount=0 Then
        begin
        AddToSystemJournal('В банке нет кирки!');
        Result := False;
        end
    else
        begin
        Grab(FindItem,1);
        Wait(650);
        CheckLag(10000);
        AddToSystemJournal('В банке осталось: '+IntToStr(FindCount)+' кирок.');
        end;
    end;
end;

procedure CheckMana;
begin
If WarMode Then SetWarMode(False);
If Mana < 50 Then
begin
While Mana <> MaxMana do
    begin
    UseSkill('Meditation');
    Wait(1000);
    end;
end;
end;
    
procedure ImDead(DeadStatus:Boolean);
    var
    Deada : Integer;
begin
If DeadStatus Then
begin
    AddToSystemJournal('Я умер. Летим домой.');
    Deada := GetGumpsCount;
    NumGumpButton(GetGumpsCount-1,1);
    while Deada = GetGumpsCount do
    Wait(50);
    NumGumpButton(GetGumpsCount-1,2);
    While 1=1 Do Wait(1000);
end;
end;
    
procedure LoadTiles;
var
XCheckMin,YCheckMin,XCheckMax,YCheckMax:integer;
begin
TyleType[0] := 1386;
TyleType[1] := 1363;
TyleType[2] := 1362;
TyleType[3] := 1361;
TyleType[4] := 1359;
TyleType[5] := 1358;
TyleType[6] := 1357;
TyleType[7] := 1356;
TyleType[8] := 1355;
TyleType[9] := 1354;
TyleType[10] := 1353;
TyleType[11] := 1352;
TyleType[12] := 1351;
TyleType[13] := 1350;
TyleType[14] := 1349;
TyleType[15] := 1348;
TyleType[16] := 1347;
TyleType[17] := 1346;
TyleType[18] := 1345;
TyleType[19] := 1344;
TyleType[20] := 1343;
TyleType[21] := 1342;
TyleType[22] := 1341;
TyleType[23] := 1340;
TyleType[24] := 1339;
TileNum := TStringList.Create;
TileX := TStringList.Create;
TileY := TStringList.Create;
TileZ := TStringList.Create;

XCheckMin := Xmin;
XCheckMax := XCheckMin+3;
While XCheckMin < Xmax Do
begin
YCheckMin := Ymin;
YCheckMax := YCheckMin+3;
While YCheckMin < Ymax Do
begin
for s := 0 to 24 do
    begin
    b:= GetStaticTilesArray(XCheckMin,YCheckMin,XCheckMax,YCheckMax, 0, TyleType[s], a);
    if b>0 Then
    begin
    for c :=0 to b-1 do
      begin
      TileNum.Add(IntToStr(TyleType[s]));
      TileX.Add(IntToStr(a[c].X));
      TileY.Add(IntToStr(a[c].Y));
      TileZ.Add(IntToStr(a[c].Z));
      end;
    end;
    end;
YCheckMin := YCheckMax+1;
YCheckMax := YCheckMin+3;
end;
XCheckMin := XCheckMax+1;
XCheckMax := XCheckMin+3;
end;

AddToSystemJournal('Найдено точек руды: '+IntToStr(TileNum.Count)+';');
end;

procedure CheckMineXY;
begin
For pX := Getx(self)-1 to Getx(self)+1 do
begin
    For pY := Gety(self)-1 to Gety(self)+1 Do
    begin
        If (pX <> GetX(Self)) and (pY <> getY(self)) then
        begin
            If NewMoveXY(pX,pY,False,0,true) Then Exit;
        end;
    end;        
end;
AddToSystemJournal('Не могу копать под собой. Фикс не срабатал.');
While 1=1 do wait(1000);
end;

procedure Lumber(tTile,tX,tY,tZ:integer);
begin
cTime := Now;
While InJournalBetweenTimes('far away|line of sight|nothing here',cTime,Now)=-1 Do
begin
cTime2 := Now;
If TargetPresent Then CancelTarget;
if (GetType(ObjAtLayer(RhandLayer)) <> AxeType) then
   begin
   UseObject(FindType(AxeType, Backpack));
   end;
if (GetType(ObjAtLayer(RhandLayer)) = AxeType) then
   begin
   UseObject(ObjAtLayer(RhandLayer));
   end;  
WaitForTarget(5000);
TargetToTile(tTile,tX,tY,tZ);
WaitJournalLine(cTime2,'put the|far away|line of sight|fail to find|nothing here|close to yourself',25000);
If InJournalBetweenTimes('close to yourself',cTime2,Now)<>-1 Then CheckMineXY;
Wait(350);
end;
end;

procedure CheckWeight;
begin
FindType(Log,BackPack);
If (FindFullQuantity > 150) or (NeedToDrop = True) Then
    begin
    recall(bankrune);
    If NeedToDrop Then
        begin
        Wait(60000*30);
        NeedToDrop := False;
        end;
    checkrune(bankrune);
    CheckLag(10000);
    UoSay('bank');
    Wait(650);
    CheckLag(10000);
    While FindType(Log,BackPack)>0 Do
        begin
        MoveItem(FindItem,-1,Bank,0,0,0);
        Wait(650);
        CheckLag(10000);
        end;
    FindTypeEx(Log,$0000,bank,False);
    AddToSystemJournal('Руды в банке: '+IntToStr(FindFullQuantity));
    CheckReags;
    If CheckAxe = False Then Exit;
    CheckMana;
    recall(OstrovRune);  
    checkrune(OstrovRune);
    AddToSystemJournal('------------------');
    end;
end;      
    
begin
SetARStatus(True);
SetPauseScriptOnDisconnectStatus(True);
SetEventProc(evDeath,'ImDead');
LoadTiles;
NeedToDrop := False;
While 1 = 1 Do
begin
For ii:=0 To TileNum.Count-1 Do
begin
    If GetPathArray(StrToInt(TileX[ii]),StrToInt(TileY[ii]),True,3,mPathArr)<0 Then
        begin
        AddToSystemJournal('Не вижу шахты.');
        Exit;
        end;
    NewMoveXY(StrToInt(TileX[ii]),StrToInt(TileY[ii]),True,2,True);
    Lumber(StrToInt(TileNum[ii]),StrToInt(TileX[ii]),StrToInt(TileY[ii]),StrToInt(TileZ[ii]));
    CheckWeight;
end;
NeedToDrop := True;
AddToSystemJournal('Копать закончил. 30 минут отдых');
CheckWeight;
end;
TileNum.Clear;
TileNum.Free;
TileX.Clear;
TileX.Free;
TileY.Clear;
TileY.Free;
TileZ.Clear;
TileZ.Free;
end.