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

Tinkering_Necklace. Dragon World

Only working scripts
Post Reply
Unholy
Novice
Novice
Posts: 119
Joined: 23.06.2008 2:26
Location: DRW

Post by Unholy »

К стати есть еще один прикол)
Они крафтят, я плавлю айрон, тощу его домой так они с пола его забирают)))
Top
Expensive
Posts: 4
Joined: 11.07.2008 20:42
Location: DRW

Post by Expensive »

Пожалуйста выложите теперь готовый скрипт!
Top
Unholy
Novice
Novice
Posts: 119
Joined: 23.06.2008 2:26
Location: DRW

Post by Unholy »

Expensive wrote:Пожалуйста выложите теперь готовый скрипт!
Ну типа вот! У меня на нем 3 чара стоят уже 4-ые сутки. И все гуд!

Code: Select all


Program Tinker_Necklace;

const
Sunduk_With_Iron_and_Tools=$4025603E;
Sunduk_With_Empty_Bags=$4025603E;
Sunduk_With_Full_Bags=$403C2EA6;
Bag=$0E76;
Tools=$1EBC;
Ingot=$1BEF;
Pig=$09BB;
Necklace=$1085;

var
k, l : integer;
TimeStart : TDateTime;
Neck_Bag : Cardinal;


procedure Check_Necklace;
 begin
   FindType(Necklace,Backpack);
   if FindCount>0 then
     begin
       while FindCount <> 0 do
         begin
           l:=l+1;
           MoveItem(FindItem,1,Neck_Bag,0,0,0);
           wait(500);
           FindType(Necklace,Backpack);
         end;
     end;
 end;


procedure Get_Bag;
 begin
   FindType(Bag,Backpack);
   if FindCount=0 then
     begin
       UseObject(Sunduk_With_Empty_Bags);
       wait(1000);
       FindType(Bag,Sunduk_With_Empty_Bags);
       if FindCount>0 then
         begin
           MoveItem(FindItem,1,Backpack,0,0,0);
           wait(1000);
           UseObject(FindItem);
           wait(1000);
         end;
     end ;
   Neck_Bag:=FindType(Bag,Backpack);
 end;


procedure Out_Bag;
 begin
   FindType(Bag,Backpack);
   if FindCount>0 then
     begin
       MoveItem(FindItem,1,Sunduk_With_Full_Bags,0,0,0);
       wait(1000)
     end;
 end;


procedure Check_World_Save;
 begin
  if InJournal('saving')<>-1 then
   begin
    ClearJournal;
    k:=0;
    repeat
      wait(10000);
      k:=k+1;
      AddToSystemJournal('World is saving more than '+IntToStr(k*10)+' seconds.');
    until (InJournal('data')<>-1) or (k>30);
   end
 end;


procedure Check_Connect;
 begin
  if not Connected then
    while not Connected do
      begin
        Connect;
        wait(1000);
      end;
 end;


procedure Check_Iron;
 begin
  FindTypeEx(Ingot,$0000,Backpack,False);
  if (FindCount=0) OR (GetQuantity(FindItem)<5) then
    begin
      AddToSystemJournal('Добираем инги.');
      UseObject(Sunduk_With_Iron_and_Tools);
      wait(1000);
      FindTypeEx(Ingot,$0000,Sunduk_With_Iron_and_Tools,False);
      if (FindCount>0) and (GetQuantity(FindItem)>100) then
        begin
          MoveItem(FindItem,100,Backpack,0,0,0);
          wait(1000);
          AddToSystemJournal('Добрали 100 iron ingots. На данный момент имеем '+IntToStr(Count(Ingot))+' штук. Осталось ещё '+IntToStr(CountEx(Ingot,$0000,Sunduk_With_Iron_and_Tools))+' iron ingots. l='+IntToStr(l)+'; Count='+IntToStr(Count(Necklace))+';');
        end
      else
        AddToSystemJournal('Ошибка во время добора Iron Ignots.');
        exit;
    end
   FindType(Ingot,Ground);
   if FindCount>0 then
     begin
       MoveItem(FindItem,0,Sunduk_With_Iron_and_Tools,0,0,0);
       wait(500);
     end
 end;


procedure Check_Food;
 begin
  UseObject(Sunduk_With_Iron_and_Tools)
  wait(250);
  FindType(Pig,Sunduk_With_Iron_and_Tools);
  if FindCount>0 then
    begin
      MoveItem(FindItem,1,Backpack,0,0,0);
      wait(250);
      UseObject(FindItem);
      FindType(Pig,Backpack);
      if FindCount=0 then AddToSystemJournal('Покушали.');
      if FindCount>0 then MoveItem(FindItem,1,Sunduk_With_Iron_and_Tools,0,0,0);
    end
  else
    AddToSystemJournal('a Pig не был найден в сундуке.');
 end;


procedure Check_Last_Bag;
  begin
    FindType(Bag,Backpack);
    if FindCount>0 then
      begin
        UseObject(FindItem);
        wait(500)
        Neck_Bag:=FindType(Bag,Backpack); 
        FindType(Necklace,Neck_Bag);
        l:=FindCount;
        AddToSystemJournal('В мешке '+IntToStr(l)+' necklace.');
      end
  end; 


Begin
 UseObject(Sunduk_With_Iron_and_Tools);
 wait(1000);
 ClearJournal;
 CancelMenu;
 AutoMenu( 'Tinkering' , 'Jewelry' );
 AutoMenu( 'Jewelry' , 'necklace' );
 while not Dead do
   begin
     Check_Last_Bag;
     Get_Bag;
     repeat
       if Weight>500 then exit;
       Check_Iron;
       k:=0;
       TimeStart:=Now;
       UseObject(FindType(Tools,Backpack));
       repeat
         wait(100);
         k := k + 1;
         Check_World_Save;
       until (InJournalBetweenTimes('You put|failed', TimeStart, Now)<>-1) or (k > 300);
       wait(100);
       if InJournal('put')<>-1 then
         begin
           Check_Necklace;
         end
       ClearJournal;
     until l>=255 
     if l>=255 then
       begin
         l:=0;
         Out_Bag;
       end;
   end;
End.
Top
Kynep
Neophyte
Neophyte
Posts: 40
Joined: 29.05.2008 6:41

Post by Kynep »

Unholy wrote:
Expensive wrote:Пожалуйста выложите теперь готовый скрипт!
Ну типа вот! У меня на нем 3 чара стоят уже 4-ые сутки. И все гуд!
А после дисконекта? Или нескольких?
Top
v26RuS
Novice
Novice
Posts: 61
Joined: 18.05.2008 16:07
Location: DRW
Contact:
Contact v26RuS

Post by v26RuS »

Данный скрипт работает и после дисконекта проверено)
Невозможное возможнО!
Top
Kynep
Neophyte
Neophyte
Posts: 40
Joined: 29.05.2008 6:41

Post by Kynep »

v26RuS wrote:Данный скрипт работает и после дисконекта проверено)
ОК, а если у меня стоит один большой сундук и в нем лежит 2 пака, один пустой, второй с мешками и айроном. Все версии скрипта падали после нескольких дисков.
Top
Unholy
Novice
Novice
Posts: 119
Joined: 23.06.2008 2:26
Location: DRW

Post by Unholy »

Kynep wrote:
v26RuS wrote:Данный скрипт работает и после дисконекта проверено)
ОК, а если у меня стоит один большой сундук и в нем лежит 2 пака, один пустой, второй с мешками и айроном. Все версии скрипта падали после нескольких дисков.
Тогда в начале скрипта нужно вписать чтоб он открывал сначала 1 сундук(в котором паки) потом 1 пак, потом 2 пак.
Top
grundick
Developer
Developer
Posts: 272
Joined: 31.01.2008 21:16

Post by grundick »

не забываем что после каждого дисконекта сундуки надо заново открывать.
Top
grundick
Developer
Developer
Posts: 272
Joined: 31.01.2008 21:16

Post by grundick »

пробуем :)

Code: Select all

Program necklace;

{$Include 'all.inc'}

Const 
   Sunduk_With_Iron_and_Tools=$4023C9CD;     // сундук с айрон инготами и тинкер тулсами
   Sunduk_With_Empty_Bags=$401A2627;         // сундук с пустыми сумочками  
   Sunduk_With_Full_Bags=$401A24C1;          // сундук ,куда складываем заполненные сумочки
   Bag=$0E76;  
   Tools=$1EBC;
   Ingot=$1BEF;  //(DRW)
   Pig=$09BB; 
   MaxQnt=250;                               //максимальное кол-во никлейсов в сумке

Var 
   NeckType: array [0..1] of word;
   CurrentBag: cardinal;
   i: integer;

procedure Check_World_Save; 
  begin 
     if InJournal('saving')<>-1 then 
        begin 
        SetJournalLine(InJournal('saving'),'');
        SetJournalLine(InJournal('data'),'');
        i:=0; 
        repeat 
           wait(10000); 
           i:=i+1; 
           AddToSystemJournal('World is saving more than '+IntToStr(i*10)+' seconds.'); 
        until (InJournal('data')<>-1) or (i>30); 
        end; 
 end; 

procedure LoadIron;
Begin
If Dead Or (Not Connected) then Exit;
If Count(Ingot)<2 then 
    begin
    UseObject(Sunduk_With_Iron_and_Tools);
    CheckLag;
    Wait(1000);
    FindTypeEx(Ingot,$0000,Sunduk_With_Iron_and_Tools,false);
    If Not DragItem(FindItem,100) then  AddToSystemJournal('В сундуке кончились айрон инготы!');
    Wait(500);
    If (Weight>(STR*4)) then  
       begin
       DropItem(Sunduk_With_Iron_and_Tools,0,0,0);
       raiseException(erCustomError,'У НАС ЯВНЫЙ ПЕРЕГРУЗ!!!МЫ НЕ МОЖЕМ ВЗЯТЬ ИНГОТЫ!!!');
       end
    Else DropItem(backpack,0,0,0);
    end;
End;

procedure LoadTinkerTools;
Begin
If Dead Or (Not Connected) then Exit;
If Count(Tools)<1 then 
    begin
    UseObject(Sunduk_With_Iron_and_Tools);
    CheckLag;
    Wait(1000);
    If FindType(Tools,Sunduk_With_Iron_and_Tools)=0 then AddToSystemJournal('Не могу найти тинкер тулсу!')
    Else  Moveitem(FindItem,1,backpack,0,0,0);
    end;
End;

procedure CraftNecklace;
Var
   STime: TDateTime;
   FailCounter: integer;

Begin
Check_World_Save; 
Stime:=Now;
UseType(Tools,$FFFF);
AutoMenu('Tinkering','Jew'); 
AutoMenu('Jew','neck');
WaitJournalLine(STime,'You put|failed',30000);
wait(200);
   If (InJournalBetweenTimes('failed',Stime,Now)<>-1) then FailCounter:=(FailCounter+1);
   If (InJournalBetweenTimes('You put',Stime,Now)<>-1) then FailCounter:=0;
   If FailCounter>=20 then Wait(30000);
End;

procedure FindEmptyBag;
var
TempBag: cardinal;
SumQnt: integer;

Begin
UseObject(Sunduk_With_Empty_Bags);
CheckLag;
Wait(1000);
FindType(bag,Sunduk_With_Empty_Bags);
   While FindCount>0 do
       begin
       If Dead or (Not Connected) then Exit;
       Check_World_Save; 
       TempBag:=FindItem;
       UseObject(FindItem);
       CheckLag;
       Wait(1000);
       SumQnt:=CountEx(NeckType[0],$FFFF,TempBag)+CountEx(NeckType[1],$FFFF,TempBag);
       If (SumQnt<MaxQnt) then                                                 
           begin
	   AddToSystemJournal('запоминаем пустую сумочку...');
           CurrentBag:=TempBag; 
	   Exit;
	   end
        else
	   begin
	   AddToSystemJournal('Найденная сумочка забита до отказа!Перекладываем в сундук с заполненными сумками.');
	   MoveItem(TempBag,1,Sunduk_With_Full_Bags,0,0,0); 
	   Wait(1000);
	   end;
       FindType(bag,Sunduk_With_Empty_Bags);
       wait(200);
       end;
    If (FindCount<1) then raiseException(erCustomError,'Свободных сумочек больше нету.останавливаем скрипт.')
End;


procedure UnLoadNecklace;
Begin
If CurrentBag=0 then FindEmptyBag;
If (Weight>(4*Str-100)) or ((Count(NeckType[0])+Count(NeckType[1]))>=MaxQnt) then      
    begin
    UseObject(Sunduk_With_Empty_Bags);
    CheckLag;
    Wait(1000);
    UseObject(CurrentBag);
    CheckLag;
    Wait(1000);
    For i:=0 to 1 do 
         repeat 
         If Dead Or (Not Connected) then Exit;
	 Check_World_Save; 
         If (CountEx(NeckType[0],$FFFF,CurrentBag)+CountEx(NeckType[1],$FFFF,CurrentBag))>=MaxQnt then             
	     begin
	     AddToSystemJournal('Сумку заполнили полностью!Перекладываем в сундук с заполненными сумками.');
	     MoveItem(CurrentBag,1,Sunduk_With_Full_Bags,0,0,0); 
	     Wait(1000);
	     FindEmptyBag;
	     end;

	 FindType(NeckType[i],Backpack); 
         if FindCount>0 then 
            begin 
            MoveItem(FindItem,1,CurrentBag,0,0,0); 
            CheckLag; 
            end; 
         until  (FindType(NeckType[i],Backpack)=0); 
    end;
End;

BEGIN
NeckType[0]:=$1086;
NeckType[1]:=$1085; 

WaitConnection(3000);
SetARStatus(true);

While not Dead do
    begin
    If Connected then 
        begin
	LoadIron;
	LoadTinkerTools;
	CraftNecklace;
	UnloadNecklace;
	end
    Else Wait(3000);
    end;
END.
Top
Edred
Moderator
Moderator
Posts: 559
Joined: 28.03.2006 21:29

Post by Edred »

grundick wrote:не забываем что после каждого дисконекта сундуки надо заново открывать.
Смотрим мои крафтовые скрипты и изучаем процедуру OpenContainer(). Она именно для этого и предназначена. Для переоткрывания контейнеров если был реконнект.
Top
grundick
Developer
Developer
Posts: 272
Joined: 31.01.2008 21:16

Post by grundick »

Ok :roll:

Code: Select all

Program necklace;

{$Include 'all.inc'}

Const 
   Sunduk_With_Iron_and_Tools=$4023C9CD;     // сундук с айрон инготами и тинкер тулсами
   Sunduk_With_Empty_Bags=$401A2627;         // сундук с пустыми сумочками  
   Sunduk_With_Full_Bags=$401A24C1;          // сундук ,куда складываем заполненные сумочки
   Bag=$0E76;  
   Tools=$1EBC;
   Ingot=$1BEF;  //(DRW)
   Pig=$09BB; 
   MaxQnt=250;                               //максимальное кол-во никлейсов в сумке

Var 
   NeckType: array [0..1] of word;
   CurrentBag: cardinal;
   i: integer;
   LastContOpen: TDateTime;

procedure Check_World_Save; 
  begin 
     if InJournal('saving')<>-1 then 
        begin 
        SetJournalLine(InJournal('saving'),'');
        SetJournalLine(InJournal('data'),'');
        i:=0; 
        repeat 
           wait(10000); 
           i:=i+1; 
           AddToSystemJournal('World is saving more than '+IntToStr(i*10)+' seconds.'); 
        until (InJournal('data')<>-1) or (i>30); 
        end; 
 end; 

procedure LoadIron;
Begin
If Dead Or (Not Connected) then Exit;
If Count(Ingot)<2 then 
    begin
    FindTypeEx(Ingot,$0000,Sunduk_With_Iron_and_Tools,false);
    If Not DragItem(FindItem,100) then  AddToSystemJournal('В сундуке кончились айрон инготы!');
    Wait(500);
    If (Weight>(STR*4)) then  
       begin
       DropItem(Sunduk_With_Iron_and_Tools,0,0,0);
       raiseException(erCustomError,'У НАС ЯВНЫЙ ПЕРЕГРУЗ!!!МЫ НЕ МОЖЕМ ВЗЯТЬ ИНГОТЫ!!!');
       end
    Else DropItem(backpack,0,0,0);
    end;
End;

procedure LoadTinkerTools;
Begin
If Dead Or (Not Connected) then Exit;
If Count(Tools)<1 then 
    begin
    If FindType(Tools,Sunduk_With_Iron_and_Tools)=0 then AddToSystemJournal('Не могу найти тинкер тулсу!')
    Else  Moveitem(FindItem,1,backpack,0,0,0);
    end;
End;

procedure CraftNecklace;
Var
   STime: TDateTime;
   FailCounter: integer;

Begin
Check_World_Save; 
Stime:=Now;
UseType(Tools,$FFFF);
AutoMenu('Tinkering','Jew'); 
AutoMenu('Jew','neck');
WaitJournalLine(STime,'You put|failed',30000);
wait(200);
   If (InJournalBetweenTimes('failed',Stime,Now)<>-1) then FailCounter:=(FailCounter+1);
   If (InJournalBetweenTimes('You put',Stime,Now)<>-1) then FailCounter:=0;
   If FailCounter>=20 then Wait(30000);
End;

procedure FindEmptyBag;
var
TempBag: cardinal;
SumQnt: integer;

Begin
FindType(bag,Sunduk_With_Empty_Bags);
   While FindCount>0 do
       begin
       If Dead or (Not Connected) then Exit;
       Check_World_Save; 
       TempBag:=FindItem;
       UseObject(FindItem);
       CheckLag;
       Wait(1000);
       SumQnt:=CountEx(NeckType[0],$FFFF,TempBag)+CountEx(NeckType[1],$FFFF,TempBag);
       If (SumQnt<MaxQnt) then                                                 
           begin
	   AddToSystemJournal('запоминаем пустую сумочку...');
           CurrentBag:=TempBag; 
	   Exit;
	   end
        else
	   begin
	   AddToSystemJournal('Найденная сумочка забита до отказа!Перекладываем в сундук с заполненными сумками.');
	   MoveItem(TempBag,1,Sunduk_With_Full_Bags,0,0,0); 
	   Wait(1000);
	   end;
       FindType(bag,Sunduk_With_Empty_Bags);
       wait(200);
       end;
    If (FindCount<1) then raiseException(erCustomError,'Свободных сумочек больше нету.останавливаем скрипт.')
End;

procedure OpenContainer(f : boolean); 
   // если f - true - просто открываем все нужные контейнеры, то есть: 
   // SundukIngots,SundukEmptyBag,Sunduk2Craft и curbag (если он не равен 0) 
   // если f - false - проверяем, был ли реконнект чара после последнего 
   // открывания контейнеров, если был - переоткрываем контейнеры и записываем 
   // новое значение в переменную LastContOpen, если не был - ничего не делаем 
Begin
If Dead or (Not Connected) then Exit;
if (f = true) or (LastContOpen < ConnectedTime) then 
    begin 
         UseObject(Sunduk_With_Empty_Bags); 
         wait(1000); 
         Check_World_Save; 
         UseObject(Sunduk_With_Full_Bags); 
         wait(1000); 
         Check_World_Save; 
         UseObject(Sunduk_With_Iron_and_Tools);
	 wait(1000);
	 Check_World_Save;
	 if CurrentBag <> 0 then 
             begin 
             UseObject(CurrentBag); 
             wait(1000); 
             Check_World_Save; 
             end
	 Else
	     FindEmptyBag;
         LastContOpen := Now; 
         addtosystemjournal('Контейнеры открыты в ' + DateTimeToStr(Now)); 
      end; 
End;

procedure UnLoadNecklace;
Begin
If (Weight>(4*Str-100)) or ((Count(NeckType[0])+Count(NeckType[1]))>=MaxQnt) then      
    begin
    For i:=0 to 1 do 
         repeat 
         If Dead Or (Not Connected) then Exit;
	 Check_World_Save; 
         If (CountEx(NeckType[0],$FFFF,CurrentBag)+CountEx(NeckType[1],$FFFF,CurrentBag))>=MaxQnt then             
	     begin
	     AddToSystemJournal('Сумку заполнили полностью!Перекладываем в сундук с заполненными сумками.');
	     MoveItem(CurrentBag,1,Sunduk_With_Full_Bags,0,0,0); 
	     Wait(1000);
	     FindEmptyBag;
	     end;

	 FindType(NeckType[i],Backpack); 
         if FindCount>0 then 
            begin 
            MoveItem(FindItem,1,CurrentBag,0,0,0); 
            CheckLag; 
            end; 
         until  (FindType(NeckType[i],Backpack)=0); 
    end;
End;

BEGIN
NeckType[0]:=$1086;
NeckType[1]:=$1085; 

WaitConnection(3000);
SetARStatus(true);
LastContOpen:=Now;
OpenContainer(true);

While not Dead do
    begin
    If Connected then 
        begin
	OpenContainer(false);
	LoadIron;
	LoadTinkerTools;
	CraftNecklace;
	UnloadNecklace;
	end
    Else Wait(3000);
    end;
END.
Last edited by grundick on 27.10.2008 21:06, edited 1 time in total.
Top
Kynep
Neophyte
Neophyte
Posts: 40
Joined: 29.05.2008 6:41

Post by Kynep »

Роняет он неки, хоть убей. Без дисконектов и прочего. Щас собрал штук 25 за 30 минут работы. Кароч, дело такое, чар с мешком в паке, пускаю скрипт, наполняет пак и начинает кидать на пол. Т.е. он не видит мешок после реконекта.
Top
Nasty Nay
Neophyte
Neophyte
Posts: 27
Joined: 02.07.2008 19:07

Post by Nasty Nay »

а у меня пишет ошибка при донаборе айрона((
Top
Nasty Nay
Neophyte
Neophyte
Posts: 27
Joined: 02.07.2008 19:07

Post by Nasty Nay »

блин все работало, ушла на работу пришла, и теперь не хочет добирать инги айрона что делать подскажите((( помогите!!((
Top
ShraM
Neophyte
Neophyte
Posts: 15
Joined: 07.07.2008 2:26

Post by ShraM »

grundick wrote:Ok :roll:

Code: Select all

2:06:59 [Jack ]: Character Unknown Name Connected.
2:07:27 [Jack ]: Compiling
2:07:27 [Jack ]: Compiler: [Error] (TEST NEC!!!!.sc at 94:8):  Unknown identifier 'CheckLag'
2:07:27 [Jack ]: Compiling failed
2:07:27 [Jack ]: Script TEST NEC!!!!.sc stoped successfuly
2:07:52 [Jack ]: Compiling
2:07:52 [Jack ]: Compiler: [Error] (TEST NEC!!!!.sc at 94:8):  Unknown identifier 'CheckLag'
2:07:52 [Jack ]: Compiling failed
2:07:52 [Jack ]: Script TEST NEC!!!!.sc stoped successfuly
2:09:59 [Jack ]: Compiling
2:09:59 [Jack ]: Compiler: [Error] (TEST NEC!!!!.sc at 94:8):  Unknown identifier 'CheckLag'
2:09:59 [Jack ]: Compiling failed
2:09:59 [Jack ]: Script TEST NEC!!!!.sc stoped successfuly
2:10:00 [Jack ]: Compiling
2:10:00 [Jack ]: Compiler: [Error] (TEST NEC!!!!.sc at 94:8):  Unknown identifier 'CheckLag'
2:10:00 [Jack ]: Compiling failed
2:10:00 [Jack ]: Script TEST NEC!!!!.sc stoped successfuly
Top
Post Reply

Return to “Scripts”