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

куплю скрипт

Only working scripts
Post Reply
alexandr
Neophyte
Neophyte
Posts: 17
Joined: 15.02.2016 20:04

куплю скрипт

Post by alexandr »

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

Re: куплю скрипт

Post by drabadan »

Точно не помню как там, что работало - разбирайся.

Code: Select all

Program Heartwood;


uses
 Gumps;

var
 Runebook : Cardinal; 
 BowCount, indx : Integer;
 GTime, StartTime : TDateTime;
 GWeight, PrevLogs{, TotalBows} : Integer;
 RestartScript : Boolean;
 
 Colors : Array of Word; 
 
 {config vars}
 AtHomePoint : TPoint;
 AtVendorsPoint : TPoint;
 Recalls : Array of Byte;
 
 
const 
 Lag = 600;
 PrizeBag = $4093494D; 
 LoadBag = $4093494E;   
 
procedure SetConfig(CharName : String);
begin
 case CharName of
  'JippersCrippers' :
   begin
    AtVendorsPoint.X := 7040;
    AtVendorsPoint.Y := 378;
    AtHomePoint.X := 2169;
    AtHomePoint.Y := 882;
    Recalls := [11,23];
   end;
  'Bifur' :
   begin
    AtVendorsPoint.X := 7040;
    AtVendorsPoint.Y := 378;
    AtHomePoint.X := 2169;
    AtHomePoint.Y := 882;
    Recalls := [11,23];
   end;
  'Drabadanter' :
   begin
    AtVendorsPoint.X := 7040;
    AtVendorsPoint.Y := 378;
    AtHomePoint.X := 2169;
    AtHomePoint.Y := 882;
    Recalls := [7,13];
   end;
  'Driller' :
   begin
    AtVendorsPoint.X := 7040;
    AtVendorsPoint.Y := 378;
    AtHomePoint.X := 2169;
    AtHomePoint.Y := 882;
    Recalls := [7,13];
   end; 
  'Melnik' :
   begin
    AtVendorsPoint.X := 7040;
    AtVendorsPoint.Y := 378;
    AtHomePoint.X := 2169;
    AtHomePoint.Y := 882;
    Recalls := [17,23];
   end;
  'Dwalin' :
   begin
    AtVendorsPoint.X := 7040;
    AtVendorsPoint.Y := 378;
    AtHomePoint.X := 2169;
    AtHomePoint.Y := 882;
    Recalls := [7,13];
   end;   
 end;
end;
 
procedure WaitLag;
begin
 Wait(Lag);
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; 
 
procedure StartSystem;
begin
 Runebook := FindType($22C5, Backpack); 
end;

procedure CastRecall(Where : Integer);
var
 currX : Integer;
 i : Integer; 
begin 
 currX := GetX(Self);
 //while GetX(Self) = currX do
  //begin
   if RestartScript then Exit;
   UseObject(Runebook);
   WaitLag;
   NumGumpButton(GetGumpsCount-1, Where); 
   for i := 0 to 70 do
    begin
     if GetX(Self) <> CurrX then
      Break;
     Wait(100);
    end;
   Wait(2000);
  //end;
end;     

procedure RecallTo(Where : String);
begin
 case Where of
  'Bank' : CastRecall(5);
  'Yew'  : CastRecall(Recalls[0]);   
  'Home' : CastRecall(Recalls[1]);
 end;
end;

procedure MoveTo(Where : String);
begin
 ClearBadLocationList;
 case Where of
  'Heartwood' :
   begin
    if Getx(Self) < 6000 then
     begin
      RecallTo('Yew'); 
      NewMoveXY(535, 992, true, 0, true); //vhod v portal
     end;
    WaitLag;
    Wait(2000);
    NewMoveXY(AtVendorsPoint.X, AtVendorsPoint.y, true, 1, true); //kvesteru
    WaitLag;
   end;
  'Home' : 
   begin    
    while GetX(Self) > 6000 do 
     begin 
      ClearBadLocationList;
      if RestartScript then Exit;
      NewMoveXY(6984, 339, true, 0, true); //vuhod iz heartwood
      FindType($3967, Ground);
      if FindItem > 0 then
       NewMoveXY(Getx(FindItem), GetY(FindItem), true, 0, true);
     end;    
    WaitLag;
    Wait(2000);
    UOSay('Guards');
    if GetX(Self) < 5000 then
     RecallTo('Home')
    else
     MoveTo(Where);
    WaitLag;
    Wait(1000);   
   end;
 end;
end;
 
procedure GetQuest; 
var
 bool : Boolean;
 gi : TGumpInfo;
begin
 {if not hidden then
 repeat
  UseSkill('Hiding');
  Wait(7000);
 until Hidden;}
 
 bool := False;
 if RestartScript then Exit;
 repeat  
  UseObject($00000677);
  WaitLag;
  if wait_for_gump($4C4C6DB0, 3000) then
   begin
    GetGumpInfo(GetGumpsCount-1, gi);    
    if Length(gi.XmfHTMLGumpColor) > 0 then
     if (GetClilocById(gi.XmfHTMLGumpColor[1].Cliloc_Id) = 'A Simple Bow') then     
      bool := True;
   end;
 until bool;
 PushGumpButton(GetGumpsCount-1, 'Quest Offer', 95, 395, 4);    
end;


procedure LoadBows(Count : Integer);
begin
 NewMoveXY(GetX(PrizeBag), GetY(PrizeBag), true, 1, true);
 UseObject(LoadBag);
 WaitLAg;
 AddToSystemJournal('Loading bows: ' + TimeToStr(Now));
 repeat
  if FindType($13B2, LoadBag) > 0 then
   begin
    if MoveItem(FindType($13B2, LoadBag), 1, Backpack, 0,0,0) then
     WaitLag
    else
     LoadBows(Count);
   end
  else
   //AddToSystemJournal('No bows at load bag!');
   Wait(1000);
  //WaitLag;
  FindType($13B2, Backpack);
 until FindCount >= Count; 
end;
   
procedure Unload;
//var
 {LootTypes : Array of Word;
 i,k : Integer;
 Items : Array of Cardinal;}
begin
 NewMoveXY(AtHomePoint.X, AtHomePoint.Y, true, 1, true);
 if GetZ(Self) > 9 then
  repeat 
   ClearBadLocationList;
   NewMoveXY(2171, 893, true, 1, true);
   NewMoveXY(GetX(PrizeBag), GetY(PrizeBag), true, 1, true);
  until GetZ(Self) < 15;
 {UseObject(PrizeBag); 
 WaitLag;}
 {if RestartScript then Exit;
 LootTypes := [$1022, $2F58, $2F5A, $2F59, $2F5B];
 FindType($FFFF, Backpack);
 if GetFoundItems(Items) > 0 then
  for i := 0 to Length(Items)-1 do
   for k := 0 to Length(LootTypes)-1 do
    if GetType(Items[i]) = LootTypes[k] then
     begin
      if RestartScript then Exit;
      if k = 0 then
       if GetColor(Items[i]) = $0000 then Continue;
      MoveItem(Items[i], 1, PrizeBag, 1,1,1);
      WaitLag;
     end;}
 while FindType($1022, Backpack) > 0 do
  if MoveItem(FindItem, 0, PrizeBag, 0,0,0) then
    Wait(600); 
end;

function CountTime(Time : TDateTime) : Double;
var
 Hour, Min, Sec, MSec: Word;
begin
 Result := 0;
 DecodeTime(Time, Hour, Min, Sec, MSec);
 if Hour > 0 then
  Result := (Hour * 60)*60;
 if Min > 0 then
  Result := Result + (Min*60);
 if Sec > 0 then
  Result := Result + Sec;
 AddToSystemJOurnal(FloatToStr(Result)); 
end;

procedure ToggleQuestItem;
var
 gi : TGumpInfo;
 i : Integer;
 //tmpCont : Cardinal;
begin
 if RestartScript then Exit;
 //tmpCount := FindType($0E79, Backpack);
 
 if Self = $000037FE then SetContextMenuHook(Self, 6) else  SetContextMenuHook(Self, 5);
 RequestContextMenu(Self);
 i := 0;                                 
 WaitLag;
 
 
  repeat
   //RequestContextMenu(Self); 
   if WaitForTarget(1000) then
    begin
     TargetToObject(FindTypeEx($13B2, 0000, backpack, True));
     //WaitLag;
     Wait(50);
     i := i + 1;
     FindTypeEx($13B2, $04EA, Backpack, True);
    end
   else
    RequestContextMenu(Self);
  until FindFullQuantity >= 10;
  
 CancelTarget;
 if TargetPresent then TargetToObject(Self);
 WaitLag;
 UseObject($00000677);
 if wait_for_gump($4C4C6DB0, 3000) then
  begin
   WaitLag;
   GetGumpInfo(GetGumpsCount-1, gi); 
   if Length(gi.GumpButtons) >= 2 then
    NumGumpButton(GetGumpsCount-1, gi.GumpButtons[1].return_value);
   if wait_for_gump($4C4C6DB0, 3000) then 
    begin
     GetGumpInfo(GetGumpsCount-1, gi);
     if Length(gi.GumpButtons) > 0 then
      NumGumpButton(GetGumpsCount-1, gi.GumpButtons[0].return_value);
    end;    
  end
 else
  ToggleQuestItem;
 IgnoreReset;
 ClearContextMenu;
end;

function CheckItemProps(Item : Cardinal) : Boolean;
var
 Props : Array of String;
 i : Integer;
begin
 Result:= False;
 Props := ['recovery 3',
           'casting 3',
           'cost 10%',
           'cost 11%',
           'cost 12%',
           'cost 13%',
           'cost 14%',
           'cost 15%',
           'cost 16%',
           'cost 17%',
           'cost 18%',
           'cost 19%',
           'cost 20%',
           'repond',
           'regeneration',
           'chance increase'           
          ];
          
 for i := 0 to Length(Props)-1 do
  if (BmSearch(1,AnsiLowerCase(GetToolTip(Item)), Props[i]) > 0) then
   Result := True;
 
end;

procedure NewLooter(Container : Cardinal);
var
 i : Integer;
begin
 UseObject(Container);
 WaitLag;
 for i := Low(Colors) to High(Colors) do
  if FindTypeEx($1022, Colors[i], Container, False) > 0 then
   if MoveItem(FindItem, 0, Backpack, 0,0,0) then
    begin
     Wait(600);
     FillNewWindow('Got a ' + GetToolTip(FindItem) + ' at: ' + TimeToStr(Now));
    end; 
end;

procedure LootHandler(Container : Cardinal);
var                                                
 LootTypes : Array of Word;
 Items : Array of Cardinal; 
 i, k : Integer; 
begin
 if RestartScript then Exit;
 LootTypes := [$1022{, $2F58, $2F5A, $2F59, $2F5B}];
 UseObject(Container);
 WaitLag;
 //Wait(1000);
 FindType($FFFF, Container);
 if GetFoundItems(Items) > 0 then
  for i := 0 to Length(Items)-1 do 
   begin
    //FillNewWindow('Got reward: ' + GetToolTip(Items[i]));  
    for k := 0 to Length(LootTypes)-1 do      
     if GetType(Items[i]) = LootTypes[k] then
      begin
       if CheckItemProps(Items[i]) then
        begin
         MoveItem(Items[i], 1, Backpack, 0,0,0);
         WaitLag;
        end;
       if (GetType(Items[i]) = LootTypes[0]) then
        if (GetColor(Items[i]) = $04A9) or (GetColor(Items[i]) = $04A8) then
         begin
          MoveItem(Items[i], 1, Backpack, 0,0,0);
          FillNewWindow('Got reward! TOOL. ' + GetToolTip(Items[i]) + ' ' + TimeToStr(Now));
          WaitLag;
         end; 
        if (BMSearch(1, GetToolTip(Items[i]), 'Heartwood') > 0) then
         AddToSystemJournal('Got runic!');
        //if (k > 0) then
        if (BMSearch(1, AnsiLowerCase(GetToolTip(Items[i])), 'bonus: 30') > 0){ or
          (BMSearch(1, AnsiLowerCase(GetToolTip(Items[i])), 'bonus: 29') > 0) or
          (BMSearch(1, AnsiLowerCase(GetToolTip(Items[i])), 'bonus: 28') > 0) }then
         begin       
          MoveItem(Items[i], 1, Backpack, 0,0,0);
          WaitLag;
        //AddToSystemJournal('Got reward: ' + GetToolTip(Items[i]));      
         end;
      end;
   end;     
end;                    

function BowsCheck : Boolean;
begin
 Result := False;
 FindType($13B2, Backpack);
 if FindCount > 10 then
  Result := True;   
end;

procedure MainProc;
var
 i : Integer;
begin
 for i := 0 to GetGumpsCount-1 do
  CloseSimpleGump(i);
 GWeight := Weight;
 GTime := Now; 
 while not RestartScript do  
  begin 
   //AddToSystemJournal(IntToStr(((MaxWeight-70)/6)))
   WaitLag;
   FindType($13B2, Backpack);
   BowCount := FindCount;
   if not BowsCheck then
    begin
     while (Getx(self) > 2200) or (GetX(Self) < 1500) do
      MoveTo('Home');
     Unload;
     LoadBows((MaxWeight - Weight - 20)/6);
    end; 
   while (GetX(Self) < 6000) or (Dist(7040, 378, GetX(Self), GetY(Self))>2) do
    MoveTo('Heartwood');
   for indx := 0 to (BowCount/10)-1 do
    begin
     GetQuest;
     ToggleQuestItem;
     WaitLag;
    end;
   while FindType(GetType(Backpack), Backpack)>0 do
    begin
     //WaitLag;
     //LootHandler(FindItem);
     NewLooter(FindItem);
     WaitLag;
     MoveItem(FindType(GetType(Backpack), Backpack), 1, $40CD9538, 0,0,0);
     WaitLag;
    end;
  end; 
end;

procedure OnSpeech(Text,SenderName : String; SenderId : Cardinal);
begin
 if Text = 'The world is saving, please wait.' then
  WaitJournalLine(Now, 'World save complete.', 20000); 
end; 


begin
 SetEventProc(evUnicodeSpeech, 'OnSpeech');
 IgnoreReset;
 StartSystem;
 //MoveTo('Bank'); 
 AddGumpIgnoreBySerial($30AAC19);
 RestartScript := False; 
 StartTime := Now;
 PrevLogs := 0;
 MoveOpenDoor := True; 
 MoveThroughNPC := 1;
 MoveCheckStamina := Stam/2;
 SetConfig(GetName(Self));
 Colors := [$04A9, $04A8];
 
 //LootHandler(FindType(GetType(Backpack), Backpack)); 
 while True do 
  begin
   RestartScript := False;
   MainProc;
   Wait(50);
  end; 
end.

alexandr
Neophyte
Neophyte
Posts: 17
Joined: 15.02.2016 20:04

Re: куплю скрипт

Post by alexandr »

спс,попробую может что и получится!)а можешь пжлст принцип его описать !?
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: куплю скрипт

Post by drabadan »

alexandr wrote:спс,попробую может что и получится!)а можешь пжлст принцип его описать !?
нет, это же бесплатный скрипт.
Вчитайся перенастрой и гоняй.

З.Ы. Да и не помню я уже чо там к чему. Лут фильтрует, 1 скрипт на несколько ботов, для каждого свой конфиг.
У меня было так, что 3 чара стояло крафтило в сумку луки а 5 бегало их сдавало, 1 из лесорубов носил борды между сумкой лесорубов и сумкой с регами для крафтеров. То-есть 4 рубило один из них получал команды по доставке дров если тех мало было, 3 крафтили луки, 5 ходили сдавали в хартвуд. Сдавальщики морфались в привидение и брали квесты только на луки. А луков они брали полный пак 200 щемто штук, чтоб сразу 20 раз квест сдать, всякую хуйню выкидывали в треш. Вспомнилось епте.
alexandr
Neophyte
Neophyte
Posts: 17
Joined: 15.02.2016 20:04

Re: куплю скрипт

Post by alexandr »

спасибо тебе добрый человек!)
alexandr
Neophyte
Neophyte
Posts: 17
Joined: 15.02.2016 20:04

Re: куплю скрипт

Post by alexandr »

можешь тогда еще гампы скинуть!?инклюд вроде гампов,на форуме не нашел.
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: куплю скрипт

Post by drabadan »

Code: Select all

unit Gumps;

interface

function PushGumpButton(GumpIndex : ShortInt; GumpText : String; X, Y, Return_Value : Integer) : Boolean;
function wait_for_gump(gump_id,wait_time_ms : integer) : boolean;

implementation

function PushGumpButton(GumpIndex : ShortInt; GumpText : String; X, Y, Return_Value : Integer) : Boolean;
var
 GI : TGumpInfo;
 TextFound, ButtonFound : Boolean;
 ButtonIndex, i : Integer;
begin
 GetGumpInfo(GumpIndex, GI);
 Wait(50); 
 {if Length(GI.XmfHTMLGumpColor) > 0 then
  for i := 0 to Length(GI.XmfHTMLGumpColor)-1 do
   begin
    //AddToSystemJournal(GetClilocById(GI.XmfHTMLGumpColor[i].Cliloc_Id));
    if GumpText = GetClilocById(GI.XmfHTMLGumpColor[i].Cliloc_Id) then
    begin
	 TextFound := True; 
	 Break;
	end;
  end;}
 TextFound := True; 
 if Length(GI.GumpButtons) > 0 then
  for i := 0 to Length(GI.GumpButtons)-1 do
  begin
   //AddToSystemJournal(IntToStr(GI.GumpButtons[i].Return_Value));
   if (X = GI.GumpButtons[i].X) and (Y = GI.GumpButtons[i].Y) and (Return_Value = GI.GumpButtons[i].Return_Value) then
    begin
	 ButtonIndex := i;
	 ButtonFound := True;
	 Break;
	end;
  end;
 
 if TextFound and ButtonFound then
  begin
   NumGumpButton(GumpIndex, GI.GumpButtons[ButtonIndex].return_value);
   //AddToSystemJournal('Pushed the button!');
   Result := True;
  end;
 {if not TextFound then
  AddToSystemJournal('Text not found!');
 if not ButtonFound then
  AddToSystemJournal('Button not found!');}
end;

function wait_for_gump(gump_id,wait_time_ms : integer) : boolean;
var 
 wait_cycle : integer;
begin
 if dead or not connected then exit;
  repeat
   if getgumpid(getgumpscount-1) = gump_id then
    begin     
     result := true;
     break;
    end;
   wait(50);
   CheckLag(60000);
   inc(wait_cycle);
  until wait_cycle >= (wait_time_ms/50);
end;

end.
alexandr
Neophyte
Neophyte
Posts: 17
Joined: 15.02.2016 20:04

Re: куплю скрипт

Post by alexandr »

вроде разобрался спс
alexandr
Neophyte
Neophyte
Posts: 17
Joined: 15.02.2016 20:04

Re: куплю скрипт

Post by alexandr »

что означают цифры (Recalls := [11,23]) 11 и 23????
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: куплю скрипт

Post by drabadan »

alexandr wrote:что означают цифры (Recalls := [11,23]) 11 и 23????
а хз, наверно руны в рунбуках. То-есть первая поидее домой, вторая в хартвуд.
Post Reply