Заявка на новые возможности, либо на исправление старых

[Vizit0r]

по той же причине нет. кроме тебя этим никто не будет пользоваться, вот и все.

[Macks]

по той же причине нет. кроме тебя этим никто не будет пользоваться, вот и все.

Я один играю на сфере, ок.

[Vizit0r]

а причем тут сфера?

[Macks]

а причем тут сфера?

На шарде где нельзя перекладывать большие тяжести используется сфера.
Минимум на этом шарде это актуально.

[Vizit0r]

а. ок, добавлю, но это может быть не скоро.

[drabadan]

а причем тут сфера?

На шарде где нельзя перекладывать большие тяжести используется сфера.
Минимум на этом шарде это актуально.

так, а что за проблема написать себе под дллку скриптик небольшой, по типу инжектовских аутолоадов.

у меня вот один из автолоадов, со всякими треш тестами, которые биндились на кнопочки всякие

Code: Select all

program AutoLoad;

var
 CastRecovering : Boolean;

procedure fStep;
begin
 ClientPrint(IntToStr(WorldNum));
end;

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

procedure Kill;
begin
 CLientRequestObjectTarget;
 while not ClientTargetResponsePresent do wait(100);
 Attack(ClientTargetResponse.Id);
end;

procedure GetMyGold;
begin
 FindType($0EED, ObjAtLayer(BankLayer));
 AddToSystemJournal(IntToStr(FindFullQuantity) + ' : gold in bank');
end;

procedure GetItemInfo(Item : Cardinal);
var
aa : TClilocRec;
bb : TClilocItemRec;
i,k : Integer;
begin
aa := GetToolTipRec(Item);
AddToSystemJournal('Total lines in Toolptip: ' + IntToStr(aa.Count));
for i := 0 to aa.Count - 1 do
  begin
    AddToSystemJournal('Line ' + IntToStr(i) + ': ');
    bb := aa.Items[i];   
    //AddToSystemJournal('Cliloc: $' + IntToHex(bb.ClilocID,8));
    //AddToSystemJournal('Cliloc text: ' + GetClilocByID(bb.ClilocID));
    for k := 0 to Length(bb.Params) - 1 do
     begin//AddToSystemJournal('Param' + IntToStr(k) + ': "'+ bb.Params[k] + '"');
      if bb.Params[k] = '#1044095' then
       AddToSystemJournal('Bingo' + '$' + IntToHex(Item, 8));
     end;
  end; 
end;

function GetBeetleWeight(id : Cardinal) : Integer;
var
 str : String;
begin
 Result := 0;
 str := GetToolTip(id);
 Delete(str, 1, BMSearch(1, str, ':'));
 Delete(str, BMsearch(1, str, 'stones'), Length(str)-1);
 str := Trim(str);
 Result := StrToInt(str); 
end;

procedure GetItemInfoFromTarget;
begin
 CLientRequestObjectTarget;
 while not ClientTargetResponsePresent do wait(100);
  GetBeetleWeight(ClientTargetResponse.Id);//AddToSystemJournal(GetToolTip(ClientTargetResponse.Id));
 
end;

procedure HealFriend;
var
 Friend : Cardinal;
begin
 ClientRequestObjectTarget;
 while not ClientTargetResponsePresent do wait(100);
 Friend := ClientTargetResponse.Id;
 
 while True do
  begin
   Cast('Heal');
   if WaitForTarget(60000) then
    TargetToObject(Friend);
   Wait(300);
  end;
  
end;

procedure GetItemInfoFromContainer(VendorName : String; Container : Cardinal; WTS : String);
var
 Item : Cardinal;
begin
 //CLientRequestObjectTarget;
 //while not ClientTargetResponsePresent do wait(100);
 UseObject(Container);
 Wait(20);
 CheckLag(60000);
 Item := Container; 
 FindType($FFFF, Item);                   
 AddToSystemJournal('Searching started, items in search: ' + IntToStr(FindCount)); 
 while FindType($FFFF, Item) > 0 do
  begin
   if IsContainer(FindItem) then
    GetItemInfoFromContainer(VendorName, FindItem, WTS);
   if BMSearch(1, GetToolTip(FindItem), WTS) > 0 then
    begin
     FillNewWindow('=======================================================================');
     FillNewWindow(VendorName);
     UOSay('Bingo!');
     //AddToSystemJournal('Bingo: ' + '$' + IntToHex(FindItem, 8));
     FillNewWindow('Bingo: ' + '$' + IntToHex(FindItem, 8));
     FillNewWindow(GetToolTip(FindItem));
     ClickOnObject(FindItem);
    end;         
   Ignore(FindItem);
   Wait(5);
  end;
 Ignore(Container);
 AddTosystemJournal('Search ended...')
end;



{procedure TestCOntainer;
var
 cont : Cardinal;
begin
 ClientRequestObjectTarget;
 while not ClientTargetResponsePresent do wait(100);
 cont := ClientTargetResponse.Id;
 if IsContainer(cont) then
  begin
   UOSay('container');
   //UseObject(cont);
   GetItemInfoFromContainer(VendorName, cont);
   AddToSystemJournal('$' + IntToHex(GetParent(cont), 8));
  end
 else
  UOSay('not container');                    
end;}

procedure ParseVendor(Vendor : Cardinal; WTS : String);
var
 cont : Cardinal;
begin
 //ClientRequestObjectTarget;
 //while not ClientTargetResponsePresent do wait(100);
 cont := Vendor;//ClientTargetResponse.Id;
 //AddToSystemJournal('======================================================================='); 
 //FillNewWindow('=======================================================================');
 //FillNewWindow(GetName(cont));
 while FindType($FFFF, cont) > 0 do
  begin   
   if IsContainer(FindItem) then
    begin
     UseObject(FindItem);
     Wait(300);
     GetItemInfoFromContainer(GetName(cont), FindItem, WTS);
    end;
   Ignore(FindItem);
  end;
 Ignore(Vendor);
end;

procedure ParseMarket;
var
 VendorTypes : Array of Word;
 i : Integer;
begin
 IgnoreReset;
 VendorTypes := [$0190, $0191];
 FindDistance := 40;
 //for i := 0 to 1 do
 FindType(VendorTypes[1], Ground);
 UOSay(IntToStr(FindCount));
 for i := 0 to 1 do
  while FindType(VendorTypes[i], Ground) > 0 do
   begin
    ParseVendor(FindItem, 'Necromancy');
    Wait(5);
    //Ignore(FindItem);
   end;
 IgnoreReset;
end;

procedure TestDist;
var
 vend : Cardinal;
begin
 ClientRequestObjectTarget;
 while not ClientTargetResponsePresent do wait(100);
 vend := ClientTargetResponse.Id;
 UOSay(IntToStr(Dist(Getx(self), getY(self), getx(vend), gety(vend))));
 AddToSystemJournal(GetToolTip(vend));
end;

function ParseURL(Text : String) : String;
//var
 //str : String;
begin
 Delete(Text, 1, BMSearch(1, Text,'http')-1);
 //AddToSystemJournal(IntToStr(BMSearch(1, Text, 'Post body was 0 chars long.')) + ' ' + IntToStr(Length()));
 Delete(Text, BMSearch(1, Text, 'Post body was 0 chars long.'), Length(Text)-1);
 
 Result := Text;
end;

procedure CountItem;
begin
 ClientRequestObjectTarget;
 while not ClientTargetResponsePresent do wait(100);
 FindTypeEx(GetType(ClientTargetResponse.Id), GetColor(ClientTargetResponse.Id), GetParent(    ClientTargetResponse.Id), True);
 AddToSystemJOurnal(IntToStr(FindFullQUantity));
 ClientPrint(IntToStr(FindFullQUantity));
end;

procedure OnSpeech(Text, SenderName : String; SenderID : Cardinal);
begin
 if Text = 'recovered' then
  CastRecovering := True; 
end;

procedure CastingSpellTargetSelf;
var
 cTime : TDateTime;
begin
 cTime := Now; 
 while WaitForTarget(100) do
  if (InJournalBetweenTimes('recovered', cTime, Now) <> 0) then
   Halt
  else if TargetPresent then
   TargetToObject(Self); 
end;

{procedure HealSelf;
begin
 if Poisoned then 
  begin   
   Cast('Cure');
   CastingSpellTargetSelf;     
  end;
 Cast('Heal');
 CastingSpellTargetSelf;  
end;}

procedure TestMemory;
begin
 while True do
  begin
   UseSkill('Hiding');
   Wait(10000);
  end;
end;

procedure GetGround;
begin
AddToSystemJournal(IntToHex(GetParent(Self), 8));
end;


procedure MakeReward;
var
 i : Integer;
begin
 for i := 0 to 7 do
  begin
   MoveItem(FindTypeEx($1BDD, $0000, $43015E52, True), 200, Backpack, 0,0,0);
   Wait(600);
   UseType($0F47, $FFFF);
   if waitfortarget(60000) then
    TargetToObject(FindType($1BDD, Backpack));
   Wait(600);
   MoveItem(FindType($1BD7, Backpack), 999, $000C8F7A, 0,0,0);
   Wait(600);
  end;
end;

procedure SellReward;
begin
 while FindType($1BD7, $41F62853) > 0 do
  begin
   MoveItem(FindItem, 200, Backpack, 0,0,0); 
   Wait(600);
   UseObject($40014B1E);
   Wait(600);
   NumGumpButton(GetGumpsCount-1, 303); 
   Wait(600);
   ConsoleEntryUnicodeReply('200');
  end;
end;
     
procedure TestBeetleBag;
begin
 AddToSystemJournal('$' + IntToHex(GetParent($4336DA24),8));
end;

procedure RecallLuna;
begin
 UseObject($416C056B);
 Wait(300);
 NumGumpButton(GetGumpsCount-1, 17);
end;

procedure TrainStrength;
begin
 FindType($13C7, Backpack);
 
 while true do
  begin
  waittargetobject(FindItem);
   UseSkill('Arms Lore'); 
   wait(1200);
  end; 
end;

procedure GetGold;
begin
 FindDistance := 40;
 FindVertical := 100;
 while FindType($0EED, Ground) > 0 do
  begin
   NewMoveXY(GetX(FindItem), GetY(FindItem), true, 1, true);
   MoveItem(FindItem,99999, backpack, 0,0,0);
   Wait(600); 
   Ignore(FindItem);
  end;
end;

procedure TestStr;
begin
 if BMSearch(1, GetToolTip($415AA972), 'Exceptional') > 0 then UOSay('Shit');
end;

procedure GumpParserTests;
var 
 gi : TGumpInfo;
begin
 GetGumpInfo(GetGumpsCount-1, gi);
 NumGumpButton(GetGumpsCount-1, gi.GumpButtons[8-3].return_value);
end;

procedure MyStrToInt;
begin
 AddToSystemJournal(IntToStr(StrToInt('lkj')));
end;

function BodIsComplete(Bod : Cardinal) : Integer; //-1 error; 0 - not complete; 1 - complete;
var
 str, str1 : String;
 int1, int2 : Integer;
 Sl : TStringList;
begin
 Result := -1;
 str := AnsiLowerCase(GetToolTip(Bod));
 str := Copy(str, Pos('make:', str) + 5, Length(str)-1);
 str1 := Copy(str, Pos('|', str)+1, Length(str)-1);
 str := Copy(str, 1, Pos('|', str)-1);
  AddToSystemJournal(str1);
 
 if Pos('|', str1) > 0 then  
  begin
   str1 := Copy(str1, Pos(':', str1)+1, Pos('|', str1)-1);
   str1 := Copy(str1, 1, Pos('|', str1)-1);
  end
 else
  str1 := Copy(str1, Pos(':', str1)+1, Length(str1)-1);
 AddToSystemJournal(str1);  
 str := Trim(str);
 str1 := Trim(str1);
 int1 := StrToInt(str);
 int2 := StrToInt(str1);
 
 if int1 <> int2 then
  Result := 0
 else
  Result := 1;
 
 AddToSystemJOurnal(str + ' ' + str1 + ' ' + IntToStr(Result)); 
end;

procedure TestBodComplete;

begin
 BodIsComplete(FindType($2258, Backpack));
end;

procedure RequestToMeCOntextMEnu;
begin
 //UseObject(GetParent($44759178));
 if GetParent(GetParent($400154F3)) > 0 then
  UseObject(GetParent(GetParent($400154F3)));
 RequestContextMenu($400154F3);
end;

procedure DateTimeTests;
var
 cTIme, pTime : TDateTime; 
 Hour, Min, Sec, MSec: Word;
begin
 cTIme := Now;
 //DecodeTime(cTime, Hour, Min, Sec, MSec); 
 Wait(3000);
 pTime := Now;
 cTime := Now - cTime; 
 DecodeTime(cTime, Hour, Min, Sec, MSec); 
 AddToSystemJournal(IntToStr(Hour) + ' ' + IntToStr(Min) + ' ' + IntToStr(Sec));
end;

function GetFoundItems(var Items: Array Of Cardinal): Integer;
var List: TStringList; i: Integer;
begin
  List := TStringList.Create;
  if GetFindedList(List) = False then Result := 0
  else begin
    SetLength(Items, List.Count);
    for i := 0 to Length(Items)-1 do Items[i] := StrToInt('$'+List.Strings[i]);
    Result := Length(Items);
  end;
  List.Free;
end; 

function GetIdFromTarget(str : String) : Cardinal;
begin
 Result := 0;
 
 ClientPrint(str);
 
 ClientRequestObjectTarget;
 while not ClientTargetResponsePresent do 
  wait(100);
  
 Result := ClientTargetResponse.Id; 
end;

procedure MoveSomeItem;
var
 Items : Array of Cardinal;
 Item, Cont : Cardinal;
 i, n : Integer;
begin
 Item := GetIdFromTarget('choose item');
 Cont := GetIdFromTarget('choose container'); 
 
 FindTypeEx(GetType(Item), GetColor(Item), GetParent(Item), False);
 n := FindCount;
 if GetFoundItems(Items) > 0 then
  for i := 0 to High(Items) do
   begin
    if Weight >= MaxWeight then
     begin
      ClientPrint('Overweight!');
      Break;
     end;
    ClientPrint('To move items remaining: ' + IntToStr(n-i));
    if MoveItem(Items[i], 0, Cont, 0,0,0) then
     Wait(600)
    else
     Wait(100);
   end;
end;

procedure CleanBackpack;
var
 Items : Array of Cardinal;
 Item, Cont : Cardinal;
 i, n : Integer;
begin
 //Item := GetIdFromTarget('choose item');
 Cont := GetIdFromTarget('choose container'); 
 
 //FindTypeEx(GetType(Item), GetColor(Item), GetParent(Item), False);
 FindType($FFFF, Backpack);
 n := FindCount;
 if GetFoundItems(Items) > 0 then
  for i := 0 to High(Items) do
   begin
    if Weight >= MaxWeight then
     begin
      ClientPrint('Overweight!');
      Break;
     end;
    ClientPrint('To move items remaining: ' + IntToStr(n-i));
    if MoveItem(Items[i], 0, Cont, 0,0,0) then
     Wait(600)
    else
     Wait(100);
   end;
end;


procedure ChangeStat;
begin
 SetStatState(0, 0)
end;

procedure MoveAtRange;
begin
 NewMoveXY(GetX($0000BAF8), GetY($0000BAF8), true, 8, true);
end;

procedure OpenBox;
begin
 UseObject($40A2A458);
end;

procedure FIndBackpack;
var Item : Cardinal;
begin
 Item := GetParent($40F2245E);
 CLientPrint(IntToHex(Item, 8));
 AddToSystemJournal(IntToHex(Item, 8));
end;

begin
end.                              

[Macks]

так, а что за проблема написать себе под дллку скриптик небольшой, по типу инжектовских аутолоадов

Скриптик я написал, но ему нужно указывать из какого контейнера в какой и предмет.
А тут вызывал команду, переложил итем и все остальные итемы полетели.

[drabadan]

так, а что за проблема написать себе под дллку скриптик небольшой, по типу инжектовских аутолоадов

Скриптик я написал, но ему нужно указывать из какого контейнера в какой и предмет.
А тут вызывал команду, переложил итем и все остальные итемы полетели.

2 раза таргетом сложно тыкнуть? в массмуве же так же будет...

[Macks]

так, а что за проблема написать себе под дллку скриптик небольшой, по типу инжектовских аутолоадов

Скриптик я написал, но ему нужно указывать из какого контейнера в какой и предмет.
А тут вызывал команду, переложил итем и все остальные итемы полетели.

2 раза таргетом сложно тыкнуть? в массмуве же так же будет...

Там таргетов нет.

[NoSilence]

Отсутствуют функции для работы с папками: DirectoryExists, CreateDir

[Vizit0r]

присутствуют, uses Sysutils;

[NoSilence]

присутствуют, uses Sysutils;

Там весь делфийский набор?

[Vizit0r]

нет, там весь дельфийский набор юнита SysUtils

[NoSilence]

После использования FindAtCoord в списке GetFindedList наблюдаются странности. Например, может "загулять" предмет с иными координатами.

[Vizit0r]

если повторяемо - тогда смогу исправить, иначе - вряд ли.