Forum in READ ONLY mode! All questions and discussions on Discord official server, invite link: https://discord.gg/VxsGzJ7

Mining, Lumber для BestUO.ru

Only working scripts
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Mining, Lumber для BestUO.ru

Post by drabadan »

Поскольку я в очередной раз забил на ультиму выкладываю пару скриптов, которыми я копал\рубил.

Майнинг и ламбер работают одинаково.
Ставим сундук в сундук ложим сумку с инвизками, отмычками, скининг кнайфами, рекол регами и кирками. В сундук или сумку с рунами на шахты, в пак руну домой. Сумку для выгрузки результатов.
Копаем - рубим, кому шо нравится.
Он не реколится по рунам на которых осталось мало зарядов, домой руну перемарчивает.
На скриптах было выкопано, вырубано - вагон и маленькая тележка.
Mining

Code: Select all

Program Mining_BestUO_Kendal;

const
    SeekRange = 20; //радиус поиска деревьев
    Pickaxe_Type = $0E85;
    Shovel_Type = $0E85;
    Invizka_Type = $0E24;
    Invizka_Color = $0060;
    Rune_Type = $1F14;
    Knife_Type = $13F6;
    Lockpick_Type = $14FB;
    IsidasChest_Type = $0E43;
    Rock_Type = $177C;
    Food_Type = $097B;   
//==========================================================================//
    MyMaxWeight = 550;
    //HomeRune = $4029C175;
//===========================================================================//
    HomeChest = $40924E0C;
    BagOfRunes = $40C2BB44;
    ReloadBag = $40975D90;
    ResultBag = $40361CAC;
    UnlootBag = $40C2BB44;
//===========================================================================//
	ICQ_login = ;
	ICQ_password = ;
	TargetICQ_login = ;


type
    MinTile = record
        x, y, z, Tile : Word;
    end;

var
    Caves_Array : Array of Cardinal;
    MinTiles_Array : Array of MinTile;
    Ore : Array[0..3] of Word;
    Cave_Index, Idx, controlInt : Integer;
    FlagPk, FlagProceed : Boolean;
    ReloadItems_Array : Array[0..6] of Word;
    LootItems_Array : Array of Word;
    HomeRune : Cardinal;
    
{$Region Initializing}

//Initiation of ore types Array;
procedure InitOre;
  begin
    Ore[0] := $19B7;               // 1 Ore 
    Ore[1] := $19BA;               // 2 Ore 
    Ore[2] := $19B8;               // 3 Ore 
    Ore[3] := $19B9;               // 4 Ore
    
    if CharName = 'Kraz' then HomeRune := $4029C175;
    if CharName = 'Drabadan' then HomeRune := $4044D616;
  end;
  
//Initiation of ReloadItems_Array
procedure InitReloadItems_Array;
begin
     ReloadItems_Array[0] := BM; 
     ReloadItems_Array[1] := BP;
     ReloadItems_Array[2] := MR;
     ReloadItems_Array[3] := Invizka_Type;
     ReloadItems_Array[4] := Pickaxe_Type;
     ReloadItems_Array[5] := Lockpick_Type;
     ReloadItems_Array[6] := Knife_Type;         
end;
  
//Initiation of RunesToCaves;
procedure GetCaveRunes;
var 
    i : Integer;
begin
    MoveOpenDoor := True;
    NewMoveXY(GetX(HomeChest), GetY(HomeChest), true, 1, true);
    Wait(1000);
    UseObject(HomeChest);
    CheckLag(30000);
    Wait(1000);
    UseObject(BagOfRunes);
    CheckLag(30000);
    Wait(1000);
    //for i := 0 to 20 do AddToSystemJournal(IntToStr(i));
    if FindType(Rune_Type, BagOfRunes) > 0 then
        begin
            //AddToSystemJournal(IntToStr(FindCount));
            SetLength(Caves_Array, FindCount);
            for i := 0 to FindCount -1 do
                begin
                     FindType(Rune_Type, BagOfRunes);                    
                     Caves_Array[i] := FindItem;
                     Ignore(FindItem);                                           
                end;
        end
    else
        AddToSystemJournal('No runes found...');
    IgnoreReset;
    AddToSystemJournal('Added ' + IntToStr(Length(Caves_Array)) + ' Caves.');         
end;	

{$Endregion}

{$Region Kernel procedures}
function ArrayHasItem(My_Array : Array of Word; Item_Type : Word) : Boolean;
var i : Integer;
begin
    Result := False;
    for i := Low(My_Array) to High(My_Array) do
        if Item_Type = My_Array[i] then Result := True; 
end;
{$Region MobHandling}

function IsMob : Cardinal;
begin    
    Result := 0;
    if FindType($000E, Ground) > 0 then Result := FindItem;
end;

procedure CarveAndLoot;
var   
    Corpse : Cardinal;
begin    
    Wait(1000);
    Beep;
    if FindType($2006, Ground) > 0 then 
        begin
            Corpse := FindItem;
            UseType(Knife_Type, $FFFF);
            CheckLag(30000);
            if WaitForTarget(5000) then 
                TargetToObject(Corpse)
            else
                AddToSystemJournal('No knifes found!');
            CheckLag(30000);
            Wait(650);
            UseObject(Corpse);
            Wait(1000);
            CheckLag(30000);            
            while FindType($FFFF, Corpse) > 0 do
                begin
                    if not ArrayHasItem(LootItems_Array, GetType(FindItem)) then
                        begin
                            SetLength(LootItems_Array, Length(LootItems_Array)+1);
                            LootItems_Array[High(LootItems_Array)] := GetType(FindItem);
                        end;
                    MoveItem(FindItem, 0, Backpack, 0,0,0);
                    Wait(650);
                    CheckLag(30000);
                end;
            if FindType(Rock_Type, Ground) > 0 then 
                begin
                    UseObject(FindItem);
                    Wait(300);
                    CheckLag(30000);
                end
            else
                ClientPrint('No rocks found...');
            if FindType(IsidasChest_Type, Ground) > 0 then
                begin
                    Corpse := FindItem;
                    UseType(Lockpick_Type, $FFFF);
                    CheckLag(30000);
                    if WaitForTarget(5000) then TargetToObject(Corpse);
                end
            else
                ClientPrint('No chests found...');
            Ignore(Corpse);
        end;
    ClientPrint('Loot finished!');   
end;

procedure KillMob(Mob : Cardinal);
var
    ctime : TDateTime;    
begin
    ctime := Now;
    while IsMob > 0 do
        begin            
            Attack(Mob);
            Wait(300);
            CheckLag(30000);
            if WaitJournalLine(ctime, 'убили', 300) then break;
        end;
    CarveAndLoot;    
end;

{$EndRegion}

function GetRuneCharges(Rune_Id : Cardinal) : Integer;
var
    CTime : TDateTime;
    s : String;
begin
    CTime := Now;
    ClickOnObject(Rune_Id);
    CheckLag(30000);
    Result := 0;
     if WaitJournalLine(CTime, '(', 2000) then
        begin
            Idx := InJournalBetweenTimes('(', CTime, Now);
            s := Journal(Idx);
            Delete(s, Pos(')',s), Length(s));
            Delete(s, 1, Pos('(', s));
            Result := StrToInt(s);
        end
    else
        Result := -1;
end;

procedure WaitLag(WaitMS : Integer);
begin
    Wait(WaitMS);
    CheckLag(60000);
end;

//Icq handling;
procedure SendMsg_ICQ(str : String);
begin
    if not ICQConnected then
        ICQConnect(ICQ_login, ICQ_password);
    if ICQConnected then
        ICQSendText(TargetICQ_Login, str)
    else
        AddToSystemJournal('No icq connection, failed to send message!');   
end;

//procedure GetTilesToMine;
procedure GetTilesToMine;
var
    x, y, i : Integer;
    TileInfo : TStaticCell;
begin
    SetLength(MinTiles_Array, 0);
    for x := (-1 * SeekRange) to SeekRange do
        for y := (-1 * SeekRange) to SeekRange do
            begin
                TileInfo := ReadStaticsXY(GetX(self)+x, GetY(self)+y, 0);
                if TileInfo.StaticCount > 0 then
                    for i := Low(TileInfo.Statics) to High(TileInfo.Statics) do
                        if (TileInfo.Statics[i].Tile >= 1339) and (TileInfo.Statics[i].Tile <= 1359) and (TileInfo.Statics[i].z = GetZ(self)) then
                            begin
                                SetLength(MinTiles_Array, Length(MinTiles_Array) + 1);
                                MinTiles_Array[High(MinTiles_Array)].Tile := TileInfo.Statics[i].Tile;
                                MinTiles_Array[High(MinTiles_Array)].x := TileInfo.Statics[i].x;
                                MinTiles_Array[High(MinTiles_Array)].y := TileInfo.Statics[i].y;
                                MinTiles_Array[High(MinTiles_Array)].z := TileInfo.Statics[i].z;
                            end;                            
            end;
        AddToSystemJournal('Found ' + IntToStr(Length(MinTiles_Array)) + ' tiles to mine.');   
end;

//Antimacro;
procedure GumpHandling;
var
    gi : TGumpInfo;
    st : TStringList;
    tResult : Integer;
begin
    Wait(RandomRange(1, 6)*1000);
    GetGumpInfo(GetGumpsCount-1, gi);
    st := TStringList.Create;
    StrBreakApart(gi.Text[High(gi.Text)], ' ', st);
    if st.Count > 0 then
        begin
            if st[1] = 'плюс' then
                tResult := StrToInt(st[0]) + StrToInt(st[2]);
            if st[1] = 'минус' then
                tResult := StrToInt(st[0]) - StrToInt(st[2]);
        end;        
    if tResult > -1 then
        begin
            Wait(1500);
            CheckLag(30000);
            AddToSystemJournal('Gump answer is: ' + IntToStr(tResult));
            NumGumpTextEntry(GetGumpsCount-1, 0, IntToStr(tResult));
            NumGumpButton(GetGumpsCount-1, gi.GumpButtons[Low(gi.GumpButtons)].return_value);
        end
    else
        AddToSystemJournal('ERROR');
    st.Free;
end;

//runing from PK;
function RunPK : Boolean;
var i : Integer;
begin
    Result := False;
    Ignore(self);
    FindDistance := 20;
    if (FindType($0190, Ground) > 1) or (FindType($0191, Ground) > 0) then
        begin
            ClickOnObject(FindItem);
            Result := True;
            Cast('Recall');
            AddToSystemJournal('Name: ' + GetName(FindItem));
            SendMsg_ICQ('PK at: ' + CharName);
            CheckLag(30000);
            if WaitForTarget(3000) then TargetToObject(HomeRune);
            UseObject(FindTypeEx($0E24, $0060, Backpack, false));            
            for i := 0 to 45 do
                begin
                    Wait(100);
                    CheckLag(30000);
                    if FindType($0F0D, Ground) > 0 then MoveItem(FindItem, 0, Backpack, 0,0,0);
                end;
        end;
end;

procedure CheckHide;
var i : Integer;
begin
    while not Hidden do
        begin
            UseSkill('Hiding');
            for i := 0 to 55 do
                begin
                    Wait(100);
                    CheckLag(30000);
                    if Hidden then break;
                end;
        end;
end;

procedure CheckMana;
var 
    i : Integer;
    ctime : TDateTime;
begin
    if Mana < MaxMana/2 then        
        begin
            for i := 0 to 999 do
                begin
                    ctime := Now;
                    UseSkill('Meditation');
                    Wait(300);
                    CheckLag(30000);
                    if not WaitJournalLine(ctime, 'You lose', 5000) then break;
                end;
            while Mana < MaxMana-10 do Wait(1000);
        end
    else
        ClientPrint('Mana ok...');                       
end;

function FindGM : Boolean;
begin
    Result := False;
    if (GetDistance($00000001) < 20) and (GetDistance($00000001) > -1) then Result := True;
    FindDistance := 20;
    if FindTypeEx($FFFF, $83EA, Ground, True) > 0 then Result := True;
end;

procedure GMFound;
var i : Integer;
begin
    for i := 0 to 3 do
        begin
            SendMsg_ICQ('ЕШЕЛЬМЕ ЕШЕЛЬБЕ!!!! НАЩАЙНИКЕ ПРИШОЛь');
            Beep;
            Wait(600);
            AddToSystemJournal('ЕШЕЛЬМЕ ЕШЕЛЬБЕ!!!! НАЩАЙНИКЕ ПРИШОЛь');
        end;
    UOSay('хеллоу');
    Wait(10000);    
end;

//MinTile with Index of MinTiles_Array
procedure MinTileSpot(Idx : Integer);
var
    i, k : Integer;
    msgFizzle, msgEnd : String;
    cTime : TDateTime;    
begin
    msgFizzle := 'You put |You loosen ';
    msgEnd := 'is nothing| too far| mining in rock| cannot mine| no line| reach| not to mine|Try mining ';
    if Dist(GetX(self), GetY(self), MinTiles_Array[Idx].x, MinTiles_Array[Idx].y) > 2 then 
        NewMoveXY(MinTiles_Array[Idx].x, MinTiles_Array[Idx].y, true, 1, true);
    for k := 0 to 4 do
        begin
            if IsMob > 0 then KillMob(IsMob);
            if FlagPk then exit;
            if WarMode then SetWarMode(False);
            if FindGM then GMFound;
            //if not Hidden then CheckHide;     
            if IsGump then GumpHandling;
            if RunPk then FlagPk := True;    
            if UseType(Pickaxe_Type, $FFFF) = 0 then 
                UseType(Shovel_Type, $FFFF);
            CheckLag(30000);
            if not WaitForTarget(3000) then
                if UseType(Pickaxe_Type, $FFFF) = 0 then 
                    UseType(Shovel_Type, $FFFF);
            CheckLag(30000);
            if not WaitForTarget(3000) then 
                begin
                    ClientPrint('No pickaxes or shovels found...');
                    exit;
                end
            else
                begin
                    cTime := Now;
                    TargetToTile(MinTiles_Array[Idx].Tile, MinTiles_Array[Idx].x, MinTiles_Array[Idx].y, MinTiles_Array[Idx].z);                    
                    for i := 0 to 70 do
                        begin
                            if IsMob > 0 then KillMob(IsMob);
                            if RunPk then 
                                begin
                                    FlagPk := True;
                                    break;
                                end;
                            Wait(100);
                            CheckLag(30000);
                            if (InJournalBetweenTimes(msgFizzle, cTime, Now) <> -1) then break;
                            if (InJournalBetweenTimes(msgEnd, cTime, Now) <> -1) then exit;
                        end;
                end;
        end;
    ClientPrint('Tile finished.');    
end;

//no comments
function Recall(Rune : Cardinal) : Boolean;
var i, cX, cY : Integer;
begin
    Result := False;
    cX := GetX(self);
    cY := GetY(self);
    Cast('Recall');
    CheckLag(30000);
    if WaitForTarget(3000) then TargetToObject(Rune);
    for i := 0 to 70 do
        begin
            CheckLag(30000);
            Wait(100);
            if (GetX(self) <> cX) or (GetY(self) <> cY) then
                begin
                    Result := True;
                    break;
                end;
        end;                 
end;

procedure RemarkHomeRune;
begin
    if GetRuneCharges(HomeRune) < 10 then
        begin
            Cast('Mark');
            CheckLag(30000);            
            if WaitForTarget(5000) then TargetToObject(HomeRune);
            Wait(5000);
            CheckMana;
        end
    else
        ClientPrint('Rune ok...');       
end;

function CanRecall(Rune_Id : Cardinal) : Boolean;
begin
    Result := False;
    if GetRuneCharges(Rune_Id) > 10 then 
        begin
            CheckMana;
            Result := True;
        end; 
end;

//no comments
procedure Unload;
var
    i, tQuantity : Integer;
    tItem : Cardinal; 
    ctime : TDateTime;   
begin
    SendMsg_ICQ('Unloading at: ' + CharName);
    InitReloadItems_Array;
    InitOre;
    if GetDistance(HomeChest) = -1 then 
        begin
            Recall(HomeRune);
            Wait(300);
            CheckLag(30000);
            CheckMana;
            RemarkHomeRune;
        end;        
    MoveOpenDoor := True;
    NewMoveXY(GetX(HomeChest), GetY(HomeChest), true, 1, true);
    Wait(1000);
    //UOSay('BANK VISCA BARCELONA!!!');
    UseObject(HomeChest);
    Wait(1000);
    CheckLag(30000);
    for i := Low(Ore) to High(Ore) do
        while FindType(Ore[i], Backpack) > 0 do
            begin
                MoveItem(FindItem, 0, ResultBag, 0,0,0);
                Wait(650);
                CheckLag(30000);
            end;
    if Length(LootItems_Array) > 0 then
        begin
            UseObject(UnlootBag);
            CheckLag(30000);
            Wait(600);
            for i := Low(LootItems_Array) to High(LootItems_Array) do
                while FindType(LootItems_Array[i], Backpack) > 0 do
                    begin
                        MoveItem(FindItem, 0, UnlootBag, 0,0,0);
                        Wait(600);
                        CheckLag(30000);
                    end;
        end;   
    UseObject(ReloadBag);
    Wait(600);
    CheckLag(30000);
    if FindType(Food_Type, ReloadBag) > 0 then
        begin
            MoveItem(FindItem, 15, Backpack, 0,0,0);
            Wait(650);
            CheckLag(30000);
            for i := 0 to 30 do                
                begin
                    ctime := Now;
                    UseObject(FindType(Food_Type, Backpack));
                    Wait(300);
                    CheckLag(30000);
                    if WaitJournalLine(ctime, 'simply too', 1000) then break;
                end;
            MoveItem(FindType(Food_Type, Backpack), 0, ReloadBag, 0,0,0);
            Wait(650);
            CheckLag(30000);
        end;
    if FindType($0F0E, Backpack) > 0 then 
        begin
            MoveItem(FindItem, 0, ReloadBag, 0,0,0);
            Wait(650);
            CheckLag(30000);
        end;
    for i := Low(ReloadItems_Array) to High(ReloadItems_Array) do
        begin
            if FindType(ReloadItems_Array[i], ReloadBag) > 0 then
                begin
                    tItem := FindItem;
                    if FindType(ReloadItems_Array[i], Backpack) <= 0 then
                        begin                            
                            MoveItem(tItem, 5, Backpack, 0,0,0);
                            Wait(1000);
                            CheckLag(30000);
                        end
                    else
                        begin
                            tQuantity := FindFullQuantity;
                            //AddToSystemJournal(IntToStr(tQuantity));
                            if tQuantity < 5 then                              
                                begin
                                    MoveItem(tItem, 5 - FindFullQuantity, Backpack, 0,0,0);
                                    Wait(1000);
                                    CheckLag(30000);
                                end;
                        end;
                end
            else
                begin
                    FlagProceed := False;
                    AddToSystemJournal('Lack of resources to proceed, halting!');
                end;
        end;    
    ClientPrint('Unload Complete!');    
    CheckMana;        
end;                               

{$Endregion}

//Main Loop
begin
    //SendMsg_ICQ('Script started at: ' + CharName);    
    IgnoreReset;
    FlagProceed := True;
    GetCaveRunes; 
    Unload;   
    while not Dead and FlagProceed do
        begin
            while IsGump do CloseSimpleGump(GetGumpsCount-1);
            for Cave_Index := Low(Caves_Array) to High(Caves_Array) do  
                begin
                    CLientPrint('Rune num: ' + IntToStr(Cave_Index));
                    if not FlagProceed then break;
                    if CanRecall(Caves_Array[Cave_Index]) and FlagProceed then 
                        begin
                            Recall(Caves_Array[Cave_Index]);
                            Wait(300);
                            CheckLag(30000);
                            GetTilesToMine;
                        end;
                    for Idx := 0 to Length(MinTiles_Array)-1 do
                        begin
                            CLientPrint('Tile num: ' + IntToStr(Idx));
                            if Weight >= MyMaxWeight then 
                                begin
                                    controlInt := Idx;
                                    Unload;
                                    Recall(Caves_Array[Cave_Index]);
                                    WaitLag(1000);
                                    Idx := controlInt;
                                end;  
                            if not FlagProceed then break;
                            if (Idx >= Low(MinTiles_Array)) and (Idx <= High(MinTiles_Array)) then
                                 MinTileSpot(Idx)
                            else
                                begin
                                    AddToSystemJournal('Index is out of range, index value is: ' + IntToStr(Idx));
                                    break;
                                end;
                            if FlagPk then
                                begin
                                    Unload;
                                    AddToSystemJournal('PK');
                                    Wait(300000);
                                    FlagPk := False;
                                    break;                                    
                                end;                
                        end;
                    Unload;
                end;
        end; 
end.
Lumber

Code: Select all

Program Lumberjacking_BestUO_Recall;

const
    SeekRange = 60;
    Pickaxe_Type = $0F43;
    Shovel_Type = $0F43;
    Invizka_Type = $0E24;
    Invizka_Color = $0060;
    Rune_Type = $1F14;
    Knife_Type = $13F6;
    Lockpick_Type = $14FB;
    IsidasChest_Type = $0E43;
    Rock_Type = $0CF6;
    Food_Type = $097B;
    Logs = $1BDD;   
//==========================================================================//
    MyMaxWeight = 520;
    HomeRune = $4044D616;
//===========================================================================//
    HomeChest = $40262D3D;
    BagOfRunes = $40262D3D;
    ReloadBag = $40EC3189;
    ResultBag = $407D2EC0;
    UnlootBag = $40E10831;
//===========================================================================//

type
    MinTile = record
        x, y, z, Tile : Word;
    end;

var
    Caves_Array : Array of Cardinal;
    MinTiles_Array : Array of MinTile;
    Ore : Array[0..3] of Word;
    Cave_Index, Idx, controlInt : Integer;
    FlagPk, FlagProceed : Boolean;
    ReloadItems_Array : Array[0..6] of Word;
    LootItems_Array : Array of Word;
    TreeTile : Array[0..39] of Word;
    
{$Region Initializing}

//Initiation of ore types Array;
procedure InitOre;
  begin
    Ore[0] := $19B7;               // 1 Ore 
    Ore[1] := $19BA;               // 2 Ore 
    Ore[2] := $19B8;               // 3 Ore 
    Ore[3] := $19B9;               // 4 Ore
  end;
  
//Initiation of ReloadItems_Array
procedure InitReloadItems_Array;
begin
     ReloadItems_Array[0] := BM; 
     ReloadItems_Array[1] := BP;
     ReloadItems_Array[2] := MR;
     ReloadItems_Array[3] := Invizka_Type;
     ReloadItems_Array[4] := Pickaxe_Type;
     ReloadItems_Array[5] := Lockpick_Type;
     ReloadItems_Array[6] := Knife_Type;         
end;

procedure InitTTilesArray;
begin
TreeTile[0]:=3274;
TreeTile[1]:=3275;
TreeTile[2]:=3277;
TreeTile[3]:=3280;

TreeTile[4]:=3283;
TreeTile[5]:=3286;
TreeTile[6]:=3288;
TreeTile[7]:=3290;

TreeTile[8]:=3293;
TreeTile[9]:=3296;
TreeTile[10]:=3299;
TreeTile[11]:=3302;

TreeTile[12]:=3320;
TreeTile[13]:=3323;
TreeTile[14]:=3326;
TreeTile[15]:=3329;

TreeTile[16]:=3393;
TreeTile[17]:=3394;
TreeTile[18]:=3395;
TreeTile[19]:=3396;

TreeTile[20]:=3415;
TreeTile[21]:=3416;
TreeTile[22]:=3417;
TreeTile[23]:=3418;

TreeTile[24]:=3419;
TreeTile[25]:=3438;
TreeTile[26]:=3439;
TreeTile[27]:=3440;

TreeTile[28]:=3441;
TreeTile[29]:=3442;
TreeTile[30]:=3460;
TreeTile[31]:=3461;

TreeTile[32]:=3462;
TreeTile[33]:=3476;
TreeTile[34]:=3478;
TreeTile[35]:=3480;

TreeTile[36]:=3482;
TreeTile[37]:=3484;
TreeTile[38]:=3492;
TreeTile[39]:=3496;
end;
  
//Initiation of RunesToCaves;
procedure GetCaveRunes;
var 
    i : Integer;
begin
    MoveOpenDoor := True;
    if GetDistance(HomeChest) > 2 then  NewMoveXY(GetX(HomeChest), GetY(HomeChest), true, 1, true);
    Wait(300);
    UseObject(HomeChest);
    CheckLag(30000);
    Wait(1000);
    //for i := 0 to 20 do AddToSystemJournal(IntToStr(i));
    if FindType(Rune_Type, BagOfRunes) > 0 then
        begin
            //AddToSystemJournal(IntToStr(FindCount));
            SetLength(Caves_Array, FindCount);
            for i := 0 to FindCount -1 do
                begin
                     FindType(Rune_Type, BagOfRunes);                    
                     Caves_Array[i] := FindItem;
                     Ignore(FindItem);                                           
                end;
        end
    else
        AddToSystemJournal('No runes found...');
    IgnoreReset;
    AddToSystemJournal('Added ' + IntToStr(Length(Caves_Array)) + ' Caves.');         
end;    

{$Endregion}

{$Region Kernel procedures}
function ArrayHasItem(My_Array : Array of Word; Item_Type : Word) : Boolean;
var i : Integer;
begin
    Result := False;
    for i := Low(My_Array) to High(My_Array) do
        if Item_Type = My_Array[i] then Result := True; 
end;
{$Region MobHandling}

function IsMob : Cardinal;
begin
    Result := 0;
    if FindType($002F, Ground) > 0 then Result := FindItem;
end;

procedure CarveAndLoot;
var   
    Corpse : Cardinal;
begin
    if FindType($2006, Ground) > 0 then 
        begin
            Corpse := FindItem;
            UseType(Knife_Type, $FFFF);
            CheckLag(30000);
            if WaitForTarget(5000) then 
                TargetToObject(Corpse)
            else
                AddToSystemJournal('No knifes found!');
            CheckLag(30000);
            Wait(650);
            UseObject(Corpse);            
            while FindType($FFFF, Corpse) > 0 do
                begin
                    if not ArrayHasItem(LootItems_Array, GetType(FindItem)) then
                        begin
                            SetLength(LootItems_Array, Length(LootItems_Array)+1);
                            LootItems_Array[High(LootItems_Array)] := GetType(FindItem);
                        end;
                    MoveItem(FindItem, 0, Backpack, 0,0,0);
                    Wait(650);
                    CheckLag(30000);
                end;
            if FindType(Rock_Type, Ground) > 0 then 
                begin
                    UseObject(FindItem);
                    Wait(300);
                    CheckLag(30000);
                end
            else
                ClientPrint('No rocks found...');
            if FindType(IsidasChest_Type, Ground) > 0 then
                begin
                    Corpse := FindItem;
                    UseType(Lockpick_Type, $FFFF);
                    CheckLag(30000);
                    if WaitForTarget(5000) then TargetToObject(Corpse);
                end
            else
                ClientPrint('No chests found...');
        end;
    ClientPrint('Loot finished!');   
end;

procedure KillMob(Mob : Cardinal);
var
    ctime : TDateTime;    
begin
    ctime := Now;
    while IsMob > 0 do
        begin            
            Attack(Mob);
            Wait(300);
            CheckLag(30000);
            if WaitJournalLine(ctime, 'убили', 300) then break;
        end;
    CarveAndLoot;    
end;

{$EndRegion}

function GetRuneCharges(Rune_Id : Cardinal) : Integer;
var
    CTime : TDateTime;
    s : String;
begin
    CTime := Now;
    ClickOnObject(Rune_Id);
    CheckLag(30000);
    Result := 0;
     if WaitJournalLine(CTime, '(', 2000) then
        begin
            Idx := InJournalBetweenTimes('(', CTime, Now);
            s := Journal(Idx);
            Delete(s, Pos(')',s), Length(s));
            Delete(s, 1, Pos('(', s));
            Result := StrToInt(s);
        end
    else
        Result := -1;
end;

//procedure GetTilesToMine;
procedure GetTilesToMine;
var
    x, y, i, k : Integer;
    TileInfo : TStaticCell;
begin
    InitTTilesArray;
    SetLength(MinTiles_Array, 0);
    for x := (-1 * SeekRange) to SeekRange do
        for y := (-1 * SeekRange) to SeekRange do
            begin
                TileInfo := ReadStaticsXY(GetX(self)+x, GetY(self)+y, 0);
                if TileInfo.StaticCount > 0 then
                    for i := Low(TileInfo.Statics) to High(TileInfo.Statics) do
                        for k := Low(TreeTile) to High(TreeTile) do
                            if (TileInfo.Statics[i].Tile = TreeTile[k]) then
                                begin
                                    SetLength(MinTiles_Array, Length(MinTiles_Array) + 1);
                                    MinTiles_Array[High(MinTiles_Array)].Tile := TileInfo.Statics[i].Tile;
                                    MinTiles_Array[High(MinTiles_Array)].x := TileInfo.Statics[i].x;
                                    MinTiles_Array[High(MinTiles_Array)].y := TileInfo.Statics[i].y;
                                    MinTiles_Array[High(MinTiles_Array)].z := TileInfo.Statics[i].z;
                                end;                            
            end;
        AddToSystemJournal('Found ' + IntToStr(Length(MinTiles_Array)) + ' tiles to mine.');   
end;

//Antimacro;
procedure GumpHandling;
var
    gi : TGumpInfo;
    st : TStringList;
    tResult : Integer;
begin
    GetGumpInfo(GetGumpsCount-1, gi);
    st := TStringList.Create;
    StrBreakApart(gi.Text[High(gi.Text)], ' ', st);
    if st.Count > 0 then
        begin
            if st[1] = 'плюс' then
                tResult := StrToInt(st[0]) + StrToInt(st[2]);
            if st[1] = 'минус' then
                tResult := StrToInt(st[0]) - StrToInt(st[2]);
        end;        
    if tResult > -1 then
        begin
            Wait(1500);
            CheckLag(30000);
            AddToSystemJournal('Gump answer is: ' + IntToStr(tResult));
            NumGumpTextEntry(GetGumpsCount-1, 0, IntToStr(tResult));
            NumGumpButton(GetGumpsCount-1, gi.GumpButtons[Low(gi.GumpButtons)].return_value);
        end
    else
        AddToSystemJournal('ERROR');
    st.Free;
end;

//runing from PK;
function RunPK : Boolean;
var i : Integer;
begin
    Result := False;
    Ignore(self);
    FindDistance := 20;
    if (FindType($0190, Ground) > 1) or (FindType($0191, Ground) > 0) then
        begin
            AddToSystemJournal('Name: ' + GetName(FindItem));
            Result := True;
            Cast('Recall');
            CheckLag(30000);
            if WaitForTarget(3000) then TargetToObject(HomeRune);
            UseObject(FindTypeEx($0E24, $0060, Backpack, false));
            for i := 0 to 45 do
                begin
                    Wait(100);
                    CheckLag(30000);
                    if FindType($0F0D, Ground) > 0 then MoveItem(FindItem, 0, Backpack, 0,0,0);
                end;
        end;
end;

procedure CheckHide;
var i : Integer;
begin
    while not Hidden do
        begin
            UseSkill('Hiding');
            for i := 0 to 55 do
                begin
                    Wait(100);
                    CheckLag(30000);
                    if Hidden then break;
                end;
        end;
end;

procedure CheckMana;
var 
    i : Integer;
    ctime : TDateTime;
begin
    if Mana < MaxMana/2 then        
        begin
            for i := 0 to 999 do
                begin   
                    ctime := Now;
                    UseSkill('Meditation');
                    Wait(300);
                    CheckLag(30000);
                    if not WaitJournalLine(ctime, 'You lose', 5000) then break;
                end;
            while Mana < MaxMana-10 do Wait(1000);
        end
    else
        ClientPrint('Mana ok...');                       
end;

//MinTile with Index of MinTiles_Array
procedure MinTileSpot(Idx : Integer);
var
    i, k, m : Integer;
    msgFizzle, msgEnd : String;
    cTime : TDateTime;    
begin
    msgFizzle := 'You put |You hack ';
    msgEnd := 'is nothing| not to chop| appears immune| cannot mine| no line| reach| not to mine| try mining';
    if Dist(GetX(self), GetY(self), MinTiles_Array[Idx].x, MinTiles_Array[Idx].y) > 2 then 
        NewMoveXY(MinTiles_Array[Idx].x, MinTiles_Array[Idx].y, true, 1, true);
    for k := 0 to 4 do
        begin
            if IsMob > 0 then KillMob(IsMob);
            if FlagPk then exit;
            if WarMode then SetWarMode(False);
            //if not Hidden then CheckHide;     
            if IsGump then GumpHandling;
            if RunPk then FlagPk := True;    
            if UseType(Pickaxe_Type, $FFFF) = 0 then 
                UseType(Shovel_Type, $FFFF);
            CheckLag(30000);
            if not WaitForTarget(3000) then
                if UseType(Pickaxe_Type, $FFFF) = 0 then 
                    UseType(Shovel_Type, $FFFF);
            CheckLag(30000);
            if not WaitForTarget(3000) then 
                begin
                    ClientPrint('No pickaxes or shovels found...');
                    exit;
                end
            else
                begin
                    cTime := Now;
                    TargetToTile(MinTiles_Array[Idx].Tile, MinTiles_Array[Idx].x, MinTiles_Array[Idx].y, MinTiles_Array[Idx].z);                    
                    for i := 0 to 55 do
                        begin                       
                            if IsMob > 0 then KillMob(IsMob);
                            if RunPk then 
                                begin
                                    FlagPk := True;
                                    break;
                                end;
                            Wait(100);
                            CheckLag(30000);
                            if (InJournalBetweenTimes(msgFizzle, cTime, Now) <> -1) then break;
                            if (InJournalBetweenTimes(msgEnd, cTime, Now) <> -1) then exit;
                        end;
                end;
        end;
    ClientPrint('Tile finished.');    
end;

//no comments
function Recall(Rune : Cardinal) : Boolean;
var i, cX, cY : Integer;
begin
    Result := False;
    cX := GetX(self);
    cY := GetY(self);
    Cast('Recall');
    CheckLag(30000);
    if WaitForTarget(3000) then TargetToObject(Rune);
    for i := 0 to 55 do
        begin
            CheckLag(30000);
            Wait(100);
            if (GetX(self) <> cX) or (GetY(self) <> cY) then
                begin
                    Result := True;
                    break;
                end;
        end;                 
end;

procedure RemarkHomeRune;
begin
    if GetRuneCharges(HomeRune) < 10 then
        begin
            Cast('Mark');
            CheckLag(30000);            
            if WaitForTarget(5000) then TargetToObject(HomeRune);
            Wait(5000);
            CheckMana;
        end
    else
        ClientPrint('Rune ok...');       
end;

function CanRecall(Rune_Id : Cardinal) : Boolean;
begin
    Result := False;
    if GetRuneCharges(Rune_Id) > 10 then Result := True; 
end;

//no comments
procedure Unload;
var
    i, tQuantity : Integer;
    tItem : Cardinal; 
    ctime : TDateTime;   
begin
    InitReloadItems_Array;
    InitOre;
    if GetDistance(HomeChest) = -1 then 
        begin
            Recall(HomeRune);
            Wait(300);
            CheckLag(30000);
            CheckMana;
            RemarkHomeRune;
        end;        
    MoveOpenDoor := True;
    NewMoveXY(GetX(HomeChest), GetY(HomeChest), true, 1, true);
    //UOSay('BANK VISCA BARCELONA!!!');
    UseObject(HomeChest);
    Wait(1000);
    CheckLag(30000);
    while FindType(Logs, Backpack) > 0 do
        begin
            MoveItem(FindItem, 0, ResultBag, 0,0,0);
            Wait(650);
            CheckLag(30000);
        end;
    if Length(LootItems_Array) > 0 then
        begin
            UseObject(UnlootBag);
            CheckLag(30000);
            Wait(600);
            for i := Low(LootItems_Array) to High(LootItems_Array) do
                while FindType(LootItems_Array[i], Backpack) > 0 do
                    begin
                        MoveItem(FindItem, 0, UnlootBag, 0,0,0);
                        Wait(600);
                        CheckLag(30000);
                    end;
        end;   
    UseObject(ReloadBag);
    Wait(600);
    CheckLag(30000);
    if FindType(Food_Type, ReloadBag) > 0 then
        begin
            MoveItem(FindItem, 15, Backpack, 0,0,0);
            Wait(650);
            CheckLag(30000);
            for i := 0 to 30 do                
                begin
                    ctime := Now;
                    UseObject(FindType(Food_Type, Backpack));
                    Wait(300);
                    CheckLag(30000);
                    if WaitJournalLine(ctime, 'simply too', 1000) then break;
                end;
            MoveItem(FindType(Food_Type, Backpack), 0, ReloadBag, 0,0,0);
            Wait(650);
            CheckLag(30000);
        end;
    if FindType($0F0E, Backpack) > 0 then 
        begin
            MoveItem(FindItem, 0, ReloadBag, 0,0,0);
            Wait(650);
            CheckLag(30000);
        end;
    for i := Low(ReloadItems_Array) to High(ReloadItems_Array) do
        begin
            if FindType(ReloadItems_Array[i], ReloadBag) > 0 then
                begin
                    tItem := FindItem;
                    if FindType(ReloadItems_Array[i], Backpack) <= 0 then
                        begin                            
                            MoveItem(tItem, 5, Backpack, 0,0,0);
                            Wait(650);
                            CheckLag(30000);
                        end
                    else
                        begin
                            tQuantity := FindFullQuantity;
                            //AddToSystemJournal(IntToStr(tQuantity));
                            if FindFullQuantity < 5 then
                                begin
                                    MoveItem(tItem, 5 - FindFullQuantity, Backpack, 0,0,0);
                                    Wait(650);
                                    CheckLag(30000);
                                end;
                        end;
                end
            else
                begin
                    FlagProceed := False;
                    AddToSystemJournal('Lack of resources to proceed, halting!');
                end;
        end;    
    ClientPrint('Unload Complete!');    
    CheckMana;        
end;                               

{$Endregion}

//Main Loop
begin
    FlagProceed := True;
    GetCaveRunes;
    Unload;   
    while not Dead and FlagProceed do
        begin
            while IsGump do CloseSimpleGump(GetGumpsCount-1);
            for Cave_Index := Low(Caves_Array) to High(Caves_Array) do  
                begin
                    if not FlagProceed then break;                    
                    if CanRecall(Caves_Array[Cave_Index]) then 
                        begin
                            Recall(Caves_Array[Cave_Index]);
                            Wait(300);
                            CheckLag(30000);
                            GetTilesToMine;
                        end;
                    for Idx := Low(MinTiles_Array) to High(MinTiles_Array) do
                        begin
                            if Weight >= MyMaxWeight then 
                                begin
                                    controlInt := Idx;
                                    Unload;
                                    Recall(Caves_Array[Cave_Index]);
                                    Idx := controlInt;
                                end;    
                            if (Idx >= Low(MinTiles_Array)) and (Idx <= High(MinTiles_Array)) then
                                MinTileSpot(Idx)
                            else
                                begin
                                    AddToSystemJournal('Error in mintiles array, current index is: ' + IntToStr(Idx));
                                    break; 
                                end;
                            if FlagPk then
                                begin
                                    //Unload;
                                    AddToSystemJournal('PK');
                                    Wait(300000);
                                    FlagPk := False;
                                    break;                                    
                                end;                
                        end;
                    Unload;
                end;
        end; 
end.
Буду рад услышать конструктивную критику и\или возможности оптимизации данных скриптов.
CxC
Neophyte
Neophyte
Posts: 34
Joined: 25.10.2009 15:45
Contact:

Re: Mining, Lumber для BestUO.ru

Post by CxC »

запустил мининг
1. Ты что-то намудрил с руной домой, то у тебя определяется по нику, то объявляется...
2. Какая-то беда с ICQ модулем, пока его и весь вызов не закомментировал - завести не смог
3. Поставь небольшую дистанцию на атаку големов, а то через полкарты атачит и тупит
4. Нужен список френдов, от которых чар не реколится
5. Неплохо было бы вывести в начало скрипта "юзать или нет хайд"
6. Я что-то занубил и не нашел регулируемое количество взятие инвизок. Ножей что-то он набирает тонну в пак
7. Бинты не помешали бы после убийства големов

пока все )
Last edited by CxC on 07.01.2014 15:12, edited 1 time in total.
CxC
Neophyte
Neophyte
Posts: 34
Joined: 25.10.2009 15:45
Contact:

Re: Mining, Lumber для BestUO.ru

Post by CxC »

Code: Select all

[16:59:10:758] System: Where do you want to use the Pickaxe?
[16:59:25:129] System: You must wait to perform another action
[16:59:28:369] System: You must wait to perform another action
[16:59:29:625] System: You loosen some rocks but fail to find any useable ore.
[16:59:31:579] System: Where do you want to use the Pickaxe?
[16:59:32:254] You see: Forest Gazer [6/60]
[16:59:39:816] System: You loosen some rocks but fail to find any useable ore.
[16:59:40:006] System: Where do you want to use the Pickaxe?
[16:59:50:461] You see: Gray Horse
[16:59:52:359] System: You must wait to perform another action
[16:59:55:549] System: You must wait to perform another action
[16:59:58:952] System: You put the Iron Ores in your pack.
[16:59:59:073] System: Where do you want to use the Pickaxe?
[17:00:11:452] System: You must wait to perform another action
[17:00:12:663] System: You put the Iron Ores in your pack.
[17:00:14:672] System: Where do you want to use the Pickaxe?
[17:00:22:837] System: You loosen some rocks but fail to find any useable ore.
[17:00:23:166] System: Where do you want to use the Pickaxe?
[17:00:34:078] You see: Forest Gazer [6/60]
[17:00:35:804] System: You must wait to perform another action
[17:00:38:994] System: You must wait to perform another action
[17:00:39:227] System: You put the Iron Ores in your pack.
[17:00:42:255] System: Where do you want to use the Pickaxe?
[17:00:53:363] System: You loosen some rocks but fail to find any useable ore.
[17:00:53:559] System: Where do you want to use the Pickaxe?
что он пытается сделать во время копки? )))
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Mining, Lumber для BestUO.ru

Post by drabadan »

CxC у тебя задержка там стрелять колотить какая, пытается копнуть...

По замечаниям - спасибо, буду работать, чинить!
Globant
Neophyte
Neophyte
Posts: 39
Joined: 30.04.2013 23:23

Re: Mining, Lumber для BestUO.ru

Post by Globant »

CxC wrote:пока все )
это пока, пернит рекол будет стоять и дрочить в паке перебросом ресурса в шахте, от пк если пернул рекол, второй раз не пробует рекол делать.
Globant
Neophyte
Neophyte
Posts: 39
Joined: 30.04.2013 23:23

Re: Mining, Lumber для BestUO.ru

Post by Globant »

заметил такую байду, на последней версии стелса, чар уходит от пк и виснет на месте рекола, тупо стоит и ничего не делает! на старых версиях он не глючил после рекола.
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Mining, Lumber для BestUO.ru

Post by drabadan »

Globant wrote:заметил такую байду, на последней версии стелса, чар уходит от пк и виснет на месте рекола, тупо стоит и ничего не делает! на старых версиях он не глючил после рекола.
бывало тоже...
исключал все while и repeat из скрипта и более менее работало!
va1et
Posts: 5
Joined: 30.04.2014 23:59

Re: Mining, Lumber для BestUO.ru

Post by va1et »

Запустил ламбер - вроде всё норм, но когда нужно реколиться по рунам, выдаёт такое:
: No runes found...
: Added 0 Caves.
va1et
Posts: 5
Joined: 30.04.2014 23:59

Re: Mining, Lumber для BestUO.ru

Post by va1et »

и ошибку такую выдаёт

Code: Select all

lumber_drabadan.sc at 383:5): Variable 'M' never used
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Mining, Lumber для BestUO.ru

Post by drabadan »

va1et wrote:и ошибку такую выдаёт

Code: Select all

lumber_drabadan.sc at 383:5): Variable 'M' never used
вероятно руны лежат не там где надо или айдишки не те написаны.
Про переменную - это уведомление, а не ошибка.
va1et
Posts: 5
Joined: 30.04.2014 23:59

Re: Mining, Lumber для BestUO.ru

Post by va1et »

drabadan wrote:
va1et wrote:и ошибку такую выдаёт

Code: Select all

lumber_drabadan.sc at 383:5): Variable 'M' never used
вероятно руны лежат не там где надо или айдишки не те написаны.
Про переменную - это уведомление, а не ошибка.
проверял. ради интереса кинул по руне в каждый мешок и даже в общий сундук, - не реколится и всё тут.
ps: в мининге с рунами проблем не возникло
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Mining, Lumber для BestUO.ru

Post by drabadan »

va1et wrote:
drabadan wrote:
va1et wrote:и ошибку такую выдаёт

Code: Select all

lumber_drabadan.sc at 383:5): Variable 'M' never used
вероятно руны лежат не там где надо или айдишки не те написаны.
Про переменную - это уведомление, а не ошибка.
проверял. ради интереса кинул по руне в каждый мешок и даже в общий сундук, - не реколится и всё тут.
ps: в мининге с рунами проблем не возникло
так оно там идентичное все, хз хз...
va1et
Posts: 5
Joined: 30.04.2014 23:59

Re: Mining, Lumber для BestUO.ru

Post by va1et »

точно косяк где-то!)
va1et
Posts: 5
Joined: 30.04.2014 23:59

Re: Mining, Lumber для BestUO.ru

Post by va1et »

решил проблему тем, что установил сумкой с рунами основной сундук. по другому не пахало
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Mining, Lumber для BestUO.ru

Post by drabadan »

va1et wrote:решил проблему тем, что установил сумкой с рунами основной сундук. по другому не пахало
правильно сделал, у меня так и было!
А косяк мой - скрипт не открывает сумку с рунами прежде чем читать их, ибо я изначально руны складывал в сундук.
Доделать - рукикрюки, лень, жизньгавно!
Post Reply