Досвидание (прощальное фиесто)
Posted: 28.11.2008 2:53
				
				Так как я уже почти перестал играть захожу так поздороваться да пообщаться выкладываю все свои скриптики....
Все скрипты тестировались на сервере ДРВ и играл я там-же)) на момент моей игры все скрипты работали.
Alchemy
autobuy
Camping
Carpentry
Blacksmith All Daggers
Fishing
Lumber
Lumber tails inject
			Все скрипты тестировались на сервере ДРВ и играл я там-же)) на момент моей игры все скрипты работали.
Alchemy
Code: Select all
Program AlchemyDRW; 
// (c) v26RuS (Galiano{ASTARTA} DRW) v1.1
{$Include 'all.inc'}
var
 STime: TDateTime;
 q: integer;
 AlchemyFlag : Boolean;  
const 
WhatYouDo = 'Total Mana'; // Что делаем
TypBottles = $0F0E;  // Тип пустых бутылок
TypPotion = $0F0A;   // Тип готовых бутылок
ColPotion = $0F0A;   // Цвет готовых бутылок
TypReag= $0F87;  // Тип реагентов из которых делаем
CountRegs = 10; // Какое количество реагентов брать
CountBottles = 5; // Какое количество пустых бутылок брать
Sunduk_reags_bottels = $40053D27; // ИД сундука с которого берем бутылки и реагенты
Sunduk_craft = $40053D27;  // ИД сундука в который кладем готовый продукт
procedure check_reag; 
 begin 
  FindType(TypReag,Backpack); 
  if (FindCount=0) OR (Count(TypReag)<10) then 
    begin 
      UseObject(Sunduk_reags_bottels); 
      wait(250); 
      FindType(TypReag,Sunduk_reags_bottels); 
      if (FindCount>0) and (CountEx(TypReag,$0000,Sunduk_reags_bottels)>100) then 
        begin 
          MoveItem(FindItem,CountRegs,Backpack,0,0,0); 
          wait(250); 
          AddToSystemJournal('Добрали '+IntToStr(CountRegs)+' реагентов. На данный момент имеем '+IntToStr(Count(TypReag))+' штук. Осталось ещё '+IntToStr(CountEx(TypReag,$0000,Sunduk_reags_bottels))+' реагентов.'); 
        end 
      else 
        AddToSystemJournal('Ошибка во время добора реагентов.'); 
	AlchemyFlag := false;
    end 
 end; 
procedure check_bootle; 
 begin 
  FindTypeEx(TypBottles,$0000,Backpack,false); 
  if (FindCount=0) OR (Count(TypBottles)<10) then 
    begin 
      UseObject(Sunduk_reags_bottels); 
      wait(250); 
      FindTypeEX(TypBottles,$0000,Sunduk_reags_bottels,false); 
      if (FindCount>0) and (CountEx(TypBottles,$0000,Sunduk_reags_bottels)>100) then 
        begin 
          MoveItem(FindItem,CountBottles,Backpack,0,0,0); 
          wait(250); 
          AddToSystemJournal('Добрали '+IntToStr(CountBottles)+' бутылок. На данный момент имеем '+IntToStr(CountEx(TypBottles,$0000,backpack))+' штук. Осталось ещё '+IntToStr(CountEx(TypBottles,$0000,Sunduk_reags_bottels))+' бутылок.'); 
        end 
      else 
        AddToSystemJournal('Ошибка во время добора реагентов.'); 
	AlchemyFlag := false;
    end 
 end; 
procedure craft_bottle; 
 begin 
      FindTypeEx(TypPotion,ColPotion,Backpack,false); 
      if (FindCount>0) AND (CountEx(TypPotion,ColPotion,backpack) > 9) then 
        begin 
          MoveItem(FindItem,1,Sunduk_craft,0,0,0); 
          wait(800); 
      end; 
 end; 
Begin
AlchemyFlag := true;
CancelMenu;
wait(500)
Automenu('What',WhatYouDo);
repeat
check_reag;
check_bootle;
UseObject(FindType(TypReag,Backpack))
Wait(500);
STime := Now;
	repeat
	wait(500)
	q := q+1;
	checksave;
	until (InJournalBetweenTimes('You put', STime, Now)<>-1) or (InJournalBetweenTimes('You toss', STime, Now)<>-1) or (AlchemyFlag = false) or (q > 300);
craft_bottle;
until (AlchemyFlag = false) or Dead;
FullDisconnect;
End.Code: Select all
program autobuy; 
{$Include 'all.inc'} 
{$Include 'checkflow.inc'}
{$Include 'move.inc'}
const 
   kolvo = 300;
   s_reag = $403BCB95;
   r_home = $4029A3FA;
   rmax = 3;
   b=0;
   run=$1F14;
   br_bag = $40325CCF;
   r_bag = $40325D10;
type 
buy_rail = array[1..rmax] of Integer;
rune_rail = array[1..30] of Integer;
regs_rail = array[1..3] of Integer;
ven_rail = array[1..2] of Integer;
var 
buy : buy_rail;
rune : rune_rail;
rumax, r, oldx, oldy, mark_key : Integer;
r_homes : Cardinal;
Times : TDateTime; 
procedure IntRune;
var r : integer;
begin
AddToSystemJournal('Инициализация рун');
UseObject(r_bag);
wait(1000);
 findtype(run,r_bag);
 rumax:=FindCount;
 for r:=1 to rumax do
  begin
     checksave;
  findtype(run,r_bag);
  rune[r]:=FindItem;
  Ignore(FindItem);
 end;
AddToSystemJournal('Инициализированно '+IntToStr(rumax)+' рун');
IgnoreReset;
end;
procedure Intbuy;
begin
AddToSystemJournal('Инициализация покупок');
//buy[1] := $0F7A; //BP
buy[2] := $0F88; //NS
buy[3] := $0E34; //BLS
//buy[4] := $0F7B; //BM
//buy[5] := $0F84; //GA
//buy[6] := $0F85; //GI
//buy[7] := $0F86; //MR
buy[1] := $0F87; //NW
if not GetAutoBuyMode then SetAutoBuyMode(true); 
SetAutoBuyDelay(2); 
end;
procedure Reags;
var Reg : regs_rail;
i : Integer;
begin
 Reg[1]:=$0F7B;
 Reg[2]:=$0F7A;  
 Reg[3]:=$0F86; 
 AddToSystemJournal('Берем реги');
 Useobject(s_reag);
 wait(1000);
 for i:=1 to 3 do
  begin
  findtype(Reg[i],backpack)
  if (FindCount = 0) or (Count(Reg[i]) < 20) then
  begin
  findtype(Reg[i],s_reag);
  if findcount > 0 then
   begin
     checksave;
   MoveItem(FindItem,50,Backpack,0,0,0);
   wait(800); 
  end;
 end;
 end;
end;
 
procedure check_mana;
begin
AddToSystemJournal('Проверка маны');
 if Mana < 30 then
  begin
  repeat
   useskill('Meditation');
     checksave;
   wait(5000);
  until Mana = Int;
 end;
end;
procedure vendor_buy;
var ven : ven_rail;
vx,vy,i,z,bs : Integer;
vn : string;
begin
AddToSystemJournal('Ищем вендоров и покупаем');
 ven[1]:=$0190;
 ven[2]:=$0191;
 FindDistance:=5;
 ignore(Self);
 for i:=1 to 2 do
 begin
  findtype(ven[i],ground)
  if FindCount > 0 then
  begin
   for z:=1 to FindCount do
   begin
    FindType(ven[i],ground);
    ClickOnObject(FindItem);
    vx:=GetX(FindItem);
    vy:=GetY(FindItem);
    vn:=GetName(FindItem);
    if (GetDistance(FindItem) > 3) then
    begin
     checksave;
     move(vx, vy, 2);
    end;
    for bs:=1 to rmax do
    begin
     checksave;
     AutoBuy(buy[i],$0000,kolvo); 
     UOSay(vn+' buy');
     AutoBuy(buy[i],$0000,0); 
     wait(2000);
    end;
   UOSay(vn+' bye');
   Ignore(FindItem);
   wait(1000);
   end;
  end;
 end;
IgnoreReset;
end;
procedure razgruz;
var i,cnt : Integer;
begin
AddToSystemJournal('Разгрузка');
 for i:=1 to rmax do
 begin
  findtype(buy[i],backpack);
  if FindCount > 0 then
  begin
   cnt:=GetQuantity(FindItem);
     checksave;
   moveitem(FindItem,cnt,s_reag,0,0,0);
   wait(800);
  end;
 end;
end;
begin 
 AddToSystemJournal('Запуск скрипта');
 Intbuy;
 IntRune;
 r_homes:=r_home;
useobject(r_bag);
wait(1000);
useobject(br_bag);
wait(1000);
 repeat
  Reags;
  findtype(run,r_bag);
  rumax:=FindCount;
  for r:=1 to rumax do
  begin
   oldx:=GetX(Self);
   oldy:=GetY(Self);
   AddToSystemJournal('Прыгаем по руне №'+IntToStr(r));
   repeat
     checksave;
    check_mana;
    cast('Recall');
    WaitForTarget(1500); 
    TargetToObject(Rune[r]);
    wait(6000);
   until (oldx <> GetX(Self)) AND (oldy <> GetY(Self));
   ClearJournal;
   wait(500);
   Times:=Now;
   ClickOnObject(Rune[r]);
   wait(4000);
   if (inJournalBetweenTimes('(2 charges)', Times, Now) <> -1) or (inJournalBetweenTimes('(1 charges)', Times, Now) <> -1) then
    begin
    AddToSystemJournal('Ремарк руны №'+IntToStr(r));
    UseObject(br_bag)
    wait(1000);
    findtype(run,br_bag)
    wait(1000);
    moveitem(FindItem,1,Backpack,0,0,0);
    wait(1000);
    repeat
     checksave;
     check_mana;
     FindType(run,backpack);
     cast('Mark');
     WaitForTarget(1500); 
     TargetToObject(FindItem);
     wait(10000);
     Times:=Now;
     mark_key:=1;
     if (inJournalBetweenTimes('spell', Times, Now) <> -1) then
     begin
      mark_key:=0;
     end;
    until mark_key=1;
   mark_key:=0;
   DropHere(Rune[r]);
   Rune[r]:=FindItem;
   moveitem(FindItem,1,r_bag,0,0,0);
   wait(800);
   end;
   vendor_buy;
  end;
   oldx:=GetX(Self);
   oldy:=GetY(Self);
   AddToSystemJournal('Летим домой');
   repeat
     checksave;
    check_mana;
    cast('Recall');
    WaitForTarget(1500); 
    TargetToObject(r_homes);
    wait(6000);
   until (oldx <> GetX(Self)) AND (oldy <> GetY(Self));
   ClearJournal;
   wait(500);
   Times:=Now;
   ClickOnObject(r_homes);
   wait(2000);
   if (inJournalBetweenTimes('(2 charges)', Times, Now) <> -1) or (inJournalBetweenTimes('(1 charges)', Times, Now) <> -1) then
    begin
    AddToSystemJournal('Ремарк руны домой');
    UseObject(br_bag)
    wait(1000);
    findtype(run,br_bag)
    wait(1000);
    moveitem(FindItem,1,Backpack,0,0,0);
    wait(1000);
    repeat
     checksave;
     check_mana;
     FindType(run,backpack);
     cast('Mark');
     WaitForTarget(1500); 
     TargetToObject(FindItem);
     wait(8000);
     Times:=Now;
     mark_key:=1;
     if (inJournalBetweenTimes('spell', Times, Now)  <> -1) then
     begin
      mark_key:=0;
     end;
    until mark_key=1;
   mark_key:=0;
   DropHere(r_homes);
   r_homes:=FindItem;
   wait(800);
   end;
  razgruz;
  wait(1000);
  repeat
   useskill('Hiding');
     checksave;
   wait(5000);
  until Hidden;
  wait(350000);
 until Dead;
End.
Code: Select all
Program CampingDrw; 
{$Include 'all.inc'} 
// (c) v26RuS (Galiano{ASTARTA} DRW)
// Простенький скрипт для прокачки кемпинга, 
// Становимся дома около сундука откуда брать хворост, он берет хворос летить к месту выкладки
// передвигается по направлению на цифровой клаве 1 (нуп пад)
// кончаеться хворост летит домой добирает и по новой при неуспешном поджиге пробует еще раз.
// Доходит до финальнай кординаты опять летит домой добираеться и по новой
const 
Hvorost = $0DE1; // Тип хвороста 
Sunduk_of_hvorost = $403BCB95; // Сундук откуда брать хворост
trash_id=$404A3ED8;
var
 mx: integer;
 CampingFlag : Boolean;  
 x, y : Integer;
   procedure CheckDead; 
Begin 
if Dead then 
begin 
AddToSystemJournal('Персонаж мертв: '+TimeToStr(now)); 
CampingFlag := false;
FullDisconnect; 
end 
      end; 
 
procedure doborhv;
 begin 
  FindType(Hvorost,Backpack); 
  if (FindCount=0) OR (Count(Hvorost)<10) then 
    begin 
      UseObject(Sunduk_of_hvorost); 
      wait(250); 
      FindType(Hvorost,Sunduk_of_hvorost); 
      if (FindCount>0) and (CountEx(Hvorost,$0000,Sunduk_of_hvorost)>10) then 
        begin 
          MoveItem(FindItem,200,Backpack,0,0,0); 
          wait(250); 
          AddToSystemJournal('Добрали 200 хвороста. На данный момент имеем '+IntToStr(Count(Hvorost))+' штук. Осталось ещё '+IntToStr(CountEx(Hvorost,$0000,Sunduk_of_hvorost))+' хвороста.'); 
        end 
      else 
        AddToSystemJournal('Ошибка во время добора хвороста.'); 
	CampingFlag := false;
    end;
end;
procedure clear;
begin
addtosystemjournal('Clear');
FindDistance:=5;
repeat
findtype($0DE9,ground);
if findcount > 0 then
begin
MoveItem(FindItem,1,trash_id,0,0,0); 
wait(800);
end;
findtype($0DE9,ground);
until FindCount=0;
end;
   procedure CheckHide; 
   begin 
      if Hidden then exit; 
      if WarMode = true then SetWarMode(false); 
      repeat 
         AddToSystemJournal('Прячемся...'); 
         UseSkill('Hiding'); 
         wait(4500); 
         checksave; 
      until Hidden or (not Connected); 
   end; 
BEGIN 
FindDistance:=5;
  repeat
    checkdead;
    doborhv;
	mx := GetX(self);
	 for x := -3 to 3 do
	 begin
	  for y := -2 to 2 do
	  begin
  		CheckHide;
		FindType(Hvorost,Backpack);
		if Findcount = 0 then exit;
		Drop(FindItem,1,GetX(self)+x, GetY(self)+y, GetZ(self));
		AddToSystemJournal('Выложили хворост');
		wait(500);
		FindType(Hvorost,ground);
		 repeat
		  AddToSystemJournal('Пытаюсь зажечь хворост');
		  UseObject(FindItem);
		  wait(2000)
  		  FindType(Hvorost,ground);
		 until FindCount < 1;
		 AddToSystemJournal('Зажгли хворост');
		 wait(500)
	  end;
	 end;
  until 1<>1;
END.
Code: Select all
Program Carpentry_fishing_pole; 
const 
Sunduk=$403FED23;
Sunduk_With_logs_and_Tools=$403FCF27; 
Sunduk_With_Empty_Bags=$40325D14; 
Sunduk_With_Full_Bags=$404D54D9; 
Bag=$0E76; 
Tools=$1034; 
log=$1BDD; 
Pig=$09BB; 
Pole=$0DBF; 
color=$-1; 
var 
k, l : integer; 
TimeStart : TDateTime; 
poles_Bag : Cardinal; 
procedure Check_Pole; 
 begin 
   FindType(Pole,Backpack); 
   if FindCount>0 then 
     begin 
       MoveItem(FindItem,1,poles_bag,0,0,0); 
       wait(500); 
     end 
 end; 
procedure Get_Bag; 
 begin 
   FindType(Bag,ground); 
   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,ground,0,0,0); 
           wait(1000); 
           UseObject(FindItem); 
           wait(1000); 
         end 
     end    
   poles_bag:=FindType(Bag,ground); 
 end; 
procedure Out_Bag; 
 begin 
 AddToSystemJournal('Мешок заполнен берём новый'); 
   FindType(Bag,ground); 
   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>50) 
   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_With_logs_and_Tools); 
      wait(1000); 
      FindType(log,Sunduk_With_logs_and_Tools); 
      if (FindCount>0) and (CountEx(log,color,Sunduk_With_logs_and_Tools)>1) then 
        begin 
          MoveItem(FindType(log,Sunduk_With_logs_and_Tools),100,Backpack,0,0,0); 
          wait(1000); 
          AddToSystemJournal('Добрали 100 логов. На данный момент имеем '+IntToStr(Count(log))+' штук. Осталось ещё '+IntToStr(CountEx(log,color,Sunduk_With_logs_and_Tools))+' Логов. l='+IntToStr(l)+'; Count='+IntToStr(Count(Pole))+';'); 
        end 
      else 
        AddToSystemJournal('Ошибка во время добора Логов.'); 
        exit; 
    end 
   FindType(log,Ground); 
   if FindCount>0 then 
     begin 
       MoveItem(FindItem,0,Sunduk_With_logs_and_Tools,0,0,0); 
       wait(500); 
     end 
 end; 
procedure Check_Food; 
 begin 
  UseObject(Sunduk_With_logs_and_Tools) 
  wait(250); 
  FindType(Pig,Sunduk_With_logs_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_logs_and_Tools,0,0,0); 
    end 
  else 
    AddToSystemJournal('a Pig не был найден в сундуке.'); 
 end; 
procedure Check_Last_Bag; 
  begin 
    FindType(Bag,ground); 
    if FindCount>0 then 
      begin 
        UseObject(FindItem); 
        wait(500) 
        poles_bag:=FindType(Bag,ground);  
        FindType(Pole,poles_bag); 
        l:=FindCount; 
        AddToSystemJournal('В мешке '+IntToStr(l)+' Удочек.'); 
      end 
  end;  
procedure Check_Tools; 
  begin 
    FindType(Tools,backpack); 
    if FindCount=0 then 
      begin 
        FindType(Tools,Sunduk_With_logs_and_Tools); 
	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(Sunduk_With_logs_and_Tools); 
wait(1000);
useobject(Sunduk_With_Empty_Bags); 
wait(1000);
useobject(Sunduk_With_Full_Bags); 
wait(1000);
     Check_Last_Bag; 
     Check_Tools;
     Get_Bag; 
     repeat 
       Check_logs; 
       k:=0; 
       TimeStart:=Now; 
       UseObject(FindType(Tools,Backpack)); 
       repeat 
         wait(100); 
         k := k + 1; 
         Check_World_Save; 
       until (InJournalBetweenTimes('You put|fail', TimeStart, Now)<>-1) or (k > 300); 
       wait(500); 
    if InJournal('put')<>-1 then 
         begin 
           l:=l+1; 
           Check_Pole; 
           AddToSystemJournal(IntToStr(CountEx(Pole,$0000,poles_bag))+'  удочек на данный момент в мешке.'); 
         end 
       ClearJournal; 
     until l=255  
     if l=255 then 
       begin 
         l:=0; 
         Out_Bag; 
       end 
   end    
End.
Code: Select all
Program color_daggers;
{$Include 'all.inc'} 
const
rmax = 12;
Cnt=$403FED23; //Сундук с сундуками
Container=$404261A5; //Сундук с ингами
Containerb=$40325D14; //Сундук с багами
Unload=$404D54D9; //Куда все кидать
CountIng=100; // Сколько ингов брать
bag=$0E76; //Тип бага
dagger=$0F51; //Тип дагера
type 
in_rail = array[1..rmax] of String;
i_rail = array[1..rmax] of Integer;
var
ColorIng,TypeIng : i_rail;
NameIng : in_rail;
i, l : Integer;
Flag1 : Boolean;  
k : integer;
TimeStart : TDateTime;
dagger_bag : Cardinal; 
procedure Ruda_int;
begin
NameIng[1]:=' ';
NameIng[2]:='Rusty ';
NameIng[3]:='Old Copper ';
NameIng[4]:='Dull Copper ';
NameIng[5]:='Copper ';
NameIng[6]:='Bronze ';
NameIng[7]:='Silver ';
NameIng[8]:='Shadow ';
NameIng[9]:='Agapite ';
NameIng[10]:='Rose ';
NameIng[11]:='Blood Rock ';
NameIng[12]:='Verite';
ColorIng[1]:=$0000;
ColorIng[2]:=$0750;
ColorIng[3]:=$0590;
ColorIng[4]:=$060A;
ColorIng[5]:=$FFFF;
ColorIng[6]:=$0488;
ColorIng[7]:=$0000;
ColorIng[8]:=$096B;
ColorIng[9]:=$0193;
ColorIng[10]:=$0014;
ColorIng[11]:=$04C2;
ColorIng[12]:=$07D5;
TypeIng[1]:=$1BEF;
TypeIng[2]:=$1BEF;
TypeIng[3]:=$1BEF;
TypeIng[4]:=$1BEF;
TypeIng[5]:=$1BE3;
TypeIng[6]:=$1BEF;
TypeIng[7]:=$1BF5;
TypeIng[8]:=$1BEF;
TypeIng[9]:=$1BEF;
TypeIng[10]:=$1BEF;
TypeIng[11]:=$1BEF;
TypeIng[12]:=$1BEF;
AddToSystemJournal('Загружена руда');
end;
procedure Check_dagger; 
 begin 
   FindType(dagger,Backpack); 
   if FindCount>0 then 
     begin 
       while FindCount <> 0 do 
         begin 
           l:=l+1; 
           MoveItem(FindItem,1,dagger_bag,0,0,0); 
           wait(500); 
           FindType(dagger,Backpack); 
         end; 
     end; 
 end;
procedure Get_Bag; 
 begin 
   FindType(Bag,Backpack); 
   if FindCount=0 then 
     begin 
       UseObject(cnt); 
       wait(500); 
       UseObject(Containerb); 
       wait(1000); 
       FindType(Bag,Containerb); 
       if FindCount>0 then 
         begin 
           MoveItem(FindItem,1,Backpack,0,0,0); 
           wait(1000); 
           UseObject(FindItem); 
           wait(1000); 
         end 
     end    
   dagger_bag:=FindType(Bag,Backpack); 
 end; 
procedure Check_Last_Bag; 
  begin 
    FindType(Bag,Backpack); 
    if FindCount>0 then 
      begin 
        UseObject(FindItem); 
        wait(500) 
        dagger_bag:=FindType(Bag,Backpack);  
        FindType(dagger,dagger_bag); 
        l:=FindCount; 
        AddToSystemJournal('В мешке '+IntToStr(l)+' daggers.'); 
      end 
  end;  
procedure Out_Bag; 
 begin 
   UseObject(Cnt); 
   wait(500); 
   FindType(Bag,Backpack); 
   if FindCount>0 then 
     begin 
       MoveItem(FindItem,1,Unload,0,0,0); 
       wait(1000) 
     end 
 end; 
procedure Checkrd(TypeIngs,ColorIngs: Integer; NameIngs :  String); 
 begin 
  FindTypeEx(TypeIngs,ColorIngs,Backpack,False);
  if (FindCount=0) OR (GetQuantity(FindItem)<3) then 
    begin 
      AddToSystemJournal('Добираем инги.') 
      UseObject(cnt); 
      wait(500); 
      UseObject(Container); 
      wait(1000); 
      FindTypeEx(TypeIngs,ColorIngs,Container,False); 
      if (FindCount>0) and (GetQuantity(FindItem)>3) then 
        begin 
          MoveItem(FindItem,CountIng,Backpack,0,0,0); 
          wait(1000); 
          AddToSystemJournal('Добрали '+IntToStr(CountIng)+' '+NameIngs+'. На данный момент имеем '+IntToStr(CountEx(TypeIngs,ColorIngs,backpack))+' штук. Осталось ещё '+IntToStr(CountEx(TypeIngs,ColorIngs,Container))+' '+NameIngs+'. l='+IntToStr(l));
	  exit;
      end;
      FindType(TypeIngs,Backpack); 
      if FindCount > 0 then
      begin
      MoveItem(FindItem,0,Container,0,0,0); 
      end;
        AddToSystemJournal('Закончилась руда: '+NameIngs); 
        Flag1 := false;
        exit; 
 
  end;
   FindType(TypeIngs,Ground); 
   if FindCount>0 then 
     begin 
       MoveItem(FindItem,0,Container,0,0,0); 
       wait(500); 
     end 
 end; 
Begin
 Ruda_int;
 for i:= 1 to 12 do
 begin
  AddToSystemJournal(IntToStr(i)+' руда '+NameIng[i]);
 UseObject(cnt); 
 wait(1000); 
 UseObject(Container);
 wait(1000);
  FindTypeEx(TypeIng[i],ColorIng[i],Container,false);
  if (FindCount > 0) AND (CountEx(TypeIng[i],ColorIng[i],Container) > 3) then
  begin
   CancelMenu;
   if i = 1 then
   begin
    AutoMenu('Blacksmithing','Weapons');
    AutoMenu('Weapons','Swords');
    AutoMenu('Swords','dagger');
   end;
   if i > 1 then
   begin
    AutoMenu('Blacksmithing','Colored');
    AutoMenu('Colored',NameIng[i]+' Weapons');
    AutoMenu(NameIng[i]+' Weapons',NameIng[i]+'Swords');
    AutoMenu(NameIng[i]+' Swords',NameIng[i]+' Dagger');
   end;
   AddToSystemJournal('Делаем дагеры из: '+NameIng[i]);
   Flag1 := true;
  repeat
   Check_Last_Bag;
   Get_bag;
   if(CountEx(TypeIng[i],ColorIng[i],backpack)<3) then
   begin
   Checkrd(TypeIng[i],ColorIng[i],NameIng[i]);
   end;
   checksave;
   TimeStart:=Now; 
   k:=0;
 if Flag1 = true then
 begin
   UseObject(FindTypeEx(TypeIng[i],ColorIng[i],backpack,false));
   repeat
    wait(500);
    k := k + 1; 
    checksave;
  until (InJournalBetweenTimes('You put|failed', TimeStart, Now)<>-1) or (k > 50); 
  wait(200);
  if InJournalBetweenTimes('You put', TimeStart, Now)<>-1 then
  begin
   Check_dagger;
  end;
  if l=255 then
  begin
   l:=0;
   Out_Bag;
  end;
  end;
  until Flag1 = false;
wait(3000);
  end;
 end;
End.Code: Select all
program Fishing; 
// (c) v26RuS (Galiano{ASTARTA} DRW) 
// Залазием на лодку прописываем трюм кидаем beckpack с пустыми сумками и вперед плывет в направлении цифры 1 на нумпаде) 
{$Include 'all.inc'} 
const 
HatchID = $40338556;         // Сериал трюма 
FPoleType = $0DC0;            // Тип удочки 
BoxOfBags = $0E75;            // тип ящика с мешками 
EmptyBags = $0E76;            // тип пустого мешка 
{Сообщения} 
Mes1 = 'You pull out'; 
Mes2 = 'You fish a while, but fail'; 
Mes3 = 'There are no fish here.'; 
Mes4 = 'That is too far away.'; 
Mes5 = 'Try fishing in water.'; 
Mes6 = 'Вы не смогли выловить'; 
var 
x, y, k, n, d, s, scard, snom, m1, m2, m3, m4, m5, m6 : integer; 
ctime : TDateTime; 
CurBagID : Cardinal; 
CurBoxID : Cardinal; 
temp1 : Cardinal; 
FishResult : array[1..8] of Cardinal; 
SumResult : array[1..10] of Integer; 
FlagMagic : Integer; 
FoodID : Cardinal; 
   function GetEmptyBag : Cardinal; 
   begin 
      Result := 0; 
      UseObject(HatchID); 
      wait(1000); 
      checksave; 
      CurBoxID := findtype(BoxOfBags, HatchID); 
      if CurBoxID = 0 then 
      begin 
         Addtosystemjournal( 'Не смог найти ящик с мешками'); 
         exit; 
      end; 
      UseObject(CurBoxID); 
      wait(1000); 
      checksave; 
      temp1 := findtype(EmptyBags, CurBoxID); 
      if temp1 = 0 then 
      begin 
         Addtosystemjournal( 'Не смог найти мешок в ящике'); 
         exit; 
      end; 
      MoveItem(finditem, 1, HatchID, 0, 0, 0); 
      wait(1000); 
      checksave; 
      Result := temp1; 
   end; 
procedure virar; 
var TimeInterno : TDateTime; 
   loop1, loop2 : integer; 
    
begin 
   TimeInterno := Now; 
   UOSay('Turn Left'); 
   wait(200); 
   if (inJournalBetweenTimes('boat|cannot', TimeInterno, Now) >= 0) then //Obstaculo 
   begin 
      TimeInterno := Now; 
      loop1 := 0; 
      UOSay('Right'); 
      repeat 
         wait(100) 
         loop1 := loop1 + 1; 
      until (inJournalBetweenTimes('boat|cannot|stopped', TimeInterno, Now) >= 0) OR (loop1 >= 50); 
      if (loop1 < 50) then //Obstaculo a direita. 
      begin 
         TimeInterno := Now; 
         loop2 := 0; 
         UOSay('Left'); 
         repeat 
            wait(100) 
            loop2 := loop2 + 1; 
         until (inJournalBetweenTimes('boat|cannot|stopped', TimeInterno, Now) >= 0) OR (loop2 >= 50); 
         if (loop2 < 50) then //Obstaculo a esquerda. 
         begin 
            UOSay('Back'); 
            wait(5000); 
            virar; 
         end; 
      end; 
   end; 
end; 
procedure mover; 
var TimeInterno : TDateTime; 
   loop : integer; 
              
begin 
   TimeInterno := Now; 
   loop := 0; 
   UOSay('Forward'); 
   Addtosystemjournal('Переплываем на новое место ловли рыбы') 
   repeat 
      wait(100) 
      loop := loop + 1; 
   until (inJournalBetweenTimes('stopped', TimeInterno, Now) >= 0) OR (loop >= 150); 
   if (loop < 150) then //Obstaculo a frente. 
   begin 
      virar; 
      mover; 
   end 
   else 
   begin 
      UOSay('Stop'); 
      wait(200); 
   end; 
end; 
        
begin 
   for k := 1 to 10 do 
      SumResult[k] := 0; 
   FishResult[1] := $09CC;         // рыба 
   FishResult[2] := $09CF;         // рыба 
   FishResult[3] := $09CE;         // рыба 
   FishResult[4] := $09CD;         // рыба 
   FishResult[5] := $14EB;         // карты 
   FishResult[6] := $14EC;         // карты 
   FishResult[7] := $0DCA;         // fish net 
   FishResult[8] := $0DD6;         // prize 
   scard := 0; 
   CurBagID := GetEmptyBag; 
   if CurBagID = 0 then exit; 
   snom := 1; 
   UseObject(CurBagID); 
   wait(1000); 
   checksave; 
   s := 0; 
   repeat 
      // подсчет количества итемов в трюме 
      findtype($FFFF,HatchID); 
      if findcount > 0 then s := s + 1; 
      for k := 1 to 8 do 
      begin 
         if (GetType(finditem) = FishResult[7]) then 
         begin 
            SumResult[8] := GetQuantity(finditem); 
            break; 
         end; 
         if (GetType(finditem) = FishResult[8]) then 
         begin 
            SumResult[9] := GetQuantity(finditem); 
            break; 
         end; 
         if GetType(finditem) = FishResult[k] then SumResult[k] := GetQuantity(finditem); 
      end; 
      ignore(finditem); 
      wait(50); 
   until findcount = 0; 
   ignorereset; 
   repeat 
      UseObject(HatchID); 
      wait(1000); 
      checksave; 
FoodID := FindType($097B,backpack); 
wait(500) 
UseObject(FoodID); 
wait(500) 
UseObject(FoodID); 
      for x := -6 to 6 do 
      begin 
         for y := -6 to 6 do 
         begin 
            // Если схема облова другая - уберите следующую строку: 
//            if (y < 2) AND (x > -3) AND (x < 3) then continue; 
            repeat 
               if scard >= 250 then 
               begin 
                  // взять новый мешок 
                  CurBagID := GetEmptyBag; 
                  if CurBagID = 0 then exit; 
                  UseObject(CurBagID); 
                  wait(1000); 
                  checksave; 
                  scard := 0; 
                  s := s + 1; 
                  snom := snom + 1; 
               end; 
               if TargetPresent then CancelTarget; 
               waitconnection(3000); 
               ctime := Now; 
               UseObject(ObjAtLayerEx(LHandLayer,self)); 
               WaitForTarget(5000); 
               If TargetPresent then TargetToTile(0, GetX(self)+x, GETY(self)+y, 251); 
               k := 0; 
               repeat 
                  wait(500); 
                  k := k + 1; 
                  checksave; 
                  m1 := InJournalBetweenTimes(Mes1, ctime, Now); 
                  m2 := InJournalBetweenTimes(Mes2, ctime, Now); 
                  m3 := InJournalBetweenTimes(Mes3, ctime, Now); 
                  m4 := InJournalBetweenTimes(Mes4, ctime, Now); 
                  m5 := InJournalBetweenTimes(Mes5, ctime, Now); 
                  m6 := InJournalBetweenTimes(Mes6, ctime, Now); 
               until (k > 20) or (m1<>-1) or (m2<>-1) or (m3<>-1) or (m4<>-1) or (m5<>-1); 
          if k > 20 then 
      begin 
         wait(4000); 
         k := 0; 
               ClearJournal; 
         Addtosystemjournal('Лаг с западанием на ловлю') 
          end; 
               if m1 <> -1 then 
               begin 
                  k := 1; 
                  for n := 1 to 8 do 
                  begin 
                     findtype(FishResult[n],ground); 
                     if finditem = 0 then continue; 
                     d := GetQuantity(finditem); 
                     if (n = 5) OR (n = 6) then 
                        MoveItem(finditem, d, CurBagID, 0, 0, 0) 
                     else 
                        MoveItem(finditem, d, HatchID, 0, 0, 0); 
                     wait(1000); 
                     checksave; 
                     // Перепроверим, переместился ли объект 
                     findtype(FishResult[n],ground); 
                     if finditem > 0 then 
                     begin 
                        // Раз не переместился - значит был реконнект 
                        UseObject(HatchID); 
                        wait(1000); 
                        checksave; 
                        UseObject(CurBagID); 
                        wait(1000); 
                        checksave; 
                        d := GetQuantity(finditem); 
                        if (n = 5) OR (n = 6) then 
                           MoveItem(finditem, d, CurBagID, 0, 0, 0) 
                        else 
                           MoveItem(finditem, d, HatchID, 0, 0, 0); 
                        wait(1000); 
                        checksave; 
                     end; 
                     if d = 0 then d := 1; 
                     if FlagMagic = 1 then SumResult[8] := SumResult[8] + d; 
                     if FlagMagic = 2 then SumResult[9] := SumResult[9] + d; 
                     if FlagMagic = 3 then SumResult[10] := SumResult[10] + d; 
                     if FlagMagic = 0 then SumResult[n] := SumResult[n] + d; 
                     if (n = 5) OR (n = 6) then scard := scard + 1; 
                     // Сообщения о результатах лова: 
                     if (n <= 4) and (FlagMagic = 0) then Addtosystemjournal( inttostr(x) + inttostr(y) + ': сбросил в трюм ' + inttostr(d) + ' рыбы типа ' + inttostr(n) + ' из ' + inttostr(SumResult[n]) + '. В трюме ' + inttostr(s) + ' итемов'); 
                     if (n = 5) OR (n = 6) then Addtosystemjournal( inttostr(x) + inttostr(y) + ': сбросил в мешок N' + inttostr(snom) + ' карту. Всего в мешке ' + inttostr(scard) + ' карт'); 
                     if (n = 7) then Addtosystemjournal( inttostr(x) + inttostr(y) + ': сбросил в трюм ' + inttostr(d) + ' fish net из ' + inttostr(SumResult[9]) + '. В трюме ' + inttostr(s) + ' итемов'); 
                     if (n = 8) then Addtosystemjournal( inttostr(x) + inttostr(y) + ': сбросил в трюм ' + inttostr(d) + ' prize or rate fish из ' + inttostr(SumResult[8]) + '. В трюме ' + inttostr(s) + ' итемов'); 
                     if s > 250 then exit; 
                  end; 
               end; 
            until (m3<>-1) or (m4<>-1) or (m5<>-1); 
         end; 
      end; 
      ClearJournal; 
      Mover; 
      wait(500); 
   until False; 
End.
Code: Select all
Program LumberDRW; 
// (c) v26RuS (Galiano{ASTARTA} DRW) v1.4
{$Include 'all.inc'}
type LumbRecord = Record 
   x,y,tt,tx,ty,tz : integer; 
   end; 
var 
LumberDim : array [0..5000] of LumbRecord; 
ResDim : array [0..5000] of  LumbRecord; 
MaxPosL, MaxPosR, k : integer;               // длины соответствующих массивов 
LumberFlag : Boolean;      // true - работаем, false - нет (разгрузка или смерть) 
ctime : TDateTime;
CheckSWSTimer : TDateTime; 
const 
FMoveArrMax = 300; // ставь здесь больше, если твой чар ходит на дистанции больше 13 тайлов или вокруг чара очень много препятствий. Если препятствий на пути мало, то можно оставить как есть. 
var 
PrognosisX, PrognosisY, FMoveArrCount : integer; 
FMoveArr : array [1..FMoveArrMax] of array [1..2] of smallint; 
const 
Msg1 = 'You put the'; 
Msg2 = 'reach this'; 
Msg3 = 'fail to'; 
Msg4 = 'There are no logs here to chop'; 
Msg5 = 'There is nothing';
Msg6 = 'OOPS !!!';
AxeType1 = $0F47;
AxeType2 = $0F47;
MaxWeight = 350;
MaxFizzle = 30;
l_rails = 'f:\titles\babros_l.txt';
logType = $1BDD;
Sunduk_log = $4010C799;
r_lumb = 33;		    // Number of rune to Lumber 2 (no change)
r_home = 21;		    // Number of rune to home 1 (no change)
runebook = $4027BB57;	    // Runebook
   procedure CheckDead; 
Begin 
if Dead then 
begin 
AddToSystemJournal('Персонаж мертв: '+TimeToStr(now)); 
FullDisconnect; 
end 
      end; 
   procedure ents;
var TimeInterno : TDateTime; 
   begin
ClearJournal; 
   TimeInterno := Now; 
   Addtosystemjournal('Найден ЭНТ для продолжение напишите start');
   UOSay('\w Galiano: Ents!!! x:'+IntToStr(GetX(self))+' y:'+IntToStr(GetY(self)));
repeat
wait(2000);
until (inJournalBetweenTimes('start', TimeInterno, Now) >= 0); 
wait(2000);
ClearJournal; 
   end;
   procedure GetLumberRail(s : String; WPos : Integer; flag : Boolean); 
   // flag - true - маршрут для ламбера, false - маршрут для реса 
   begin 
      s := s + ' '; 
      if flag then 
      begin 
         LumberDim[WPos].tt := StrToInt(Copy(s,1,Pos(' ',s)-1)); 
         Delete(s,1,Pos(' ',s)); 
         LumberDim[WPos].tx := StrToInt(Copy(s,1,Pos(' ',s)-1)); 
         Delete(s,1,Pos(' ',s)); 
         LumberDim[WPos].ty := StrToInt(Copy(s,1,Pos(' ',s)-1)); 
         Delete(s,1,Pos(' ',s)); 
      end 
      else 
      begin 
         ResDim[WPos].tt := StrToInt(Copy(s,1,Pos(' ',s)-1)); 
         Delete(s,1,Pos(' ',s)); 
         ResDim[WPos].tx := StrToInt(Copy(s,1,Pos(' ',s)-1)); 
         Delete(s,1,Pos(' ',s)); 
         ResDim[WPos].ty := StrToInt(Copy(s,1,Pos(' ',s)-1)); 
         Delete(s,1,Pos(' ',s)); 
      end; 
   end;
   procedure GetRail(FileNam : String; Flagoffile : boolean); 
   var 
   List : TStringList; 
   i : integer; 
   begin 
      List := TStringList.Create; 
      List.LoadFromFile(FileNam); 
      for i := 0 to List.Count-1 do GetLumberRail(List.strings[i],i,FlagOfFile); 
      if Flagoffile then MaxPosL := i 
      else MaxPosR := i; 
   end; 
   function CheckAxe : Boolean; 
   // проверяем, есть ли топор у чара в паке или на нужном слое. 
   // если ее нет - открываем сундук и мешок, берем топор. Если топора нет 
   // в мешке - выход. 
   var tmpser : Cardinal; 
   begin 
      Result := true; 
      waitconnection(3000); 
      if (ObjAtLayerEx(LhandLayer,self) <> 0) or (count(AxeType1)<>0) or (count(AxeType2)<>0) then exit; 
      // нет у чара топора 
      repeat 
         UseObject(Sunduk_log); 
         wait(1000); 
         checksave; 
         tmpser := findtype(AxeType1,Sunduk_log); 
         if tmpser = 0 then tmpser := findtype(AxeType2,Sunduk_log); 
         if tmpser <> 0 then 
         begin 
            Grab(tmpser,1); 
            wait(1000); 
            checksave; 
         end; 
      until (count(AxeType1)<>0) or (count(AxeType2)<>0); 
   end; 
procedure dlog(logString,fname : string); 
var 
   ls : TStringList; 
begin 
   ls := TSTringList.Create(); 
   try 
      ls.loadFromFile(fname); 
   except 
      //создаем файл, если нету 
      ls.saveToFile(fname); 
   end; 
   ls.add(logString); 
   ls.saveToFile(fname) 
   ls.free(); 
end;
procedure DropLog; 
   var tmpid : Cardinal; 
   begin 
      dlog('Babros - Разгрузка логов: ' + DateTimeToStr(Now),'lumber.log'); 
      CheckDead; 
      checksave; 
      repeat 
         tmpid := Findtype(logType,backpack); 
         waitconnection(3000); 
         checksave; 
         MoveItem(tmpid,GetQuantity(tmpid),Sunduk_log,0,0,0); 
         wait(1000); 
         checksave; 
      until tmpid = 0; 
End;
   procedure CheckHide; 
   begin 
      if Hidden then exit; 
      repeat 
      if WarMode = true then SetWarMode(false); 
         AddToSystemJournal('Прячемся...'); 
         UseSkill('Hiding'); 
         wait(4500); 
         checksave; 
      until Hidden or (not Connected); 
   end; 
   function LumbCurTree(tile,x,y,z : Integer) : Boolean; 
   // рубим указанный тайл. Возвращаем false если перевес или чар мертв. 
   var q, m1, m2, m3, m4, m5, m6, CountFizzle : integer; 
   begin 
      Result := true; 
      CountFizzle := 0; 
      repeat 
	 CheckHide;
         checkdead;
         if WarMode = true then SetWarMode(false); 
         if TargetPresent then CancelTarget; 
         ctime := Now; 
         if Dead then begin Result := false; exit; end; 
	 UseObject(ObjAtLayerEx(LhandLayer,self));
         WaitForTarget(5000); 
         If TargetPresent then TargetToTile(tile, x, y, z); 
         q := 0; 
         repeat 
            wait(1000); 
            q := q + 1; 
            checksave; 
            m1 := InJournalBetweenTimes(Msg1, ctime, Now); 
            m2 := InJournalBetweenTimes(Msg2, ctime, Now); 
            m3 := InJournalBetweenTimes(Msg3, ctime, Now); 
            m4 := InJournalBetweenTimes(Msg4, ctime, Now); 
            m5 := InJournalBetweenTimes(Msg5, ctime, Now); 
            m6 := InJournalBetweenTimes(Msg6, ctime, Now); 
         until (m1<>-1) or (m2<>-1) or (m3<>-1) or (m4<>-1) or (m5<>-1) or (m6<>-1) or Dead or (q = 60); 
         if (m2<>-1) or (m3<>-1) or (q = 60) then CountFizzle := CountFizzle + 1; 
	 if (m6<>-1) then ents;
         if Dead or (Weight > MaxWeight) then begin Result := false; exit; end; 
      until (m5<>-1) or (m4<>-1) OR (CountFizzle = MaxFizzle); 
   end;
   procedure recal_rb(rune : integer); 
   var tmpr : Integer; 
   mx, my, k, Res : Integer; 
   begin 
    repeat
      Res := 0; 
        CheckDead; 
        AddToSystemJournal('Try to recall');
	tmpr := rune;
	waitgump(IntToStr(tmpr));
        wait(1000)
	UseObject(runebook);
	mx := GetX(self);
	my := GetY(self);
		k := 0;
	repeat
		wait(500)
		k := k + 1;
		CheckSave;
	until (mx<>GetX(self)) or (my<>GetY(self)) or Dead or (k = 20)
	if (mx<>GetX(self)) or (my<>GetY(self)) then Res := 1;
   until Res = 1;
   end;
procedure checkweight; 
begin 
if (Weight > MaxWeight) then  
begin 
AddToSystemJournal('Полный'); 
recal_rb(r_home); 
DropLog; 
recal_rb(r_lumb);
end; 
end;
procedure InitCheckFlow; 
begin 
CheckSWSTimer := Now; 
end; 
function SWSSoon : boolean; 
begin 
result := (GetGlobal('stealth', 'Saving World State') = '1'); 
end; 
function CheckFlow : integer; 
var 
delay : integer; 
begin 
delay := timer; 
checksave; 
WaitConnection(5000); 
result := timer - delay; 
end;
Function Abs(A: integer): integer; 
Begin 
If A>=0 then result:=A 
Else result:=0-A; 
End; 
function SetDirection(x, y : integer) : integer; 
var 
   MyX,MyY,DiffX,DiffY,GoDir: integer; 
Begin 
MyX:=GetX(self); 
MyY:=GetY(self); 
DiffX:=Abs(MyX-x); 
DiffY:=Abs(MyY-y); 
if (DiffX/(DiffY+0.1))>=2 then 
   begin 
   if (MyX>X) then 
      GoDir:=6 
   else 
      GoDir:=2; 
   end  
else 
    
   if (DiffY/(DiffX+0.1))>=2 then 
      begin 
      if (MyY>Y) then 
         GoDir:=0 
      else 
         GoDir:=4; 
      end  
   else 
        
      if (MyX>X) and (MyY>Y) then  GoDir:=7 
      else 
        if (MyX>X) and (MyY<Y) then  GoDir:=5 
        else 
           if (MyX<X) and (MyY>Y) then  GoDir:=1 
           else 
             if (MyX<X) and (MyY<Y) then  GoDir:=3; 
              
result:=GoDir; 
end; 
procedure CalcPrognosis(Dir : integer); 
begin 
   if (Dir = 1) or (Dir = 2) or (Dir = 3) then PrognosisX := GetX(self) + 1; 
   if (Dir = 5) or (Dir = 6) or (Dir = 7) then PrognosisX := GetX(self) - 1; 
   if (Dir = 0) or (Dir = 4) then PrognosisX := GetX(self); 
   if (Dir = 3) or (Dir = 4) or (Dir = 5) then PrognosisY := GetY(self) + 1; 
   if (Dir = 7) or (Dir = 0) or (Dir = 1) then PrognosisY := GetY(self) - 1; 
   if (Dir = 2) or (Dir = 6) then PrognosisY := GetY(self); 
end; 
function TryToMove(Direction : integer; RunFlag : boolean) : boolean; 
begin 
   if GetDirection(self) <> Direction then Raw_Move(Direction, RunFlag); 
   result := Raw_Move(Direction, RunFlag); 
end; 
function WrongMove(x, y : integer) : boolean; 
var 
i : integer; 
begin 
   result := false; 
   if FMoveArrCount = 0 then exit; 
   for i := 1 to FMoveArrCount do 
      begin 
      if (x = FMoveArr[i][1]) and (y = FMoveArr[i][2]) then 
         begin 
         result := true; 
         exit; 
         end; 
      end; 
end; 
function Min(x,y: integer): integer; 
begin 
 if x>y then Result:=y else Result:=x; 
end; 
function HEst(x,y: integer): integer; 
var dx,dy,Ddx : integer; 
begin 
  dx:= GetX(self)-x; 
  dy:= GetY(self)-y; 
  Ddx:= dx-dy; 
  If dx<0 then dx:=0-dx; 
  If dy<0 then dy:=0-dy; 
  If Ddx<0 then Ddx:=0-Ddx; 
  Result:= min(dx,dy)+Ddx; 
end; 
procedure SetWrongMove(x, y : integer); 
begin 
   FMoveArrCount := FMoveArrCount + 1; 
   FMoveArr[FMoveArrCount][1] := x; 
   FMoveArr[FMoveArrCount][2] := y; 
end; 
function RewindDir(Dir, c : integer) : integer; 
begin 
   result := Dir + c; 
   if result < 0 then result := result + 8; 
   if result > 7 then result := result - 8; 
end; 
function Move(x, y, tolerance : integer) : boolean; 
var 
Dir, Dist, lastX, lastY, t, i, timeout : integer; 
begin 
   FMoveArrCount := 0; 
   Dist := HEst(x, y); 
   timeout := Dist * 13000; // 13 секунд времени на шаг 
   t := timer; 
   while true do 
      begin 
      Dist := HEst(x, y); 
      if Dist <= tolerance then // пришёл 
         begin 
         result := true; 
         exit; 
      end; 
      if timer - t > timeout then // провал по таймауту 
      begin 
         AddToSystemJournal('Move: Time moved out!'); 
         result := false; 
         exit; 
      end; 
      Dir := SetDirection(x, y); 
      CalcPrognosis(Dir); 
      if WrongMove(PrognosisX, PrognosisY) then 
         begin 
         for i := 1 to 7 do 
            begin 
            Dir := RewindDir(Dir, 1); 
            CalcPrognosis(Dir); 
            if not WrongMove(PrognosisX, PrognosisY) then break; 
            end; 
      if i = 8 then 
         begin 
         AddToSystemJournal('Move: Cannot move'); 
         result := false; 
         exit; 
         end; 
      end; 
      timeout := timeout + CheckFlow; 
      lastX := GetX(self); lastY := GetY(self); 
      if TryToMove(Dir, true) then SetWrongMove(lastX, lastY) // отсюда чар пришёл 
      else SetWrongMove(PrognosisX, PrognosisY); 
      end; 
end; 
procedure _move(x, y, tolerance : integer); 
begin 
while not Move(x, y, tolerance) do wait(100); 
end;
Begin 
   GetRail(l_rails,true);
AddToSystemJournal('Маршрут ' + l_rails + ' загружен');
   repeat 
      CheckDead; 
      if Dead then LumberFlag := false else LumberFlag := true; 
      if LumberFlag then 
      begin 
         recal_rb(r_lumb);
         if not CheckAxe then exit; 
         For k := 0 to MaxPosL-1 do 
         begin 
            // идем по маршруту 
	       AddToSystemJournal('Переход к дереву #' + inttostr(k+1)+ ' x:'+inttostr(LumberDim[k].tx)+' y:'+inttostr(LumberDim[k].ty)); 
		 _move(LumberDim[k].tx, LumberDim[k].ty, 1);
	       AddToSystemJournal('Переход окончен'); 
            if LumberFlag and (LumberDim[k].tt <> 0) then 
	       CheckHide;
	       AddToSystemJournal('Начинаем рубить дерево #' + inttostr(k+1)); 
               LumberFlag := LumbCurTree(LumberDim[k].tt,LumberDim[k].tx,LumberDim[k].ty,GetZ(self));
 	       checkweight;
         end; 
      end; 
   until False; 
End.Code: Select all
sub Mark() 
var i=0,j=0,k=0,r=0,q=0,ii,jj 
var TopX=324,TopY=65 
dim TreeX[5000], TreeY[5000],TreeT[5000],TreeZ[5000] 
dim TreeTile[29] 
var flag=0,treeCount=0,clicks=0,flag2=0 
######################## 
### Графика деревьев ### 
######################## 
TreeTile[0]=3277 
TreeTile[1]=3280 
TreeTile[2]=3283 
TreeTile[3]=3286 
TreeTile[4]=3289 
TreeTile[5]=3291 
TreeTile[6]=3294 
TreeTile[7]=3296 
TreeTile[8]=3299 
TreeTile[9]=3302 
TreeTile[10]=3393 
TreeTile[11]=3394 
TreeTile[12]=3395 
TreeTile[13]=3396 
TreeTile[14]=3415 
TreeTile[15]=3416 
TreeTile[16]=3417 
TreeTile[17]=3418 
TreeTile[18]=3419 
TreeTile[19]=3438 
TreeTile[20]=3439 
TreeTile[21]=3440 
TreeTile[22]=3441 
TreeTile[23]=3442 
TreeTile[24]=3460 
TreeTile[25]=3461 
TreeTile[26]=3462 
TreeTile[27]=3290 
TreeTile[28]=3288 
uo.Exec("filterspeech on") 
uo.Exec("filterspeech add 'Where do you want to use the pickaxe?'") 
###################################### 
### Собираем координаты из клиента ### 
###################################### 
uo.Print('Выбери Кирку: ') 
uo.Exec('addobject Pickaxe') 
while uo.Targeting() 
wait(100) 
wend 
uo.Print('Собираем координаты деревьев в округе...') 
repeat 
clicks=0 
flag=0 
uo.DeleteJournal() 
####################### 
### Кликаем на тайл ### 
####################### 
uo.UseObject('Pickaxe') 
waitForTarget() 
uo.DeleteJournal() 
WaitForTryRock() 
############################### 
### Проверяем дерево ли это ### 
############################### 
flag=0 
for k=0 to 28 
if uo.LastTile(0)==TreeTile[k]+1 then 
flag=2 
end if 
next 
if flag==0 then 
for k=0 to 28 
if uo.LastTile(0)==TreeTile[k] then 
flag=1 
end if 
next 
end if 
if uo.Lasttile(1)==uo.getX() and uo.Lasttile(2)==uo.gety() then 
flag=3 
end if 
######################### 
### Кликнули на ствол ### 
######################### 
if flag==1 then 
flag2=0 
if treeCount>0 then 
for ii=1 to treeCount 
if TreeX[ii]==uo.LastTile(1) and TreeY[ii]==uo.LastTile(2) and TreeZ[ii]==uo.LastTile(3) then 
flag2=1 
end if 
next 
end if 
if flag2==0 then 
treeCount=treeCount+1 
TreeX[treeCount]=uo.LastTile(1) 
TreeY[treeCount]=uo.LastTile(2) 
TreeT[treeCount]=uo.LastTile(0) 
TreeZ[treeCount]=uo.LastTile(3) 
uo.Print('Найдено дерево '+str(treeCount)+' : x='+str(uo.Lasttile(1))+' y='+str(uo.LastTile(2))+' z='+str(uo.LastTile(3))) 
end if 
end if 
########################## 
### Кликнули по листве ### 
########################## 
if flag==2 then 
flag2=0 
if treeCount>0 then 
for ii=1 to treeCount 
if TreeX[ii]==uo.LastTile(1) and TreeY[ii]==uo.LastTile(2) and TreeZ[ii]==uo.LastTile(3) then 
flag2=1 
end if 
next 
end if 
if flag2==0 then 
treeCount=treeCount+1 
TreeX[treeCount]=uo.LastTile(1) 
TreeY[treeCount]=uo.LastTile(2) 
TreeZ[treeCount]=uo.LastTile(3) 
TreeT[treeCount]=uo.LastTile(0)-1 
uo.print('Найдено дерево '+str(treeCount)+' : x='+str(uo.Lasttile(1))+' y='+str(uo.LastTile(2))+' z='+str(uo.LastTile(3))) 
end if 
end if 
until (Flag==3) or (treeCount==500) 
uo.Exec("filterspeech off") 
uo.Print('Анализ закончен, координаты деревьев записаны в файл C:\ltitles.txt') 
SaveToFile(treeCount,TreeX,TreeY,TreeT,TreeZ) 
uo.Print('Деревьев найдено: '+str(treeCount)) 
end sub 
sub GetTree(Type,X,Y,Z) 
var i 
uo.Print('Начинаем рубку дерева...') 
for i=0 to 15 
if uo.Warmode()==1 then 
return 0 
end if 
wait(200) 
uo.DeleteJournal() 
### CheckLag() 
uo.WaitTargetTile(Type,X,Y,Z) 
uo.UseObject('Axe') 
if WaitForChange()==1 then 
return 1 
end if 
next 
return 0 
end sub 
sub WaitForTryRock() 
var Text1="That is too far away." 
var Text2="Try mining in rock." 
var Text3="There is no ore here to mine." 
var Text4="You have no line of sight to that location" 
var Text5="You can't see the target" 
for var i=0 to 50 
if uo.Journal(0)==Text1 or uo.Journal(0)==Text2 or uo.Journal(0)==Text3 or uo.Journal(0)==Text4 or uo.Journal(0)==Text5 then 
return 1 
end if 
wait(200) 
next 
return 0 
end sub 
sub WaitForTarget() 
for var i=0 to 50 
if uo.Targeting()==1 then 
return 1 
end if 
wait(200) 
next 
return 0 
end sub 
sub SaveToFile(treeCount,TreeX,TreeY,TreeT,TreeZ) 
var f=file("C:\ltitles.txt") 
var s=0,i=0 
f.open() 
f.create() 
for i=1 to treeCount 
s=safe call f.writeln(str(TreeT[i])+' '+str(TreeX[i])+' '+str(TreeY[i])+' '+str(TreeZ[i])) 
next 
f.close() 
end sub 
sub CheckLag() 
if uo.Waiting()>0 then 
uo.Exec('canceltarget') 
end if 
uo.DeleteJournal() 
uo.Click('backpack') 
repeat 
wait(50) 
until uo.InJournal('backpack') 
end sub
 Правда пока что-то не куёт, но думаю поправлю. Удачи, v26RuS
 Правда пока что-то не куёт, но думаю поправлю. Удачи, v26RuS  429827037
 429827037