Наслоение менюшек

[aalexx]

Доброго вечера. Подошла пора для прокачки карпентри. Ничего толкового не нашёл, пришлось переделывать... Насобирал вот такую ахинею, которая ,вроде, работает, но , когда делает вещь, не хочет закрывать менюшки и они набираются пачками и начинаются тормоза. Буду рад подсказке, как решить проблему.

Code: Select all

Program Carpentry;

{$Include 'all.inc'}

const
Sunduk=$40311AFE;
Tools=$1033;
log=$1BDD;
eda=$097B;
Izdelie=$0DBF;
Trash=$404DF27F;
color=$-1;


var
k, l : integer;
TimeStart : TDateTime;

procedure Check_Izdelie;
 begin
   FindType(Izdelie,Backpack);
   if FindCount>0 then
     begin
       MoveItem(FindItem,1,Trash,0,0,0);
       wait(500);
     end
 end;
 
 procedure Check_Connect;
 begin
  if not Connected then
    while not Connected do
      begin
        Connect;
        wait(1000);
      end
 end;
 
 procedure Check_logs;
 begin
  FindType(log,Backpack);
  if (FindCount=0) OR (Count(log)<1) then
    begin
      UseObject(Sunduk);
      wait(1000);
      FindType(log,Sunduk);
      if (FindCount>0) and (CountEx(log,color,Sunduk)>1) then
        begin
          MoveItem(FindType(log,Sunduk),100,Backpack,0,0,0);
          wait(1000);
          AddToSystemJournal('Добрали 100 логов. На данный момент имеем '+IntToStr(Count(log))+' штук. Осталось ещё '+IntToStr(CountEx(log,color,Sunduk))+' Логов. l='+IntToStr(l)+'; Count='+IntToStr(Count(Izdelie))+';');
        end
      else
        AddToSystemJournal('Ошибка во время добора Логов.');
        exit;
    end;
   FindType(log,Ground);
   if FindCount>0 then
     begin
       MoveItem(FindItem,0,Sunduk,0,0,0);
       wait(500);
     end
 end;
 
 procedure Check_Food;
 begin
  UseObject(Sunduk)
  wait(250);
  FindType(eda,Sunduk);
  if FindCount>0 then
    begin
      MoveItem(FindItem,1,Backpack,0,0,0);
      wait(250);
      UseObject(FindItem);
      FindType(eda,Backpack);
      if FindCount=0 then AddToSystemJournal('Покушали.');
      if FindCount>0 then MoveItem(FindItem,1,Sunduk,0,0,0);
    end
  else
    AddToSystemJournal('Еда не нашлась в сундуке в сундуке.');
 end;
 
 procedure Check_Tools;
  begin
    FindType(Tools,backpack);
    if FindCount=0 then
      begin
        FindType(Tools,Sunduk);
   if FindCount > 0 then
        begin
        moveitem(FindItem,1,backpack,0,0,0);
        end
      end
  end; 

Begin
 ClearJournal;
 CancelMenu;
 AutoMenu( 'Carpentry' , 'Weapons & Tools' );
 AutoMenu( 'Weapons & Tools' , 'fishing pole' );
 FindDistance:=1;
 while not Dead do
   begin
useobject(sunduk);
wait(1000);
useobject(Trash);
wait(1000);
     Check_Tools;
     repeat
       Check_logs;
       k:=0;
       TimeStart:=Now;
       UseObject(FindType(Tools,Backpack));
       repeat
         wait(100);
         checksave;
       until (InJournalBetweenTimes('You put|fail', TimeStart, Now)<>-1);
       wait(500);
    if InJournal('put')<>-1 then
         begin
Check_Izdelie;
         end;
       ClearJournal;
     until l=255 
     if l=255 then
      begin
         l:=0;
       end;
   end;   
End.

По такому же принципу насобирал простенький скрипт на тинкер и та же проблема - менюшки

Code: Select all

Program Tinker;

{$Include 'all.inc'}

const
Sunduk=$40230CB8;
Tools=$1EBC;
ingot=$1BEF;
eda=$097B;
Izdelie=$0f43;
Trash=$40230CB8;
color=$-1;


var
k, l : integer;
TimeStart : TDateTime;

procedure Check_Izdelie;
 begin
   FindType(Izdelie,Backpack);
   if FindCount>0 then
     begin
       MoveItem(FindItem,1,Trash,0,0,0);
       wait(500);
     end
 end;
 
 procedure Check_Connect;
 begin
  if not Connected then
    while not Connected do
      begin
        Connect;
        wait(1000);
      end
 end;
 
 procedure Check_ingot;
 begin
  FindType(ingot,Backpack);
  if (FindCount=0) OR (Count(ingot)<1) then
    begin
      UseObject(Sunduk);
      wait(1000);
      FindType(ingot,Sunduk);
      if (FindCount>0) and (CountEx(ingot,color,Sunduk)>1) then
        begin
          MoveItem(FindType(ingot,Sunduk),100,Backpack,0,0,0);
          wait(1000);
          AddToSystemJournal('Добрали 100 инготов. На данный момент имеем '+IntToStr(Count(ingot))+' штук. Осталось ещё '+IntToStr(CountEx(ingot,color,Sunduk))+' Логов. l='+IntToStr(l)+'; Count='+IntToStr(Count(Izdelie))+';');
        end
      else
        AddToSystemJournal('Ошибка во время добора инготов.');
        exit;
    end;
   FindType(ingot,Ground);
   if FindCount>0 then
     begin
       MoveItem(FindItem,0,Sunduk,0,0,0);
       wait(500);
     end
 end;
 
 procedure Check_Food;
 begin
  UseObject(Sunduk)
  wait(250);
  FindType(eda,Sunduk);
  if FindCount>0 then
    begin
      MoveItem(FindItem,1,Backpack,0,0,0);
      wait(250);
      UseObject(FindItem);
      FindType(eda,Backpack);
      if FindCount=0 then AddToSystemJournal('Покушали.');
      if FindCount>0 then MoveItem(FindItem,1,Sunduk,0,0,0);
    end
  else
    AddToSystemJournal('Еда не нашлась в сундуке в сундуке.');
 end;
 
 procedure Check_Tools;
  begin
    FindType(Tools,backpack);
    if FindCount=0 then
      begin
        FindType(Tools,Sunduk);
   if FindCount > 0 then
        begin
        moveitem(FindItem,1,backpack,0,0,0);
        end
      end
  end; 

Begin
 ClearJournal;
 CancelMenu;
 AutoMenu( 'Tinkering' , 'Tools' );
 AutoMenu( 'Tools' , 'hatchet' );
 FindDistance:=1;
 while not Dead do
   begin
useobject(sunduk);
wait(1000);
useobject(Trash);
wait(1000);
     Check_Tools;
     repeat
       Check_ingot;
       k:=0;
       TimeStart:=Now;
       UseObject(FindType(Tools,Backpack));
       repeat
         wait(100);
         checksave;
       until (InJournalBetweenTimes('You put|fail', TimeStart, Now)<>-1);
       wait(500);
    if InJournal('put')<>-1 then
         begin
Check_Izdelie;
         end;
       ClearJournal;
     until l=255 
     if l=255 then
      begin
         l:=0;
       end;
   end;   
End.

[Vizit0r]

меню собираются пачками в клиенте. Лечить:
1) не использовать клиент, зачем ему висеть при работе скрипта?
2) в настройках стелс_сервера снять галку напротив Send Menu, или как там оно дословно

[aalexx]

о! Спасибо! сейчас буду смотреть!