Попишу скрипты за еду.

тут можно задать вопрос по скриптингу
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Попишу скрипты за еду.

Post by drabadan »

King wrote:Всем привет.
занимаетца кто-то еще скриптами на заказ?
опиши суть, может есть готовое решение
King
Neophyte
Neophyte
Posts: 15
Joined: 29.06.2015 20:56

Re: Попишу скрипты за еду.

Post by King »

Отписал в лс вам.
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Попишу скрипты за еду.

Post by drabadan »

King wrote:Отписал в лс вам.
нет, не отписал :)
King
Neophyte
Neophyte
Posts: 15
Joined: 29.06.2015 20:56

Re: Попишу скрипты за еду.

Post by King »

drabadan wrote:
King wrote:Отписал в лс вам.
нет, не отписал :)
хм страно. отправил повторно!
Bubonic Pestilence
Neophyte
Neophyte
Posts: 28
Joined: 14.12.2011 4:54
Contact:

Re: Попишу скрипты за еду.

Post by Bubonic Pestilence »

Ну я тоже могу на питоне написать ;)
Эх, вот был бы "RubyScript" =) так я такой бы харвестер написал...
GaZza
Posts: 2
Joined: 12.04.2016 22:09

Re: Попишу скрипты за еду.

Post by GaZza »

Напишите скрипт пожалуйста :(

Чар берет в банке денег 20к
если мало денег идёт в банк и берет еще
реколится по вендорам (smith)
скупает у них металл (Iron) до максимального веса в 500кг
если нет металла реколится к следующему продавцу
потом реколится домой и в указаный сундук скидывает всё скупленное
потом повторяет процедуру

ждёт лаги
ждёт сейв

За ранее Благодаою повелители скриптов =)
Half-Life
Novice
Novice
Posts: 86
Joined: 30.10.2012 12:06
Location: Одесса
Contact:

Re: Попишу скрипты за еду.

Post by Half-Life »

GaZza wrote:Напишите скрипт пожалуйста :(

Чар берет в банке денег 20к
если мало денег идёт в банк и берет еще
реколится по вендорам (smith)
скупает у них металл (Iron) до максимального веса в 500кг
если нет металла реколится к следующему продавцу
потом реколится домой и в указаный сундук скидывает всё скупленное
потом повторяет процедуру

ждёт лаги
ждёт сейв

За ранее Благодаою повелители скриптов =)
После праздников скину скрипт,)
Half-Life
Novice
Novice
Posts: 86
Joined: 30.10.2012 12:06
Location: Одесса
Contact:

Re: Попишу скрипты за еду.

Post by Half-Life »

GaZza wrote:Напишите скрипт пожалуйста :(

Чар берет в банке денег 20к
если мало денег идёт в банк и берет еще
реколится по вендорам (smith)
скупает у них металл (Iron) до максимального веса в 500кг
если нет металла реколится к следующему продавцу
потом реколится домой и в указаный сундук скидывает всё скупленное
потом повторяет процедуру

ждёт лаги
ждёт сейв

За ранее Благодаою повелители скриптов =)
На вот как то так, если будут косяки отпишись тут
MetallBuyHelper

Code: Select all

program MetallBuyHelper;
{
Autor: Half-Life;
Description: Скрипт на полном автомате летает по рунабуке и скупает металл. Тестировался на шарде UOAwakening.
UOStealthClientVersion: 7.0.3;
Warning! Будьте бдительны! - Администрация многих игровых серверов враждебно относится к использованию стелс клиента на своих серверах. Заподозрив вас в использовании стелс клиента и других неправославных программ они начинают сатанеть и в порыве слепой ярости могут попасть по вам Банхаммером;
}

type TGeoCord = record
Deg,Min:Integer;
Dir:String;
end;

type TPosition = record
X,Y:Word;
end;

type TLocation = record
CenterX,CenterY,WidthX,HeightY:Word;
end;

const
Storage = $40067DCD;          //Сундук в доме куда будут скидываться реги.

HomeRuneBook = $400B6822;     //Рб с рункой в дом.
HomeRuneNumber = 12;          //Номер рунки к дому. Отсчёт начинается с единицы!
HomeX = 2298;                 //Координата Х рунки к дому.
HomeY = 717;                  //Координата У рунки к дому.

BankRuneBook = $400B6822;     //Рб с рункой в Банк.
BankRuneNumber = 1;           //Номер рунки к банку. Отсчёт начинается с единицы!
BankX = 994;                  //Координата Х рунки к банку.
BankY = 525;                  //Координата У рунки к банку.

RuneBookGumpID = $554B87F3;   //Гамп Рб.
RuneBookShift = 5;            //Чем реколится. (5-магия, 7-Чива)

GoldType = $0EED;             //Тип Голды.
GoldAmount = 20000;           //Необходимая сумма для работы скрипта.
IngotsType = $1BF2;           //Тип Металла.
IngotsAmount = 200;           //Сколько металла покупать за раз.
LimitWeight = 500;            //Максимальный вес, до которого можно скупать.

WaitRecalTime = 2000;
WaitTime = 500;
WaitLagTime = 10000;
Location:TLocation =
(
CenterX:1323;
CenterY:1624;
WidthX:5120;
HeightY:4096;
);

var
VendorRuneBooks : array of Cardinal = [$4003E577]; //Рб с рунками к Вендорам.
VendorTypes : array of Word = [$029A,$029B,$0190,$0191]; //Типы Вендоров.
VendorNames : array of String = ['blacksmith']; //Имена Вендоров. Сюда вписывать только профессии!
CurrentRune:Byte;
CurrentBook,MetalTotal:Integer;

//==============================================================================
//# Utils
//==============================================================================

procedure WaitLag(WaitTime,LagTime:Word);
begin
  Wait(WaitTime);
  CheckLag(LagTime);
end;

procedure CloseGumps;
begin
  while IsGump do begin
    if not Connected then Exit;
    if not IsGumpCanBeClosed(GetGumpsCount-1) then begin
      WaitGump('0');
      Exit;
    end;
    CloseSimpleGump(GetGumpsCount-1);
  end;
end;

//==============================================================================
//# Initial
//==============================================================================

procedure Initial;
begin
  ClearSystemJournal;
  ClearJournal;
  IgnoreReset;
  AddToSystemJournal('Стартуем!');
  AddToSystemJournal('Закрываем гапмы...');
  CloseGumps;
  AddToSystemJournal('Гампы закрыты.');
end;

//==============================================================================
//# CheckStates
//==============================================================================

procedure CheckConnection;
begin
  if Connected then Exit;
  AddToSystemJournal('Нет коннекта.');
  while not Connected do begin
    AddToSystemJournal('Пытаюсь зайти на сервер...');
    Wait(5000);
  end;
  AddToSystemJournal('Есть коннект.');
  Initial;
end;

procedure CheckDead;
begin
  if not Dead then Exit;
  AddToSystemJournal('Очень жаль, но Вы умерли.');
  AddToSystemJournal('Runebook # ' + IntToStr(CurrentBook + 1));
  AddToSystemJournal('Rune # ' + IntToStr(CurrentRune));
  Halt;
end;

procedure CheckStates;
begin
  CheckConnection;
  CheckDead;
end;

//==============================================================================
//# Recalling
//==============================================================================

function DegreesToCoordinate(Degree,Minute,Center,Size:Word;Direction:String):Integer;
begin
  Result:=Trunc((Degree*100) + ((Minute*10)/6));
  if (Direction='N') or (Direction='W') then Result:=36000-Result;
  Result:=Round(Center + ((Result*Size)/36000)) mod Size;
end;

function GetPosition():TPosition;
var
gumpInfo:TGumpInfo;
Text:String;
StringList:TStringList;
Longitude,Latitude:TGeoCord;
Step:Byte;
begin
  Step:=CurrentRune-1;
  if not IsGump then Exit;
  GetGumpInfo(GetGumpsCount-1,gumpInfo);
  Text:=GumpInfo.Text[GumpInfo.GumpText[Step*2].Text_ID]+' '+GumpInfo.Text[GumpInfo.GumpText[Step*2+1].Text_ID];
  try
    StringList:=TStringList.Create;
    StringList.Delimiter:='''';
    StringList.DelimitedText:=Text;
    Text:=StringList.Text;
    StringList.Delimiter:='°';
    StringList.DelimitedText:=Text;
    with Latitude do begin
      Deg:=StrToInt(StringList[0]);
      Min:=StrToInt(StringList[1]);
      Dir:=StringList[2];
    end;
    with Longitude do begin
      Deg:=StrToInt(StringList[3]);
      Min:=StrToInt(StringList[4]);
      Dir:=StringList[5];
    end;
    finally
    StringList.Free;
  end;
  Result.X:=DegreesToCoordinate(Longitude.Deg,Longitude.Min,Location.CenterX,Location.WidthX,Longitude.Dir);
  Result.Y:=DegreesToCoordinate(Latitude.Deg,Latitude.Min,Location.CenterY,Location.HeightY,Latitude.Dir);
end;

function RecallTo(Runebook:Cardinal;Destination:Byte;DestX,DestY:Word;Place:String):Boolean;
var
Position:TPosition;
begin
  Position.X:=DestX;
  Position.Y:=DestY;
  AddToSystemJournal('Пытаюсь среколиться в '+Place+' рунка № #'+(IntToStr(Destination)));
  while (GetX(Self)<>Position.X) and (GetY(Self)<>Position.Y) do begin
    CheckStates;
    UseObject(RuneBook);
    WaitLag(WaitTime,WaitLagTime);
    if (GetGumpID(GetGumpsCount-1)<>RuneBookGumpID) then Continue;
    if (DestX and DestY)=0 then begin
      Position:=GetPosition;
    end;
    WaitGump(IntToStr(Destination*6+5-6));
    WaitLag(WaitRecalTime,WaitLagTime);
  end;
  Result:=True;
  AddToSystemJournal('Среколились.');
end;

//==============================================================================
//# Unload
//==============================================================================

procedure Unload;
begin
  AddToSystemJournal('Разгружаюсь...');
  while FindType(IngotsType,Backpack)>1 do begin
    MetalTotal:=MetalTotal+FindFullQuantity;
    MoveItem(FindItem,FindFullQuantity,Storage,0,0,0);
    WaitLag(WaitTime,WaitLagTime);
  end;
  AddToSystemJournal('Разгрузились.');
  AddToSystemJournal('За время работы скрипта было куплено '+IntToStr(MetalTotal)+' металла.');
end;

//==============================================================================
//# Check Weight
//==============================================================================

function CheckWeight(CheckTarget:String):Boolean;
begin
  case CheckTarget of
    'weight': begin
      Result:=Weight>=LimitWeight;
    end;
    'metal': begin
      Result:=FindType(IngotsType,Backpack)>0;
    end;
    'all': begin
      Result:=(Weight>=LimitWeight) or (FindType(IngotsType,Backpack)>0);
    end;
  end;
end;

//==============================================================================
//# Check Gold
//==============================================================================

procedure CheckGold;
var
GoldCount:Word;
begin
  AddToSystemJournal('Проверяем нужны ли деньги...');
  FindType(GoldType,Backpack);
  GoldCount:=GoldAmount-FindFullQuantity;
  if FindFullQuantity>=GoldAmount then begin
    AddToSystemJournal('Нет не нужны, в вашем паке '+IntToStr(GoldCount)+' golds');
    Exit;
  end;
  AddToSystemJournal('Да нужны, не хватает '+IntToStr(GoldCount)+' golds');
  RecallTo(BankRuneBook,BankRuneNumber,BankX,BankY,'Bank');
  UOSay('withdraw '+IntToStr(GoldCount));
  WaitLag(WaitTime,WaitLagTime);
  FindType(GoldType,Backpack);
  if FindFullQuantity < GoldAmount then begin
    AddToSystemJournal('Данной суммы не достаточно для работы скрипта'
    +IntToStr(GoldCount)+
    ' golds. По всей видимости у Вас закончились деньги в банке.'+
    'Скрипт остановлен.');
    Halt;
  end;
  AddToSystemJournal('Деньги успешно сняты с Вашего счёта. Продолжаем.');
end;

//==============================================================================
//# Check Vendor
//==============================================================================

function CheckVendor(VendorName:String):Boolean;
var
i:Byte;
begin
  for i:=0 to Length(VendorNames)-1 do begin
    if Pos(VendorNames[i],VendorName)>1 then begin
      Result:=True;
      Exit;
    end;
  end;
end;

//==============================================================================
//# Buy
//==============================================================================

procedure Buy;
var
VendorID:Cardinal;
VendorName:String;
i:Byte;
MetalBefore,MetalAfter:Integer;
begin
  AddToSystemJournal('Начинаю скупать...');
  SetAutoBuyDelay(3);
  FindDistance:=8;
  for i:=0 to Length(VendorTypes)-1 do begin
    CheckStates;
    WaitLag(WaitTime,WaitLagTime);
    while FindType(VendorTypes[i], Ground)>0 do begin
      CheckStates;
      VendorName:=LowerCase(GetCliloc(Finditem));
      if not CheckVendor(VendorName) then begin
        Ignore(Finditem);
        WaitLag(WaitTime,WaitLagTime);
        FindType(VendorTypes[i],Ground);
        Continue;
      end
      else begin
        VendorID:=Finditem;
        Break;
      end;
    end;
    repeat
      CheckStates;
      MetalBefore:=CountEx(IngotsType,$0000,Backpack);
      AutoBuy(IngotsType,$0000,IngotsAmount);
      SetContextMenuHook(VendorID,1);
      RequestContextMenu(VendorID);
      WaitLag(WaitRecalTime,WaitLagTime);
      MetalAfter:=CountEx(IngotsType,$0000,Backpack);
      if CheckWeight('weight') then begin
        Unload;
        CheckGold;
        RecallTo(VendorRuneBooks[CurrentBook],CurrentRune,0,0,'Vendor place');
      end;
    until(MetalBefore=MetalAfter);
  end;
  AutoBuy(IngotsType,$0000,0);
  AddToSystemJournal('Здесь всё скупили. Едем дальше.');
  WaitLag(WaitTime,WaitLagTime);
end;

//==============================================================================
//# Recall to vendor point
//==============================================================================

procedure VendorPoint;
begin
  CurrentRune:=1;
  for CurrentBook:=0 to Length(VendorRuneBooks)-1 do begin
    repeat
      CheckStates;
      RecallTo(VendorRuneBooks[CurrentBook],CurrentRune,0,0,'Vendor place');
      Buy;
      Inc(CurrentRune);
    until(CurrentRune>16);
  end;
end;

begin
  if not GetARStatus then SetARStatus(True);
  CheckStates;
  Initial;
  if CheckWeight('all') then begin
    RecallTo(HomeRuneBook,HomeRuneNumber,HomeX,HomeY,'Home');
    Unload;
  end;
  CheckGold;
  while True do begin
    VendorPoint;
  end;
end.
Xaosik
Posts: 1
Joined: 15.01.2017 4:56

Re: Попишу скрипты за еду.

Post by Xaosik »

Привет. Напиши, скрипт, если не сложно, на Begging под шард zuluhotel.net.ua.
Чар бегает по вендорам, качает скилл, собирает какое то количество денег и скидывает их в банк, еду берет с банка. Скил качается только при удачном попрошайничестве, а задержка у одного и того же вендора на попрошайничество минут 20-30, а может и дольше. Для этого и надо что б бегал по городским вендорам. Заранее спасибо
AlexxPhot
Posts: 2
Joined: 23.01.2017 2:45

Re: Попишу скрипты за еду.

Post by AlexxPhot »

Тема еще актуальна? нужны некоторые скрипты под сферу, если можно было бы получить контакты.
Respik
Neophyte
Neophyte
Posts: 12
Joined: 15.05.2012 3:17

Re: Попишу скрипты за еду.

Post by Respik »

Я бы тоже от скрипта не отказался одного.
Если кто готов помочь с этим напишите !
Respik
Neophyte
Neophyte
Posts: 12
Joined: 15.05.2012 3:17

Re: Попишу скрипты за еду.

Post by Respik »

Вдруг кто может сделать скрипт под 4 стелс,суть скрипта.
Маг кастует на себя блесс и инту, потом пойсоном сбивает всю ману и начинает медитить, как только медитация сработала, он одевает даггер, проверяет количество маны, если больше чем надо на каст пойсона, выкастовывает и снова пытается медитировать.
nah nah
Developer
Developer
Posts: 414
Joined: 13.07.2011 11:23
Contact:

Re: Попишу скрипты за еду.

Post by nah nah »

такое бесплатно делают от нечегоделать
Akad3m1k
Neophyte
Neophyte
Posts: 16
Joined: 12.12.2016 14:45

Re: Попишу скрипты за еду.

Post by Akad3m1k »

Сто пудово есть уже готовое решение, помогите найти, или же помогите со скриптом :)

51 сфера, мининг. (абис)
Чар прилетает по руне в сундуке или банке, до ходит до места обкопки. копает до определенного веса, летит домой, выгружается(добирает реги), летит туда же. до ходит до места обкопки, продолжает капать и так по кругу.

Есть скрипток, но пишет почему то хрень какую то... "Lack of resources to proceed, halting!" и не реколится по руне из сундука
мининг

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 = $40931815;
//===========================================================================//
    HomeChest = $40F34E78;
    BagOfRunes = $40F34E78;
    ReloadBag = $40F34E78;
    ResultBag = $40F34E78;
    UnlootBag = $40F34E78;
//===========================================================================//

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;
    
{$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;
  
//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;  
    if FindType($0E85, Backpack) > 1 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 := True;
                    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.


skype akademuk666
Akad3m1k
Neophyte
Neophyte
Posts: 16
Joined: 12.12.2016 14:45

Re: Попишу скрипты за еду.

Post by Akad3m1k »

Ап
Post Reply