unit allinc; 

//
// Собственно собиралось по крохам со времен инклуд и переписывалось под новый стим как модуль.
// Автор Игорь (Shadis aka Allice) Skype: shadis_up
// Сборник общих процедур для РанУо серверов.
//   
// Author: Igor Archipcuk [Shadis aka Allice]
// Procedure Stack in Box| Get from Box
// Prevent Error for Double Stack
//
// For stealth client 6.xx.xx
//
//


interface 
            
procedure WaitConnection(WaitTime : Integer); 
procedure CheckSave;  
procedure CheckTargetError(lines, checktime : integer);
procedure FullDisconnect;
procedure GetResFromGround(tmptyp : cardinal; tmpcol : cardinal; tmpcnt : integer; tmpstr : string); 
procedure stack(ObjType, Color : word); 
procedure StackInBox(ObjType, Color : word; container : cardinal);
procedure StackInBox50(ObjType, Color : word; container : cardinal);
procedure GetResFromBox(tmptyp : cardinal; tmpcol : cardinal; tmpcnt : integer; tmpstr : string; box : cardinal); 
procedure CheckDoubleStack(tmptypCDS : cardinal; tmpcolCDS : cardinal);

implementation 


procedure WaitConnection(WaitTime : Integer);
begin
if Connected then Exit;
while not Connected do Wait(1000);
{WaitTime - Waiting After Connected}
wait(WaitTime);
end;
 
procedure CheckSave; 
var Time : TDateTime; 
begin 
Time:= Now - (0.5 / 1440); 
if InJournalBetweenTimes('Saving World State',Time,Now) >= 0 then Wait(30000) 
end;

procedure CheckTargetError(lines, checktime : integer);
var D : TDateTime;
begin
{5 minutes in DateTime = (1.0 * checktime) / 1440 = 0.00347}
D := Now - ((1.0 * checktime) / 1440.0);
InJournalBetweenTimes('I am already performing another action|doing something',D,Now);

if LineCount > lines then
  begin
  AddToSystemJournal('Error with target. Disconnected');
ClearJournal;
  Disconnect;
  end;

end;

procedure FullDisconnect;
begin
SetARStatus(false);
Disconnect;
end; 

procedure GetResFromGround(tmptyp : cardinal; tmpcol : cardinal; tmpcnt : integer; tmpstr : string); 
// tmptyp   - тип ресурса
// tmpcol   - цвет ресурса 
// tmpcnt   - количество (которое необходимо взять) 
// tmpstr   - название ресурса (для сообщений) 
// Функция ищет на полу указанный ресурс по типу и берет указанное количество. 
// Взятие гарантированное, с проверкой коннекта. Ресурс берется только в том 
// случае, если его количество в паке меньше требуемого. Если ресурс на полу отсутствует, 
// процедура пишет об этом сообщение в журнал и входит в цикл ожидания появления 
// этого ресурса под ногами. 
// v.1.03 (c) Edred 
Var m, p : integer; 
begin 
   p := Count(tmptyp); 
   if p >= tmpcnt then exit; 
   waitconnection(3000); 
   FindTypeEx(tmptyp,tmpcol,Ground,False); 
   if GetQuantity(Finditem) < tmpcnt then 
   begin 
      repeat 
         addtosystemjournal('Warning: Мало ' + tmpstr + ' на полу, добавьте'); 
         wait(10000); 
         FindTypeEx(tmptyp,tmpcol,Ground,False); 
      until GetQuantity(Finditem) >= tmpcnt; 
   end; 
   m := GetQuantity(finditem); 
   if (tmpcnt - p) = 1 then p := p - 1; 
   while not Grab(FindItem,tmpcnt - p) do 
   begin 
      waitconnection(3000); 
      wait(500); 
      checksave; 
   end; 
   wait(500); 
   addtosystemjournal('Взял ' + inttostr(tmpcnt - p) + ' ' + tmpstr + ' из ' + inttostr(m) + ' штук'); 
end;

procedure stack(ObjType, Color : word); 
var PackItem, GroundItem : Cardinal; 
CountIt : integer;
begin 
   PackItem := 0; 
   GroundItem := 0; 
   Findtype(ObjType,backpack);                    
   IF FindFullQuantity > 0 then PackItem := finditem; 
   CountIt := FindFullQuantity;
   Findtype(ObjType,ground);                    
   IF FindFullQuantity > 0 then IgnoreReset; 
   repeat 
      FindtypeEx(ObjType,Color,ground,false); 
      IF FindCount > 0 then 
      if FindQuantity > 55000 then Ignore(finditem) 
      else GroundItem := finditem; 
      FindtypeEx(ObjType,Color,ground,false); 
   until (FindCount = 0) or (GroundItem <> 0); 
   if (PackItem <> 0) and (GroundItem <> 0) then MoveItems(backpack,ObjType,Color,GroundItem,0,0,0,1000) 
   else DropHere(PackItem); 
end;



procedure StackInBox(ObjType, Color : word; container : cardinal); 
var PackItem, GroundItem : Cardinal; 
CountIt : integer;
begin 
   PackItem := 0; 
   GroundItem := 0; 
   Findtype(ObjType,backpack);                    
   IF FindFullQuantity > 0 then PackItem := finditem; 
   CountIt := FindFullQuantity;
   Findtype(ObjType, container);                    
   IF FindFullQuantity > 0 then IgnoreReset; 
   repeat 
      FindtypeEx(ObjType,Color,container,false); 
      IF FindCount > 0 then 
      if FindQuantity > 55000 then Ignore(finditem) 
      else GroundItem := finditem; 
      FindtypeEx(ObjType,Color,container,false); 
   until (FindCount = 0) or (GroundItem <> 0); 
   if (PackItem <> 0) and (GroundItem <> 0) then MoveItems(backpack,ObjType,Color,GroundItem,0,0,0,1000) 
   else MoveItem(PackItem,0,container,0,0,0);
end;

procedure StackInBox50(ObjType, Color : word; container : cardinal); 
var PackItem, GroundItem : Cardinal; 
CountIt : integer;
begin 
   PackItem := 0; 
   GroundItem := 0; 
   Findtype(ObjType,backpack);                    
   IF FindFullQuantity > 0 then PackItem := finditem; 
   CountIt := FindFullQuantity;
   Findtype(ObjType, container);                    
   IF FindFullQuantity > 0 then IgnoreReset; 
   repeat 
      FindtypeEx(ObjType,Color,container,false); 
      IF FindCount > 0 then 
      if FindQuantity > 50000 then Ignore(finditem) 
      else GroundItem := finditem; 
      FindtypeEx(ObjType,Color,container,false); 
   until (FindCount = 0) or (GroundItem <> 0); 
   if (PackItem <> 0) and (GroundItem <> 0) then MoveItems(backpack,ObjType,Color,GroundItem,0,0,0,1000) 
   else MoveItem(PackItem,0,container,0,0,0);
end;

procedure GetResFromBox(tmptyp : cardinal; tmpcol : cardinal; tmpcnt : integer; tmpstr : string; box : cardinal); 
// tmptyp   - тип ресурса
// tmpcol   - цвет ресурса 
// tmpcnt   - количество (которое необходимо взять) 
// tmpstr   - название ресурса (для сообщений) 
// Функция ищет на полу указанный ресурс по типу и берет указанное количество. 
// Взятие гарантированное, с проверкой коннекта. Ресурс берется только в том 
// случае, если его количество в паке меньше требуемого. Если ресурс на полу отсутствует, 
// процедура пишет об этом сообщение в журнал и входит в цикл ожидания появления 
// этого ресурса под ногами. 
// v.1.04 (c) FreeZzy
Var m, p : integer; 
begin 
   p := Count(tmptyp); 
   if p >= tmpcnt then exit; 
   waitconnection(3000); 
   FindTypeEx(tmptyp,tmpcol,box,False); 
   if GetQuantity(Finditem) < tmpcnt then 
   begin 
         addtosystemjournal('Warning: Мало ' + tmpstr + ' в контейнере, добавьте'); 
         wait(600);
            if GetQuantity(Finditem) > 0 then Grab(FindItem, GetQuantity(Finditem));
         exit; 
   end; 
   m := GetQuantity(finditem); 
   if (tmpcnt - p) = 1 then p := p - 1; 
   while not Grab(FindItem,tmpcnt - p) do 
   begin 
      waitconnection(3000); 
      wait(500); 
      checksave; 
   end; 
   wait(500); 
   addtosystemjournal('Взял ' + inttostr(tmpcnt - p) + ' ' + tmpstr + ' из ' + inttostr(m) + ' штук'); 
end;

procedure CheckDoubleStack(tmptypCDS : cardinal; tmpcolCDS : cardinal);
  begin
    FindtypeEx(tmptypCDS,tmpcolCDS,BackPack,false);
    IF FindCount > 1 then stack(tmptypCDS, tmpcolCDS);
  end;
end.