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

Когда-то.. Оском 2... Скрипты для кача и другое.

Only working scripts
Post Reply
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Когда-то.. Оском 2... Скрипты для кача и другое.

Post by admir »

Я нарыл старый хард и решил поделиться тем что когда-то делал для шарда Оском 2.

"Прокачка всех лоров в 1 скрипте" , (Оском 2)

Code: Select all

Program Lores;
//AdmiR(c)
//
//Shard Oskom Opay
//
//Complex macros for next 8 skills:
//Anatomy , Evaluating Int , Animal Lore , Item Ident , Taste Ident, Arms Lore, Musicianship, Tracking on Monsters .
//
//In Back Pack must be dagger and buben(a tambourine).

   {$Include 'all.inc'} 
   
//-- Options --
const

frazaAnatomy = 'looks|Вы так ничего';
frazaEvalInt = 'looks|Вы не узнали';
frazaAnimalLore = 'looks|Вы не узнали';
frazaItemId = 'appears|Вы не узнали';
frazaTasteId = 'It tastes|И не рыба';
frazaArmsLore = 'Вы считаете|Вы так ничего';

TSpellBook = $0EFA;
TDagger = $0F51;
TBuben = $0E9D;

//-- End Options --

procedure DoingSkill(Skill ,Msg : String; Id : Cardinal);
 var
 t : TDateTime;
 begin
   WaitConnection(500);
	t := Now;
	CancelWaitTarget;
	CancelTarget;
	WaitTargetObject(Id);
	useskill(Skill);
	WaitJournalLine (t,Msg,5000);
 end;
 
Procedure SwitchWar();
 begin
   SetWarMode (True);
   wait(10);
   SetWarMode (False);
 end;
 
begin
 
  SetARStatus(true);
  
  while (not dead and (GetSkillValue('Anatomy') < 100.0)) do DoingSkill('Anatomy',frazaAnatomy,self);
  
  while (not dead and (GetSkillValue('Evaluate Intelligence') < 100.0)) do DoingSkill('Evaluate Intelligence',frazaEvalInt,self);
  
  while (not dead and (GetSkillValue('Animal Lore') < 100.0)) do DoingSkill('Animal Lore',frazaAnimalLore,self);
  
  while (not dead and (GetSkillValue('Item ID') < 100.0)) do DoingSkill('Item ID',frazaItemId,self);
  
  while (not dead and (GetSkillValue('Taste Identification') < 100.0) and (FindType(TDagger,Backpack)>0)) do DoingSkill('Taste Identification',frazaTasteId,finditem);
  
  while (not dead and (GetSkillValue('Arms Lore') < 100.0) and (FindType(TDagger,Backpack)>0)) do DoingSkill('Arms Lore',frazaArmsLore,finditem);
  
  while (not dead and (GetSkillValue('Musicianship') < 100.0) and (FindType(TBuben,Backpack)>0)) do 
    begin
	 useobject(finditem);
	 wait(10);
	 SwitchWar();
	 wait(10);
    end;
	
  AutoMenu('Tracking', 'Monsters');
  while (not dead and (GetSkillValue('Tracking') < 100.0)) do 
    begin
	  WaitConnection(500);
	  UseSkill('Tracking');
	  WaitJournalLine (Now,'You see',2000);
	end;
	
end.
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Post by admir »

Это hlopok.inc для папки include
Тут я собрал что-то вроде основ функций работы с хлопком и все с ним связанное.
В дальнейшем некотрые скрипты затрагивают этот инклуд.

Code: Select all

// AdmiR ©
//
// Shard Oskom Opay (uoo.ru)
// 
// Complex Include for Cotton - Folder making process.
//
// GetCooton( Id : Cardinal) - Find cottons on ground and get theirs. Parametr ID - Id of Container for cottons.
// (Ru) Собирает с земли кусты хлопка, складывает в контейнер. Передаем в параметре ID контейнера.
//
// MakeSpools( Id : Cardinal) - Find The Spinning Wheel, get cotton from conteiner (ID) and make Spolls.
// (Ru) Берет из контейнера хлопок , перерабатывает на колесе в нитки и складывает обратно в контейнер.
//
// MakeBoltOfCloth( Id : Cardinal) - Find The Upright Loom, get spolls from conteiner (ID) and make folder.
//   If char has Scissors for cut Bolt Of Cloth, It put Folder , If not  - put Bolt Of Cloth.
// (Ru) Берет из контейнера нитки, делает рулоны, если есть ножницы режет на ткань. Складывает обратно в контейнер.
//
// MakeBandage( Id : Cardinal) - get folders from conteiner (ID), and cut it to bandages.
// (Ru) Берет ткань, режет на бинты, складывает обратно.
//


const
 TBalesOfCotton = $0DF9;
 TCotton = $0C4F;
 TSpinningWheel1 = $1015;
 TSpinningWheel2 = $1016;
 TUprightLoom = $1060; 
 TSpolls = $0FA0;
 TBoltOfCloth = $0F95;
 TScissors1 = $0F9E;
 TScissors2 = $0F9F;
 TFolder = $175D;
 TBandage = $0E21;





Procedure GetCooton( Id : Cardinal);
var
MaxWeight : Word;
 begin
   AddToSystemJournal('GetCooton');
   FindDistance:=3;
   MaxWeight := Str*4;
   WaitConnection(500);

   while findtype(TCotton, ground)>0 do 
    begin
	  useobject(FindItem);
	  WaitJournalLine (Now,'You put|You can',300);
	  if Weight > MaxWeight then while findtype(TBalesOfCotton,backpack)>0 do MoveItem(FindItem,0,Id,0,0,0); 
	end;
   while findtype(TBalesOfCotton,backpack)>0 do MoveItem(FindItem,0,Id,0,0,0); 
   CheckLag;
 end;
 
 
 
 
Procedure MakeSpools( Id : Cardinal);
// Ves 1 Bales Of Cotton = 7.2
var
IdSpinningWheel : Cardinal;
Num : Single;
MaxWeight : Word;
 begin
 AddToSystemJournal('MakeSpools');
   FindDistance:=4;
   WaitConnection(500);
   MaxWeight := Str*4;
   Num := (MaxWeight - Weight) / (72/10) ;
  // AddToSystemJournal(FloatToStr(Num));
   if (FindType(TSpinningWheel1,Ground)>0) then IdSpinningWheel := Finditem
   else if (FindType(TSpinningWheel2,Ground)>0) then IdSpinningWheel := Finditem
   		else Exit;
   useobject(Id);
   if Num > 0 then
     if findtype(TBalesOfCotton,Id)>0 then MoveItem(FindItem,Round(Num),backpack,0,0,0); 
   while findtype(TBalesOfCotton,backpack)>0 do
    begin
	  //AddToSystemJournal('Make4');
	  waittargetobject(IdSpinningWheel);
	  //AddToSystemJournal('Make4-1');
	  //wait(200);
	  useobject(FindItem);
	  //AddToSystemJournal('Make4-2');
	  //wait(200);
	  ClickOnObject(IdSpinningWheel);
	  //AddToSystemJournal('Make4-3');
	  CheckLag;
	end;
	//AddToSystemJournal('Make4-5');
	//CheckLag;
	
	//AddToSystemJournal('Make5');
	CheckLag;
   while findtype(TSpolls,backpack)>0 do MoveItem(FindItem,0,Id,0,0,0);
 end;
 
 
 
 
Procedure MakeBoltOfCloth( Id : Cardinal);
// Ves 1 Spool = 1.2
 var
 IdScissors ,IDUprightLoom : Cardinal;
 Num : Single;
 MaxWeight ,flag1 : Word;
 begin
    AddToSystemJournal(' MakeBoltOfCloth');
   FindDistance:=4;
   WaitConnection(500);
   MaxWeight := Str*4;
   Num := (MaxWeight - Weight) / 1.2; //(12/10) ;
   //AddToSystemJournal(FloatToStr(Num));
   if (FindType(TUprightLoom,Ground)>0) then IDUprightLoom := Finditem
   else Exit;
   flag1 := 1;
   if (FindType(TScissors1,backpack)>0) then IdScissors := Finditem
   else if (FindType(TScissors2,backpack)>0) then IdScissors := Finditem
   		else flag1 := 0;
   useobject(Id);
   wait(100);
   if Num > 0 then
     if findtype(TSpolls,Id)>0 then MoveItem(FindItem,Round(Num),backpack,0,0,0);
   CheckLag;  
   while findtype(TSpolls,backpack)>0 do
    begin
	  CancelWaitTarget;
	  CancelTarget;
	  waittargetobject(IDUprightLoom);
	  useobject(FindItem);
	  CheckLag;
	  addtosystemjournal('1');
	  If findtype(TBoltOfCloth,backpack)>0 then
	    if flag1 = 1 then 
		 begin
		  CancelWaitTarget;
		  CancelTarget;
		  waittargetobject(finditem);
		  useobject(IdScissors);
		  wait(100);
		 end
		else MoveItem(FindItem,0,Id,0,0,0);
	    CheckLag;
	  if findtype(TFolder,backpack)>0 then MoveItem(FindItem,0,Id,0,0,0);
	end;
 end;
 
Procedure MakeBandage( Id : Cardinal);
// Ves 1 Folder = 0.5
 var
 IdScissors : Cardinal;
 Num : Single;
 MaxWeight : Word;
 begin
 AddToSystemJournal(' MakeBandage');
   WaitConnection(500);
   MaxWeight := Str*4;
   Num := (MaxWeight - Weight) *1.5 ;
  // AddToSystemJournal(FloatToStr(Num));
   if (FindType(TScissors1,backpack)>0) then IdScissors := Finditem
   else if (FindType(TScissors2,backpack)>0) then IdScissors := Finditem
   		else Exit;
   useobject(Id);
   wait(100);
   if Num > 0 then
     if findtype(TFolder,Id)>0 then MoveItem(FindItem,Round(Num),backpack,0,0,0);
   while findtype(TFolder,backpack)>0 do 
    begin
	  CancelWaitTarget;
	  CancelTarget;
	  waittargetobject(finditem);
	  useobject(IdScissors);
	end;
   while findtype(TBandage,backpack)>0 do MoveItem(FindItem,0,Id,0,0,0);
	CheckLag;
 end;
Last edited by admir on 09.10.2010 21:24, edited 1 time in total.
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Post by admir »

И сразу же для комплекта сам скрипт прокачки Тейлора для Оскома 2.
В принципе подкорректировать несложно зная типы производимых предметов и скил с которого надо начинать его производить.

Code: Select all

//Fancy Dress 12 Folded Cloth, 1 Spool of Thread Tailoring   13.6          
//Half Apron 6 Folded Cloth, 1 Spool of Thread Tailoring      22.7 
//Long Pants 8 Folded Cloth, 1 Spool of Thread Tailoring     27.2            
//Plain Dress 10 Folded Cloth, 1 Spool of Thread Tailoring   36.3        
//Robe 16 Folded   Cloth, 1 Spool of Thread Tailoring         59.0               
//i_single_red_curtain     15 Folded Cloth, 1 Spool of Thread 90

Program Tailor;
//AdmiR©

 {$Include 'all.inc'} 
 {$Include 'hlopok.inc'}
 
 
const
TSevingKit = $0F9D;
IdContainerRes = $40075CA4;
IdContainerEmptyBag = $400A7BEC;
IdContainerFullBag = $400E54A7;

TCraftFancyDress = $1EFF;
TCraftHalfApron = $153B;
TCraftLongPants = $1539;
TCraftPlainDress = $1F01;
TCraftRobe = $1F03;


var
MaxWeight : Word;
IdSevingKit : Cardinal;
ItemName : String;
ItemType : Cardinal;
IdSciss : Cardinal;


Procedure GetSpools;
 begin
      UseObject(IdContainerRes);
      CheckLag;
      GetCooton(IdContainerRes);
      if findtype(TSpolls,IdContainerRes)>0 then MoveItem(FindItem,50,backpack,0,0,0) 
      else
       begin
         MakeSpools(IdContainerRes);
       end;
 end;
 
Procedure GetFolder;
 var 
 Num : Single;
 begin
      UseObject(IdContainerRes);
      CheckLag;
      GetCooton(IdContainerRes);
      if findtype(TFolder,IdContainerRes)>0 then 
       begin
          Num := (MaxWeight - Weight) *2 ;
          if (Num > 500) then Num := 500;
          MoveItem(FindItem,Round(Num),backpack,0,0,0);
       end
      else
       begin
         MakeSpools(IdContainerRes);
         MakeBoltOfCloth(IdContainerRes);
       end;
 end;
 
Procedure MakeItem;
 begin
  if (Count(TSpolls)<5) then GetSpools
  else 
    if (Count(TFolder)<20) then GetFolder
    else
     begin
       WaitConnection(500);
       checklag;
       CancelWaitTarget;
       CancelTarget;
       //wait(50);
       waittargettype(TFolder);
       useobject(IdSevingKit);
       wait(200);
       WaitJournalLine(Now,'Плохой|You put',5000);
     end;
 end;
 
 
Procedure DetermineMenu(Promt1,Choice1,Promt2,Choice2 : String; Ty : Cardinal);
 begin
  ItemName := Choice2;
  ItemType := Ty;
  CancelMenu;
  AutoMenu (Promt1, Choice1);
  AutoMenu (Promt2, Choice2);
 end;

 
begin
    MaxWeight := Str*4;
    FindDistance:=3;
    ItemName := 'Null'
    SetARStatus(true);
    if (FindType(TSevingKit,backpack)>0) then IdSevingKit := Finditem
    else 
        begin
          AddToSystemJournal('Seving Kit не найден');
          exit;
        end;
    
    if (FindType(TScissors1,backpack)>0) then IdSciss := Finditem
    else 
      if (FindType(TScissors2,backpack)>0) then IdSciss := Finditem
      else
           begin
          AddToSystemJournal('Scissors ножницы не найдены');
          exit;
        end;
        
    
    while (not dead and (GetSkillValue('Tailoring') < 100.0)) do
     begin
     
       WaitConnection(500);
       if (GetSkillValue('Tailoring') >= 13.6) and (GetSkillValue('Tailoring') < 22.7) and (ItemName <> 'fancy dress') then DetermineMenu('Cloth','Shirts','Shirts','fancy dress',TCraftFancyDress);
       if (GetSkillValue('Tailoring') >= 22.7) and (GetSkillValue('Tailoring') < 27.2) and (ItemName <> 'half apron') then DetermineMenu('Cloth','Misc','Misc','half apron',TCraftHalfApron);
       if (GetSkillValue('Tailoring') >= 27.2) and (GetSkillValue('Tailoring') < 36.3) and (ItemName <> 'long pants') then DetermineMenu('Cloth','Pants','Legwear','long pants',TCraftLongPants);
       if (GetSkillValue('Tailoring') >= 36.3) and (GetSkillValue('Tailoring') < 59.0) and (ItemName <> 'plain dress') then DetermineMenu('Cloth','Shirts','Shirts','plain dress',TCraftPlainDress);
       if (GetSkillValue('Tailoring') >= 59.0) and (GetSkillValue('Tailoring') < 90) and (ItemName <> 'robe') then DetermineMenu('Cloth','Shirts','Shirts','robe',TCraftRobe);
       if (GetSkillValue('Tailoring') >= 90) and (GetSkillValue('Tailoring') < 100) and (ItemName <> 'robe') then DetermineMenu('Cloth','Shirts','Shirts','robe',TCraftRobe);

     
       MakeItem;
     
       while findtype(ItemType,backpack)>0 do 
        begin
          CancelWaitTarget;
          CancelTarget;
          waittargetobject(finditem);
          useobject(IdSciss);
        checklag;
        end;
      
      
       
       If Count(TBandage) > 100 then while findtype(TBandage,backpack)>0 do MoveItem(FindItem,0,IdContainerRes,0,0,0);
       
     end;
end.     
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Post by admir »

====
СОбсвтенно основные инклуды , где-то подкорректированные.

all.inc

Code: Select all

{$Include 'checksave.inc'} 
{$Include 'hungry.inc'} 
{$Include 'checktargeterror.inc'} 
{$Include 'WaitConnection.inc'} 
{$Include 'stack.inc'} 
{$Include 'CheckLag.inc'} 
{$Include 'IsSystemMsg.inc'} 
{$Include 'timer.inc'} 


// Item Counter in Bag

Function ItemsCounter(Bag: cardinal): Integer;
Var
STime:TDateTime;
S: String;

Begin
STime:=Now;
ClickOnObject(Bag);
WaitJournalLine(Now,'items)',1000);
if (InJournalBetweenTimes('items)',STime,Now) = -1) or (LineID <> Bag) then begin result:=-1; exit; end
else
begin
  s:= Journal(LineIndex);
  Delete(s, 1, Pos('(',s));
  Delete(S,Pos(' ',S),Length(S));
  try
    result := strToInt(S);
  except
    result := -1;
  end;
end;
End;
IsSystemMsg.inc

Code: Select all

Function IsSystemMsg(Str : String; TimeBegin,TimeEnd : TDateTime) : Boolean;
begin
  result := false;
  if (InJournalBetweenTimes(Str, TimeBegin, TimeEnd) > -1) and (LineName = 'System') then result := true;
end;

waitconnection.inc

Code: Select all

procedure WaitConnection(WaitTime : Integer);
begin
if Connected then Exit;
while not Connected do Wait(1000);
{WaitTime - Waiting After Connected}
wait(WaitTime);
end;
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Post by admir »

Animal Taming.
Тоже самое- скорректировать типы живности и с какого скилла.

Скрипт сам выискивает по заданным типам животных вокруг и начинает тамить.
100% полтора дня фул гм :)

П.С. Все скрипты на тот момент (год назад) были работоспособны и приносили плоды в виде гп, была построена для этого база на которой шел круглосуточный кач чаров с о1 и о2 :)

Code: Select all

PROGRAM Animal;
//AdmiR(c)

//Oskom shard
//

   {$Include 'all.inc'} 
   
//-- Options --


type 
// Massmove of animal 
// [x][1] - Type
//    [2] - Color

TAnimal = array[1..100] of array[1..2] of Cardinal;

var
//IdAnimal : cardinal;
k,i,flag : integer;
nom : integer;
//ctime : TDateTime;
//NameHorse : String;
//Animal : array [1..10] of Cardinal;
Animal : TAnimal;
Massive : array [1..100] of Cardinal;
OldSkill : Double; 

procedure CreateMassive(nStart, nEnd : integer);
  var
  i : Integer;
  begin
    WaitConnection(500);
     //AddToSystemJournal(IntToHex(Animal[1],8));
    flag := nEnd;
	nom := 0;
	for i := nStart to nEnd do
	 begin
	   repeat
	     WaitConnection(500);
		// findtype(Animal[i], ground); 
		FindTypeEx(Animal[i][1],Animal[i][2],ground,false);
		 if finditem <> 0 then 
			begin
			 // AddToSystemJournal(IntToHex(finditem,8));
			 // AddToSystemJournal(IntToStr(nom));
			  nom := nom+1;
			  Massive[nom] := finditem;
			  //Taming(Massive[nom]);
			  //UOSay('all release');
			  ignore(finditem);
			end; 	
		until finditem = 0;
	 end; 
	 AddToSystemJournal(IntToStr(nom));
	 IgnoreReset;
  end;

procedure Taming(Id : Cardinal);
  var
  Times : TDateTime;
  begin
    //Times := Now;
    repeat
	 // AddToSystemJournal(IntToStr(Id));
	  WaitConnection(500);
	  Times := Now;
	  CancelWaitTarget;
	  CancelTarget;
      WaitTargetObject(Id);
	  UseSkill('Animal Taming'); 
	  WaitJournalLine (Times,'It seems|is already|Target is not in line|Приручить не удалось|You can|remembers you|Ваше умение|Вы не видите',25000)
	// AddToSystemJournal('Check2'); 
	until InJournalBetweenTimes('It seems|is already|Target is not in line|You can|remembers you|Ваше умение|Вы не видите',Times,Now) <> -1;
  end;

Begin 
    // Type of Animal
	Animal[1][1] := $0006; // Bird 0
	Animal[2][1]:= $0005; // Eagle 28
	Animal[3][1] := $00E4; // Horse 37
	Animal[4][1] := $00E2; // Horse
	Animal[5][1] := $00CC; // Horse
	Animal[6][1] := $00C8; // Horse 37
	Animal[7][1] := $00DC; // Llama  45
	Animal[8][1] := $00E8; // Bull  65
	Animal[9][1] := $00E9; // Bull  65
	Animal[10][1] := $00CC; // Must  80
	
	// Color Of animal
	Animal[1][2] := $FFFF;
	for i:= 2 to 7 do Animal[i][2] := $0000;
	for i:= 8 to 9 do Animal[i][2] := $FFFF;
	Animal[10][2] := $01B6;
	
	flag := 0; 
	Finddistance := 4; 
	OldSkill := GetSkillValue('Animal Taming'); 
	SetARStatus(true);
	
	
	while (not dead and (GetSkillValue('Animal Taming') <= 100.0)) do
	begin
	
	  if (GetSkillValue('Animal Taming') >= 0) and (flag < 1) then CreateMassive(1,1);
	  if (GetSkillValue('Animal Taming') >= 28) and (flag < 2) then CreateMassive(1,2);
	  if (GetSkillValue('Animal Taming') >= 37) and (flag < 6) then CreateMassive(2,6);
	  if (GetSkillValue('Animal Taming') >= 45) and (flag < 7) then CreateMassive(3,7);
	  if (GetSkillValue('Animal Taming') >= 65) and (flag < 9) then CreateMassive(3,9);
	  if (GetSkillValue('Animal Taming') >= 80) and (GetSkillValue('Animal Taming') < 100) and (flag < 10) then CreateMassive(3,10);
	  if (GetSkillValue('Animal Taming') >= 100) and (flag < 10) then CreateMassive(1,10);

	  

	  
	  WaitConnection(500);
	  if nom = 0 then exit;
	  for k := 1 to nom do 
	    begin
          Taming(Massive[k]);
	     // UOSay('all release');
		  if GetSkillValue('Animal Taming') > OldSkill then
           begin
              AddToSystemJournal('Animal Taming  ' + FloatToStr(GetSkillValue('Animal Taming')));
              OldSkill := GetSkillValue('Animal Taming');
           end;
	    end 
	
	  //AddToSystemJournal('konecc');
	   
	  //AddToSystemJournal(IntToStr(getArraylength(Animal)));
	  
	 // for k := 1 to nom do AddToSystemJournal(IntToHex(Massive[k],8));
	end;
end.
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Post by admir »

БС
Крафтит, плавит.
Выбор крафтового итема до 3х выскакивающих меню подряд.
Требует молоток в паке и форжу на земле.

Настройка только одного массива.

Code: Select all

..Craft := [
	makeTCraft....
// makeTCraft(min скил ,max скил, Тип крафт итема, Цвет крафт итема, Тип используемого ресурса,
// меню1(название,выбор), меню2, меню3)

Code: Select all

Program BS;
//AdmiR©
// Вес 1 ингота = 1

 {$Include 'all.inc'} 
 

 
const
IdContainerRes = $40065A42;  // Контейнер с ресурсами
NameSkill = 'Blacksmithing';
MaxSkillValue = 100.0;



TypeSmith1= $13E3;
TypeSmith2= $13E4;
TypeIngot = $1BF2;
TypeForge1 = $199A;
TypeForge2 = $1992;

type
   TCraft = record
      minSkill,maxSkill : double; 
	  TypeCraft, ColorCraft, TypeReagToUse : Cardinal;
	  Choice1, Promt1, Choice2, Promt2 , Choice3, Promt3: String;
	  Flag : Boolean;
   end;


var
MaxWeight ,Num : Word;
IdSmith, IdForge: Cardinal;
f : Integer;
var Craft : array of TCraft; 


// makeTCraft(min скил ,max скил, Тип крафт итема, Цвет крафт итема, Тип используемого ресурса, 
// меню1(название,выбор), меню2, меню3)

function makeTCraft(minSkill,maxSkill : double;TypeCraft, ColorCraft, TypeReagToUse : Cardinal;Choice1, Promt1 , Choice2, Promt2, Choice3, Promt3: String) : TCraft;
begin
  result.minSkill := minSkill;
  result.maxSkill := maxSkill;
  result.TypeCraft := TypeCraft;
  result.ColorCraft := ColorCraft;
  result.TypeReagToUse := TypeReagToUse;
  result.Choice1 := Choice1;
  result.Promt1 := Promt1;
  result.Choice2 := Choice2;
  result.Promt2 := Promt2;
  result.Choice3 := Choice3;
  result.Promt3 := Promt3;
  result.Flag := false;
end; 

Procedure GetIngot;
 begin
 	  Num := (MaxWeight - Weight)*1;
	  UseObject(IdContainerRes);
	  CheckLag;
	  if  FindTypeEx(TypeIngot,0,IdContainerRes,false)>0 then MoveItem(FindItem,Num,backpack,0,0,0);
 end;
 

Procedure MakeItem;
 begin
  if (Count(TypeIngot)<20) then GetIngot
  else 
	 begin
	   checklag;
	   WaitConnection(500);
	   CloseMenu;
	   CancelWaitTarget;
	   CancelTarget;
	   //wait(50);
	   waittargettype(TypeIngot);
	   useobject(IdSmith);
	   wait(300);
	   WaitJournalLine(Now,'Вы так и|You put',7000);
     end;
 end;

Procedure SmeltItem;
 begin
  while findtype(Craft[f].TypeCraft,backpack)>0 do 
	    begin
		  CancelWaitTarget;
	      CancelTarget;
	      waittargetobject(finditem);
		  useobject(IdForge);
		  checklag;
	    end;
 end;

begin
    MaxWeight := Str*4;
	FindDistance:=3;
	SetARStatus(true);
	WaitConnection(1000);
	
	
	Craft := [
	makeTCraft(0, 27, $1B7B, 0, $1BF2, 'Blacksmithing','Shields', 'Shields','metal shield','',''),
	makeTCraft(27, 40.8, $0F51, 0, $1BF2, 'Blacksmithing','Weapons', 'Swords & Blades','dagger','',''),
	makeTCraft(40.8, 43, $0F51, 0, $1BF2, 'Blacksmithing','Weapons', 'Weapons','Swords & Blades','Swords & Blades','dagger'),
	makeTCraft(43, 53, $0F5C, 0, $1BF2, 'Blacksmithing','Weapons', 'Weapons','Maces & Hammers','Maces & Hammers','mace'),
	makeTCraft(53, 60, $1440, 0, $1BF2, 'Blacksmithing','Weapons', 'Weapons','Swords & Blades','Swords & Blades','cutlass'),
	makeTCraft(60, 65, $13B5, 0, $1BF2, 'Blacksmithing','Weapons', 'Weapons','Swords & Blades','Swords & Blades','scimitar'),
	makeTCraft(65, 72, $1400, 0, $1BF2, 'Blacksmithing','Weapons', 'Weapons','Swords & Blades','Swords & Blades','kryss'),
	makeTCraft(72, 115, $13FE, 0, $1BF2, 'Blacksmithing','Weapons', 'Weapons','Swords & Blades','Swords & Blades','katana')];
	

	
	checklag;
	WaitConnection(1000);
	Disarm;
	checklag;
	if (FindType(TypeSmith1,backpack)>0) then IdSmith := Finditem
    else if (FindType(TypeSmith2,backpack)>0) then IdSmith := Finditem
   		else begin AddToSystemJournal('Кузнечный молоток не найден'); exit; end;
		
	if (FindType(TypeForge1,ground)>0) then IdForge := Finditem
    else if (FindType(TypeForge2,ground)>0) then IdForge := Finditem
   		else begin AddToSystemJournal('Forge не найдена'); exit; end;
	

    while (not dead and (GetSkillValue(NameSkill) < MaxSkillValue)) do
	begin
		checklag;
		WaitConnection(1000);
		for f := 0 to getArrayLength(Craft) - 1 do
		   //addtosystemjournal(inttostr(f));
		   if (GetSkillValue(NameSkill) >= Craft[f].minSkill) and (GetSkillValue(NameSkill) < Craft[f].maxSkill) then
		   begin
			   if (Craft[f].Flag=false) then
			   begin
				  Craft[f].Flag := true;
				  CancelMenu;
				  AutoMenu (Craft[f].Choice1, Craft[f].Promt1);
				  if (Craft[f].Choice2 <> '') and (Craft[f].Promt2 <> '') then AutoMenu (Craft[f].Choice2, Craft[f].Promt2);
				  if (Craft[f].Choice3 <> '') and (Craft[f].Promt3 <> '') then AutoMenu (Craft[f].Choice3, Craft[f].Promt3);	   
			   end;
			   break;
			end;

		MakeItem;
		SmeltItem;
	end;

end.
Last edited by admir on 10.10.2010 9:33, edited 1 time in total.
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Post by admir »

Хил - кач - сутки.

Code: Select all

PROGRAM Healing;
//AdmiR(c)

   {$Include 'all.inc'} 
   {$Include 'hlopok.inc'} 

const
TypeUliy=$091A;
TypeWater=$0B43;
IDSumka=$40075CA4;
TypeBandage=$0E21;
TypeBloodBandage=$0E20;
Eda=$097B;   //    # Еда - рыба(жареная)

var
IDUliy , IDWater : Cardinal;
ExitFlag : Boolean; 


procedure WashBloodBandage;
 begin
  if (FindType(TypeBloodBandage,Backpack)>0) then 
    begin
          AddToSystemJournal('грязные бинты1');
          AddToSystemJournal(inttostr(IDWater));
	  WaitTargetObject(IDWater);
	  UseObject(Finditem);
	  AddToSystemJournal('Бинты помыты');
	end;
 end;
 
procedure GetBandage;
 begin
   if (Count(TypeBandage)<10) then
    begin
	  UseObject(IDSumka);
	  CheckLag;
	  GetCooton(IDSumka);
	  findtype(TypeBandage,IDSumka);
	  if (FindFullQuantity=0) then 
	   begin
	     AddToSystemJournal('Нету Чистых бинтов');
		 //ExitFlag:=true;
	     //exit;
		 GetCooton(IDSumka);
		 MakeSpools(IDSumka);
		 MakeBoltOfCloth(IDSumka);
		 MakeBandage(IDSumka);
	   end
      else MoveItem(FindItem,200,Backpack,0,0,0); 
	end;
 end;

begin
    ExitFlag:=false;
	FindDistance:=3;
	SetARStatus(true);
	if (FindType(TypeUliy,Ground)>0) then IDUliy := Finditem
	else 
		begin
		  AddToSystemJournal('Улий не найден');
		  ExitFlag:=true;
		  exit;
		end;
	if (FindType(TypeWater,Ground)>0) then IDWater := Finditem
	else 
		begin
		  AddToSystemJournal('Мойка не найдена');
		  ExitFlag:=true;
		  exit;
		end;
		
	

  while (not dead and not ExitFlag and (GetSkillValue('Healing') < 100.0)) do
  begin

   
	ADDTOSYSTEMJOURNAL('11');	
	WaitConnection(500);
	WashBloodBandage;
	GetBandage;
	

	
	CheckLag;
	ADDTOSYSTEMJOURNAL('22');
	if (Life < MaxLife) then 
	 while (Life < MaxLife) and not ExitFlag do
	   begin
	     CancelWaitTarget;
		 CancelTarget;
		 WaitTargetSelf;
		 UseType(TypeBandage,$FFFF);
		 WaitJournalLine(Now,'Вы кладете bloody|Вы хотите сделать мумию|Бинты совсем не помогли',2500);
	   end
	else useobject(IDUliy);
	wait(50);
  end;
end. 
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Post by admir »

Магия.

Code: Select all

PROGRAM Magery;
//AdmiR(c)

//Oskom shard
//
//

   {$Include 'all.inc'}
   {$Include 'hlopok.inc'}  // If no include - comment this line
   
//-- Options --

const
BagResourse=$400C6705; //  #  ID. Sumka gde regi
Reagent=$0F88; //  # NightShade
//Eda=$097B;   //    # Еда - рыба(жареная)
ObjectForCast=$0EFA; // # Type Magik Book
MsgFizzleCast='Заклинание не удалось!'; //Fizzle cast system message  
TDragGorget = $1413;
CDragGorget = $0845;
IDSumka=$40075CA4;

//-- End Options --

var
ExitFlag, FlagDrag : Boolean; 
Gorget : Cardinal;

 
Procedure CheckDragon();
begin
 FlagDrag := true;
 If (GetType(ObjAtLayer(NeckLayer)) = TDragGorget) and (GetColor(ObjAtLayer(NeckLayer)) = CDragGorget) then Gorget :=ObjAtLayer(NeckLayer)
 else FlagDrag := false ;
end;

Procedure DragGorget();
begin
 UnEquip(NeckLayer);
 CheckLag;
 Equip(NeckLayer,Gorget);
end;
 

procedure CheckWar;
begin
 if WarMode then SetWarMode(false);
end;

procedure CheckMana;
begin
//AddToSystemJournal('Проверка маны');
 if Mana < 10 then
  begin
  If FlagDrag = true then DragGorget();
  GetCooton(IDSumka);   // If no Include 'hlopok.inc' Then comment this line
  repeat
   useskill('Meditation');
     //checksave;
   CheckWar;
   wait(1000);
   //AddToSystemJournal('мана');
  until Mana = Int;
 end;
end; 

 
procedure CheckRegi;
 begin
    //AddToSystemJournal('чек рег');
   if (Count(Reagent)<10) then
    begin
	  findtype(Reagent,BagResourse);
	  if (FindFullQuantity=0) then 
	   begin
	     AddToSystemJournal('Нету Реагентов');
		 //ExitFlag:=true;
	     exit;
	   end
      else MoveItem(FindItem,400,Backpack,0,0,0); 
	end;
 end;
 

procedure Casting;
 var 
 m : Word;
 Times : TDateTime;
 begin
   //AddToSystemJournal('каст');
   m := Mana;
   WaitTargetType(ObjectForCast);
   Cast('Poison'); 
   wait(100);
   CheckLag;
   Times := Now;
   while (m <= Mana) and not IsSystemMsg(MsgFizzleCast,Times, Now) and (Times + (3.0/86400) > Now) do wait(50);
 end;

begin
  
  SetARStatus(true);
  CheckDragon();
  while (not dead and not ExitFlag and (GetSkillValue('Magery') < 100.0)) do
  begin
    WaitConnection(500);
	CheckWar;
    ExitFlag:=false;
	UseObject(BagResourse);
	CheckLag;	
	CheckRegi;
	CheckMana;
	Casting;
	//If (GetSkillValue('Magery') >= 100) then ExitFlag:=true;
	
  end;
end. 
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Post by admir »

Медитация

Code: Select all

PROGRAM Meditation;
//AdmiR(c)

//Oskom shard
//
{$Include 'all.inc'} 

const
TypeRoba=$1F03;
MagicBook=$0EFA;

var
ExitFlag : Boolean; 
Roba : Cardinal;
Times : TDateTime;

procedure CheckWar;
 begin
  if WarMode then SetWarMode(false);
 end;

Procedure DropKursor;
 begin
   if (FindType(MagicBook,Backpack)>0) then MoveItem(FindItem,1,Backpack,0,0,0);
   CheckLag;
 end;

begin
 SetARStatus(true);
 ExitFlag:=false;
 DressSpeed:=5;
 
 UnEquip(RobeLayer);
 DropKursor;
 if (FindType(TypeRoba,Backpack)>0) then Roba:=Finditem 
 else 
   begin 
   AddToSystemJournal('Нету робы в паке'); ExitFlag:=true; 
   end;
 useobject(Roba);
 wait(3000);
 while (not dead and not ExitFlag) do
  begin
    WaitConnection(500);
	CheckWar;
	//AddToSystemJournal(IntToStr(DressSpeed));
	UnEquip(RobeLayer);
	useskill('Meditation');
	CheckLag;
	if (FindType(TypeRoba,Backpack)=0) then DropKursor;
	UseType(TypeRoba,$FFFF);
	Times := Now;
	while not IsSystemMsg('You are at|Медитация прервана|Вам не до этого',Times, Now) and (Times + (10.0/86400) > Now) do wait(50);
	//CheckLag;	
	//If (GetSkillValue('Meditation') >= 100) then ExitFlag:=true;
	
  end;
end.
admir
Novice
Novice
Posts: 97
Joined: 28.10.2008 20:44

Post by admir »

Ну и под занавес:
Незаконченный проект "Трейдер".
http://newvlad.nm.ru/trader.html

На тот момент все функции работали.

Принцип работы:
Создавался файл отчетности temp.log, где структурированно отмечались любые запросы на трейдеров и где хранились все операции.

Code: Select all

...
2|2|9|27.02.2009 3:40:11|3|9199|401603|Dark Man|
2|2|13|27.02.2009 3:40:48|45|9154|401603|Dark Man|
2|1|0|27.02.2009 3:42:24|5|9164|401603|Dark Man|
2|1|Disc|27.02.2009 3:42:26|5|9164|401603|Dark Man|
2|1|Disc|27.02.2009 3:42:28|5|9164|401603|Dark Man|
...
Синхронизация по времени происходила в связке комп - и метка на руне на которой писалось время путем переименования руны :)

За счет этого было не возможно сбить или обмауть чаров если шарды откатились. Тоесть трейдеры постоянно сверяли метку времени и если произошел откат то все операции совершенные после места отката аннулировались.

Все проведенные тесты были успешными.
Чары со 100% успехом принимали и передавали деньги на лагах на откатах и тд.

В описании не исправлено одна вещь.
Надо указывать при переводе гп - ИД чара получателя.

--
А теперь расскажу чуть-чуть о неосуществленных мечтах, эхх...

В планы входило прикрутить интернет магазин, через который можно было бы купить вещь или гп в игре за реальные $.

Любой желающий в игре мог положить на чара предмет или перевести гп (предварительно оформив товар в инет магазине) и указав цену.

Клиент заходит в магазин выбирает товар оплачивает, после чего в игре получает товар с трейдера-бота.

Ну поскольку все это требовало времени а времени нет то быть может кому-то мои разработки будут полезны.

===

Trader1

Code: Select all

Program New;
//EXPER1
{$Include 'all.inc'}

const
fname='C:\games\uo\stealth_v1.0 (rc 3)\Stealth_v1.0 (RC 3)\temp.log';
NumberBot=1;
NumberBotOther=2;

IdOtherBot=$000194F6;
IdSelf=$000CB284;
Runa=$4024FBCC;

TimeToSaveSphere=36.0;
TimeToInfoMsg=600000; // 1000 = 1 sec
TimeToSynhro=20000;

TradeKurs=1.0;
MaxTradeGp=10000;
MinTradeGp=10;

var
IdClient, MyGold,IdGainer : Cardinal;
NameClient : String;
starttime, TimeClient : TDateTime;
GoldCoin : array[1..3] of Cardinal;
i :Integer;
FrazeGoodbye : String;
InfoTimer ,SynchroTimer : TTimer;

Procedure CheckGold;
begin
  SetGlobal('stealth','GoldO1',IntToStr(Gold));
end;

procedure WaitConnectionEx(WaitTime : Integer);
begin
if Connected then Exit;
while not Connected do begin SetGlobal('stealth',IntToStr(IdSelf),'0'); Wait(1000); SetGlobal('stealth','TestVar1',IntToStr(IdSelf)); end;
{WaitTime - Waiting After Connected}
wait(WaitTime);
SetGlobal('stealth',IntToStr(self),'1');
end;

Procedure PutMoneyBank;
var
j:Integer;
Bank: Cardinal;
begin
  uosay('bank');
  checklag;
  Bank:=ObjAtLayer(BankLayer);
  if Bank <> 0 then
  begin
    for j:=1 to 3 do  
	  while CountEx(GoldCoin[j],$0000,backpack) > 0 do 
	  begin
	    if (FindTypeEx (GoldCoin[j],$0000,Backpack,True) > 0) then MoveItem(FindItem,0,Bank,0,0,0);
		checklag;
	  end;
  end;
end;


Function GetMoneyBank(TransferGold : Cardinal) : Boolean;
var j,i : Integer;
BackPackGold ,BankGold, Bank: Cardinal;
t: TDateTime;
begin
  if TransferGold > Gold then begin Result:=false; exit; end;
  
  BackPackGold := 0;
  BankGold := 0;
  
  for j:=1 to 3 do  BackPackGold := BackPackGold + CountEx(GoldCoin[j],$0000,backpack);
  
  if BackPackGold >= TransferGold then begin Result:=true; exit; end;
  
  uosay('bank');
  checklag;
  Bank:=ObjAtLayer(BankLayer);
  if Bank = 0 then begin Result:=false; exit; end; 
  t := Now;
  while BackPackGold < TransferGold do
  begin
    BankGold := TransferGold - BackPackGold;
    for j:=1 to 3 do   
      if (FindTypeEx (GoldCoin[j],$0000,Bank,True) > 0) then 
      begin
        MoveItem(FindItem,BankGold,backpack,0,0,0);
        checklag;
        BackPackGold:=0;
        for i:=1 to 3 do  BackPackGold := BackPackGold + CountEx(GoldCoin[i],$0000,backpack);
        BankGold := TransferGold - BackPackGold;
      end;
  end;
  BackPackGold:=0;
  for i:=1 to 3 do  BackPackGold := BackPackGold + CountEx(GoldCoin[i],$0000,backpack);
  Result := BackPackGold >= TransferGold;
end;

Function RuneRename(Id:Cardinal;Text:String):boolean;
var
Time : TDateTime;
 begin
   Time:=Now;
   useobject(Id);
   checklag;
   if IsSystemMsg('What is the new name',Time,Now) then begin ConsoleEntryReply(Text);Result:=true; end
   else Result:=false;   
 end;

Function RuneGetName(Id:Cardinal) : String ;
var
Time : TDateTime;
 begin
  Time:=Now;
  ClickOnObject(Id);
  checklag;
  if (InJournalBetweenTimes('Rune to',Time,Now) > -1) and (LineID=Id)  then Result:=Journal(LineIndex)
  else Result:='false'; 
 end;

Procedure GoMe;
begin
 uosay('; Добрый день, '+NameClient+'! Ваш ID: '+IntToHex(IdClient,8));
 wait(2000);
end;


Procedure GoExit;
begin
 uosay('; Неверная команда');
 wait(1000);
end;

Procedure GoKurs;
begin
 uosay('Курс нашего обменного пункта Офри->Опей на сегодняшний день : '+ Copy(FloatToStr(TradeKurs),0,3));
 wait(2000);
 uosay('За 10000 золотых тут вы получаете : '+ IntToStr(Round(10000*TradeKurs))+' золотых на Опей');
 wait(4000);
end;

Procedure GoHelp;
begin
 uosay('; '+NameClient+'! Вас приветствует обменный пункт золота с шарда Oskom Free на шард Oskom Pay');
 wait(5000);
 uosay(';  Для обмена денег наберите команду "!trade"');
 wait(5000);
 uosay(';  Для завершения операции обмена денег с Опей на Офри наберите "!give"');
 wait(5000);
 uosay(';  Узнать курс обмена Офри->Опей "!kurs"');
 wait(5000);
end;

Procedure Synchronization;
var 
f,Line,Line2 : TStringList;
s : string;
RuneTime : TDateTime;
i,j, NGive : Integer;
begin
  checklag;
  WaitConnectionEx(2000);
  s:=RuneGetName(Runa);
  if s <> 'false' then 
  begin
	  RuneTime:=StrToDateTime(copy(s,24,Length(S)-23));
	  while GetGlobal('stealth','FileAccessFlag') <> '0' do wait(20);
	  SetGlobal('stealth','FileAccessFlag','1');
	  f := TStringList.Create;
	  Line := TStringList.Create;
	  try
		 try
		   f.loadFromFile(fname);
		 except
		   f.SaveToFile(fname);
		 end;
		 if f.Count > 0 then for i := f.Count - 1 downto 0 do
		   begin
			  StrBreakApart(f.Strings[i],'|',Line);
			  if (Line.Strings[0] = intToStr(NumberBot)) and (StrToDateTime(Line.Strings[3]) = RuneTime) then 
				begin
				   Line.clear;
				   Break;
				end;
			  if (Line.Strings[0] = intToStr(NumberBot)) and (Line.Strings[2] <> 'Disc') and (StrToDateTime(Line.Strings[3]) > RuneTime) and (Line.Strings[1] <> '3') then
				begin
				   if (Line.Strings[1] = '2') and (Line.Strings[2] <> 'Err') then 
				   begin 
					 NGive := StrToInt(Line.Strings[2]);
					 Line2 := TStringList.Create;
					 StrBreakApart(f.Strings[NGive],'|',Line2);
					 if Line2.Strings[2] = '1' then
					 begin
					   s:='';
					   Line2.Delete(2);
					   Line2.Insert(2,'0');
					   for j:=0 to Line2.Count - 1 do 
					   begin 
						 s:=s+Line2.Strings[j]; 
						 if (j <> Line2.Count - 1) then s:=s+'|'; 
					   end; 
					   f.Delete(NGive);
					   f.Insert(NGive,s);
					 end;
					 Line2.Free;
				   end;
				   s:='';
				   Line.Delete(2);
				   Line.Insert(2,'Disc');
				   for j:=0 to Line.Count - 1 do begin s:=s+Line.Strings[j]; if j<>Line.Count - 1 then s:=s+'|'; end; 
				   f.Delete(i);
				   f.Insert(i,s);
				end; 
			  Line.Clear;
		   end;
		 f.SaveToFile(fname);
	  finally
		 Line.Free;
		 f.Free;
	  end;
	  SetGlobal('stealth','FileAccessFlag','0');
  end
  else addtosystemjournal('Ошибка синхронизации о1');
end;

Procedure InsertInLog(var i:Integer; s : String);
var
f : TStringList;
begin
 while GetGlobal('stealth','FileAccessFlag') <> '0' do wait(20);
  SetGlobal('stealth','FileAccessFlag','1');
  f := TStringList.Create;
  try
     try
       f.loadFromFile(fname);
     except
       f.SaveToFile(fname);
     end;
	 f.Delete(i);
     f.Insert(i,s);
     f.SaveToFile(fname);
  finally
      f.Free;
  end;
  SetGlobal('stealth','FileAccessFlag','0');
end;

Procedure AddToLog(var s:String);
var
f : TStringList;
begin
 while GetGlobal('stealth','FileAccessFlag') <> '0' do wait(20);
  SetGlobal('stealth','FileAccessFlag','1');
  f := TStringList.Create;
  try
     try
       f.loadFromFile(fname);
     except
       f.SaveToFile(fname);
     end;
     f.Add(s);
     f.SaveToFile(fname);
  finally
      f.Free;
  end;
  SetGlobal('stealth','FileAccessFlag','0');
end;


Procedure GoGive;
var
f,Line : TStringList;
i ,j,k,ChkG: Integer;
TmpGold, GoldInContainer, TransferGold, OpponentContainer, MyContainer : Cardinal;
TimeOperand : TDateTime;
TradeString, InsertString, Ok : String;

begin
  FrazeGoodbye:='; Для вас ничего нет.';
  uosay('; Добрый день, '+NameClient+'!');
  wait(2000);
  checklag;
  WaitConnectionEx(2000);
  if GetGlobal('stealth',IntToStr(IdOtherBot)) <> '1' then
  begin
    uosay('; Извините, сервис временно не доступен.');
	exit;
  end;
  //uosay('; Работаем');
  f := TStringList.Create;
  try
     f.loadFromFile(fname);
  except
     f.SaveToFile(fname);
  end;
  Line := TStringList.Create;
  if f.Count > 0 then for i := 0 to f.Count - 1 do
	   begin
    	  StrBreakApart(f.Strings[i],'|',Line);
		  if (Line.Strings[0] = intToStr(NumberBotOther)) and (Line.Strings[1] = '1') and (Line.Strings[2] = '0') and (Line.Strings[8] = intToStr(IdClient)) then 
		    begin
			   if (StrToDateTime(Line.Strings[3]) + (TimeToSaveSphere/86400) > Now) then
			   begin
				  FrazeGoodbye:='; Вы сможете завершить операцию по прошествии 1 часа.';
				  break;
			   end;
			   //UOSAY('ok');
			   TransferGold:=StrToInt(Line.Strings[4]);
			   if not GetMoneyBank(TransferGold) then
			   begin
			     FrazeGoodbye:='; Нету наличности в банке, или недоступен банк, оповесите сервис центр icq 9745475 .';
				 break;
			   end;
			   if not ((GetDistance(IdClient) < 3) and (GetDistance(IdClient) <> -1) and (GetZ(self) = GetZ(IdClient)) and (not IsDead(IdClient))) then
			     begin
				   FrazeGoodbye:='; Пожалуйста, подойдите ближе.';
				   break;
				 end;
			   if TradeCount() >0 then for j:= TradeCount() - 1 DownTo 0 do CancelTrade(j);
			   checklag;
			   WaitConnectionEx(2000); 
			   for j:=1 to 3 do
			     if (FindTypeEx (GoldCoin[j],$0000,backpack,True) > 0) then begin MoveItem(FindItem,TransferGold,IdClient,0,0,0); break; end;
				
			   FrazeGoodbye:='; Извините, меня ждут другие дела'; 
			   checklag;
			   WaitConnectionEx(2000);
			   repeat
			   if TradeCount()>0 then
				 for k:= TradeCount() - 1 DownTo 0 do
				   begin
					 if (GetTradeOpponent(k) <> IdClient) then CancelTrade(k)
					 else 
					   begin
						  OpponentContainer := GetTradeContainer(k,2);
						  MyContainer :=  GetTradeContainer(k,1);
						  //AddToSystemJournal('Nomer '+inttostr(k)+' count '+inttostr(TradeCount()));
						  GoldInContainer:=0;
						  for j:=1 to 3 do  GoldInContainer := GoldInContainer + CountEx(GoldCoin[j],$0000,MyContainer);
						  TmpGold := TransferGold - GoldInContainer;
						  for j:=1 to 3 do  
							  while (GetDistance(MyContainer) = 0) and (GoldInContainer < TransferGold) and (CountEx(GoldCoin[j],$0000,backpack) > 0) do 
							  begin
								if (FindTypeEx (GoldCoin[j],$0000,Backpack,True) > 0) then MoveItem(FindItem,TmpGold,MyContainer,0,0,0);
								checklag;
								GoldInContainer:=0;
						  		for ChkG:=1 to 3 do  GoldInContainer := GoldInContainer + CountEx(GoldCoin[ChkG],$0000,MyContainer);
								TmpGold := TransferGold - GoldInContainer;
							  end;
						  //uosay(IntToStr(i)+' '+IntToStr(TransferGold));
						  uosay('; Подтвердите передачу.');
							
						  
						  if (FindType($FFFF,OpponentContainer) = 0) and TradeCheck(k,2) and (GoldInContainer = TransferGold) and (GetTradeOpponent(k) = IdClient) then 
						  begin
						    ConfirmTrade(k);
							TimeClient := 0;
							uosay('; Выдано денег : '+IntToStr(TransferGold));
							checklag();
						    Synchronization; // synchronization
							checklag;
							WaitConnectionEx(2000);
							if (Gold = MyGold - TransferGold) Then
						    begin //Ok trading
							  MyGold:=Gold; 
							  Ok:= IntToStr(i);
						    end
						    else // Bad Trading
							  Ok:= 'Err';
						    TimeOperand:=Now;
							checklag;
							WaitConnectionEx(2000);
							while not RuneRename(Runa,DateTimeToStr(TimeOperand)) do begin wait(100); checklag; WaitConnectionEx(2000); end;
							If Ok <> 'Err' then
							 begin 
							    Line.Delete(2);
								Line.Insert(2,'1');
								for j:=0 to Line.Count - 1 do 
								begin 
								  InsertString:=InsertString+Line.Strings[j]; 
								  if (j <> Line.Count - 1) then InsertString:=InsertString+'|'; 
								end; 
								InsertInLog(i,InsertString);
							 end;
						   TradeString:=intToStr(NumberBot)+'|'+'2'+'|'+Ok+'|'+DateTimeToStr(TimeOperand)+'|'+intToStr(TransferGold)+'|'+intToStr(MyGold)+'|'+intToStr(IdClient)+'|'+NameClient+'|'+intToStr(IdClient)+'|';
                            AddToLog(TradeString);
							FrazeGoodbye:=('; Спасибо за использование наших услуг! Ждем вас снова!'); 
						  end;	  
					   end; 
				   end;
				wait(3000);
			   until (TimeClient + (20.0/86400) < Now);   
			   break;
			   
			end;
		  Line.clear;
       end;
  Line.free;
  f.clear;
  f.free;
  uosay(FrazeGoodbye);
  //wait(5000);
  //CheckGive;
end;


Procedure GoTrade;
var
i,j,k: integer;
AllGold,TmpGold,TransferGold, MaxMaxGp: Cardinal;
Flag : Boolean;
UserList : TStringList;
TimeOperand: TDateTime;
TradeString, Ok:String;

OpponentContainer ,TypeItem ,ColorItem : Cardinal;
begin
 FrazeGoodbye:='; Извините, меня ждут другие дела';
 if GetGlobal('stealth',IntToStr(IdOtherBot)) <> '1' then
  begin
    uosay('; Извините, сервис временно не доступен.');
	exit;
  end;
 MaxMaxGp:=Round(StrToInt(GetGlobal('stealth','GoldO2'))*TradeKurs);
 If MaxMaxGp > MaxTradeGp then MaxMaxGp := MaxTradeGp;
 
 uosay('; Добрый день, '+NameClient+'! Здесь вы можете осуществить перевод денег с этого шарда на шард Оском Opay по курсу '+ Copy(FloatToStr(TradeKurs),0,3));
 wait(2000);
 uosay('; Для этого положите на меня сумму в гп от '+IntToStr(Round(MinTradeGp))+' до '+IntToStr(MaxMaxGp)+', я вам пересчитаю по курсу ваши гп на ОPay');
 uosay('; ID Получателя: '+IntToHex(IdGainer,8));
 //wait(4000);
 //uosay('; После чего подтвердите перевод, перейдите на OPay, У MENALO2 командой !give заберите ваши гп');
  repeat
   if TradeCount()>0 then
     for i:= TradeCount() - 1 DownTo 0 do
       begin
         if (GetTradeOpponent(i) <> IdClient) then CancelTrade(i)
         else 
           begin
              OpponentContainer := GetTradeContainer(i,2);
              AddToSystemJournal('Nomer '+inttostr(i)+' count '+inttostr(TradeCount()));
              if (FindType($FFFF,OpponentContainer)>0) then
                begin
                   UserList := TStringList.Create(); 
                   GetFindedList(UserList);
                   Flag := true; 
                        for k := 0 to (UserList.Count-1) do
                          begin
                            //AddToSystemJournal('GOGO');
                            TypeItem := GetType(StrToInt('$'+UserList.strings[k]));
                            ColorItem := GetColor(StrToInt('$'+UserList.strings[k]));
                            //AddToSystemJournal(IntToStr(TypeItem));
                            //AddToSystemJournal(IntToStr(ColorItem));
                            if not ((TypeItem = GoldCoin[1]) or (TypeItem = GoldCoin[2]) or (TypeItem = GoldCoin[3])) and (ColorItem = $0000) then Flag := false;
                          end;
                   UserList.free;
                   TmpGold:= AllGold;
                   AllGold:=0;
                   for j:=1 to 3 do  AllGold := AllGold + CountEx(GoldCoin[j],$0000,OpponentContainer);
                   if (not Flag) then uosay('; Уберите лишние предметы, только золотые монеты')
                   else 
                     begin
                       if TradeCheck(i,2) and (AllGold > MinTradeGp) and (AllGold < MaxMaxGp) then
                         begin
                           ConfirmTrade(i);
                           TmpGold:=AllGold;
                           TransferGold:=Round(AllGold*TradeKurs);
                           uosay('; Получено денег : '+IntToStr(TmpGold));
                           uosay('; Будет выдано денег : '+IntToStr(TransferGold));
						   uosay('; ID Получателя: '+IntToHex(IdGainer,8));
                           checklag();
						   Synchronization; // synchronization
						   checklag;
						   WaitConnectionEx(2000);
						   // Запись в файл
						   if (TmpGold + MyGold = Gold) Then
						   begin //Ok trading
							 MyGold:=Gold; 
							 Ok:= '0';
						   end
						   else // Bad Trading
							 Ok:= 'Err';
						   TimeOperand:=Now;
						   checklag;
						   WaitConnectionEx(2000);
						   while not RuneRename(Runa,DateTimeToStr(TimeOperand)) do begin wait(100); checklag; WaitConnectionEx(2000); end;
						   TradeString:=intToStr(NumberBot)+'|'+'1'+'|'+Ok+'|'+DateTimeToStr(TimeOperand)+'|'+intToStr(TransferGold)+'|'+intToStr(MyGold)+'|'+intToStr(IdClient)+'|'+NameClient+'|'+intToStr(IdGainer)+'|';
                           AddToLog(TradeString);
                           wait(2000);
                           uosay('; Чтобы получить деньги наберите получателем в обменном пункте на шарде OPay команду "!give" ');
                           FrazeGoodbye:=('; Спасибо за использование наших услуг! Ждем вас снова!'); 
                           TimeClient := 0;
                         end
                       else
                         begin
                           if (TmpGold<>AllGold) then uosay(';  Ofree: '+IntToStr(AllGold)+' Opay: '+IntToStr(Round(AllGold*TradeKurs))+' . Подтвердите Перевод');
                           TimeClient:=TimeClient+(2.8/86400);
                         end;
                     end;
                end;
           end; 
       end;
    wait(3000);
  until (TimeClient + (30.0/86400) < Now);
  uosay(FrazeGoodbye);
  checklag;
  WaitConnectionEx(2000);
  PutMoneyBank;
  for i:= TradeCount() - 1 DownTo 0 do CancelTrade(i);
end;


Function CheckIdInString(s : String; Pos : Integer) : Integer;
var
i,j : Integer;
a : array of char; 
Flag : Boolean;
begin
  if not (Length(s) = Pos+15) then begin result := 0; exit; end;
  s:=Lowercase(s);
  a:=['0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f'];
  for i:=Pos+8 to Pos+15 do
  begin
    Flag := false;
    for j:=0 to 15 do if (s[i] = a[j]) then Flag := true;
	if not Flag then begin result := 0; exit; end;
  end;
  result := StrToInt(Copy(s,Pos+7,9));
end;

Procedure ChooseCommand;
begin
   //addtosystemjournal(inttostr(BMSearch(0,Journal(LineIndex),'!trade')));
   //addtosystemjournal(Journal(LineIndex)[1]);
   //addtosystemjournal(Journal(LineIndex)[2]);
   if (BMSearch(0,Journal(LineIndex),'!trade $')>0) then
     begin
	   IdGainer:= CheckIdInString(Journal(LineIndex),BMSearch(0,Journal(LineIndex),'!trade $'));
	   if IdGainer > 0 then GoTrade else GoExit;
	 end
   else if BMSearch(0,Journal(LineIndex),'!give')>0 then GoGive
   else if BMSearch(0,Journal(LineIndex),'!kurs')>0 then GoKurs
   else if BMSearch(0,Journal(LineIndex),'!help')>0 then GoHelp
   else if BMSearch(0,Journal(LineIndex),'!me')>0 then GoMe
   else GoExit;
end;




begin
   GoldCoin[1] := $0EED;
   GoldCoin[2] := $0EEE;
   GoldCoin[3] := $0EEF;
   SetARStatus(true);
   WaitConnectionEx(2000);
   MyGold := Gold;
   

   InfoTimer := setTimer(TimeToInfoMsg);
   SynchroTimer := setTimer(TimeToSynhro); // 300k - 5 min
   SetGlobal('stealth','FileAccessFlag','0');
   SetGlobal('stealth',IntToStr(self),'1');
  repeat
   starttime := Now;
   repeat
      //checklag;
	  WaitConnectionEx(2000);
      //addtosystemjournal(inttostr(TradeCount()));
      if TradeCount() >0 then
        for i:= 0 To TradeCount()-1 do CancelTrade(i); 
      //if  (MsgTimeOut + (40.0/86400) < Now) then 
	  if isTimer(InfoTimer) then
        begin
          resetTimer(InfoTimer);
          uosay('Работает обменный пункт, подробности команда "!hеlp"      http://admir.info');
        end; 
	  if isTimer(SynchroTimer) then
        begin
          resetTimer(SynchroTimer);
          Synchronization;
		  CheckGold;
        end; 
   until (InJournalBetweenTimes('!trade|!give|!help|!kurs|!me', starttime, Now)<>-1);
   if (LineName <> 'System') and (GetDistance(LineID) < 3) and (GetDistance(LineID) <> -1) and (GetZ(self) = GetZ(LineID)) and (not IsDead(LineID)) then
     begin
       IdClient := LineID;
       NameClient := LineName;
       TimeClient :=  LineTime;
       ChooseCommand;
     end;
  until (InJournalBetweenTimes('!stop', starttime, Now)<>-1); 

    
    
end.       


Trader2

Code: Select all

Program New;
//lA2
{$Include 'all.inc'}

const
fname='C:\games\uo\stealth_v1.0 (rc 3)\Stealth_v1.0 (RC 3)\temp.log';
NumberBot=2;
NumberBotOther=1;

IdOtherBot=$000CB284;
IdSelf=$000194F6;
Runa=$40111E9B;

TimeToSaveSphere=36.0;
TimeToInfoMsg=600000; // 1000 = 1 sec
TimeToSynhro=20000;

TradeKurs=1.0;
MaxTradeGp=10000;
MinTradeGp=10;



var
IdClient, MyGold : Cardinal;
NameClient : String;
starttime, TimeClient : TDateTime;
GoldCoin : array[1..3] of Cardinal;
i :Integer;
FrazeGoodbye : String;
InfoTimer ,SynchroTimer : TTimer;

Procedure CheckGold;
begin
  SetGlobal('stealth','GoldO2',IntToStr(Gold));
end;


procedure WaitConnectionEx(WaitTime : Integer);
begin
if Connected then Exit;
while not Connected do begin SetGlobal('stealth',IntToStr(IdSelf),'0'); Wait(1000); end;
{WaitTime - Waiting After Connected}
wait(WaitTime);
SetGlobal('stealth',IntToStr(self),'1');
end;

Procedure PutMoneyBank;
var
j:Integer;
Bank: Cardinal;
begin
  uosay('bank');
  checklag;
  Bank:=ObjAtLayer(BankLayer);
  if Bank <> 0 then
  begin
    for j:=1 to 3 do  
      while CountEx(GoldCoin[j],$0000,backpack) > 0 do 
      begin
        if (FindTypeEx (GoldCoin[j],$0000,Backpack,True) > 0) then MoveItem(FindItem,0,Bank,0,0,0);
        checklag;
      end;
  end;
end;


Function GetMoneyBank(TransferGold : Cardinal) : Boolean;
var j,i : Integer;
BackPackGold ,BankGold, Bank: Cardinal;
t: TDateTime;
begin
  if TransferGold > Gold then begin Result:=false; exit; end;
  
  BackPackGold := 0;
  BankGold := 0;
  
  for j:=1 to 3 do  BackPackGold := BackPackGold + CountEx(GoldCoin[j],$0000,backpack);
  
  if BackPackGold >= TransferGold then begin Result:=true; exit; end;
  
  uosay('bank');
  checklag;
  Bank:=ObjAtLayer(BankLayer);
  if Bank = 0 then begin Result:=false; exit; end; 
  t := Now;
  while BackPackGold < TransferGold do
  begin
    BankGold := TransferGold - BackPackGold;
    for j:=1 to 3 do   
      if (FindTypeEx (GoldCoin[j],$0000,Bank,True) > 0) then 
      begin
        MoveItem(FindItem,BankGold,backpack,0,0,0);
        checklag;
        BackPackGold:=0;
        for i:=1 to 3 do  BackPackGold := BackPackGold + CountEx(GoldCoin[i],$0000,backpack);
        BankGold := TransferGold - BackPackGold;
      end;
  end;
  BackPackGold:=0;
  for i:=1 to 3 do  BackPackGold := BackPackGold + CountEx(GoldCoin[i],$0000,backpack);
  Result := BackPackGold >= TransferGold;
end;

Function RuneRename(Id:Cardinal;Text:String):boolean;
var
Time : TDateTime;
 begin
   Time:=Now;
   useobject(Id);
   checklag;
   if IsSystemMsg('What is the new name',Time,Now) then begin ConsoleEntryReply(Text);Result:=true; end
   else Result:=false;   
 end;

Function RuneGetName(Id:Cardinal) : String ;
var
Time : TDateTime;
 begin
  Time:=Now;
  ClickOnObject(Id);
  checklag;
  if (InJournalBetweenTimes('Rune to',Time,Now) > -1) and (LineID=Id)  then Result:=Journal(LineIndex)
  else Result:='false'; 
 end;

Procedure GoMe;
begin
 uosay('; Добрый день, '+NameClient+'! Ваш ID: '+IntToHex(IdClient,8));
 wait(2000);
end;


Procedure GoExit;
begin
 uosay('goexit');
end;

Procedure GoKurs;
begin
 uosay('Курс нашего обменного пункта Опей->Офри на сегодняшний день : '+ Copy(FloatToStr(TradeKurs),0,3));
 wait(2000);
 uosay('За 10000 золотых тут вы получаете : '+ IntToStr(Round(10000*TradeKurs))+' золотых на Офри');
 wait(4000);
end;

Procedure GoHelp;
begin
 uosay('; '+NameClient+'! Вас приветствует обменный пункт золота с шарда Oskom Opay на шард Oskom Free');
 wait(5000);
 uosay(';  Для обмена денег наберите команду "!trade"');
 wait(5000);
 uosay(';  Для завершения операции обмена денег с Офри на Опей наберите "!give"');
 wait(5000);
 uosay(';  Узнать курс обмена Опей->Офри "!kurs"');
 wait(5000);
end;

Procedure Synchronization;
var 
f,Line,Line2 : TStringList;
s : string;
RuneTime : TDateTime;
i,j, NGive : Integer;
begin
  checklag;
  WaitConnectionEx(2000);
  s:=RuneGetName(Runa);
  if s <> 'false' then 
  begin
      RuneTime:=StrToDateTime(copy(s,24,Length(S)-23));
      while GetGlobal('stealth','FileAccessFlag') <> '0' do wait(20);
      SetGlobal('stealth','FileAccessFlag','1');
      f := TStringList.Create;
      Line := TStringList.Create;
      try
         try
           f.loadFromFile(fname);
         except
           f.SaveToFile(fname);
         end;
         if f.Count > 0 then for i := f.Count - 1 downto 0 do
           begin
              StrBreakApart(f.Strings[i],'|',Line);
              if (Line.Strings[0] = intToStr(NumberBot)) and (StrToDateTime(Line.Strings[3]) = RuneTime) then 
                begin
                   Line.clear;
                   Break;
                end;
              if (Line.Strings[0] = intToStr(NumberBot)) and (Line.Strings[2] <> 'Disc') and (StrToDateTime(Line.Strings[3]) > RuneTime) and (Line.Strings[1] <> '3') then
                begin
                   if (Line.Strings[1] = '2') and (Line.Strings[2] <> 'Err') then 
                   begin 
                     NGive := StrToInt(Line.Strings[2]);
                     Line2 := TStringList.Create;
                     StrBreakApart(f.Strings[NGive],'|',Line2);
                     if Line2.Strings[2] = '1' then
                     begin
                       s:='';
                       Line2.Delete(2);
                       Line2.Insert(2,'0');
                       for j:=0 to Line2.Count - 1 do 
                       begin 
                         s:=s+Line2.Strings[j]; 
                         if (j <> Line2.Count - 1) then s:=s+'|'; 
                       end; 
                       f.Delete(NGive);
                       f.Insert(NGive,s);
                     end;
                     Line2.Free;
                   end;
                   s:='';
                   Line.Delete(2);
                   Line.Insert(2,'Disc');
                   for j:=0 to Line.Count - 1 do begin s:=s+Line.Strings[j]; if j<>Line.Count - 1 then s:=s+'|'; end; 
                   f.Delete(i);
                   f.Insert(i,s);
                end; 
              Line.Clear;
           end;
         f.SaveToFile(fname);
      finally
         Line.Free;
         f.Free;
      end;
      SetGlobal('stealth','FileAccessFlag','0');
  end
  else addtosystemjournal('Ошибка синхронизации о2');
end;

Procedure InsertInLog(var i:Integer; s : String);
var
f : TStringList;
begin
 while GetGlobal('stealth','FileAccessFlag') <> '0' do wait(20);
  SetGlobal('stealth','FileAccessFlag','1');
  f := TStringList.Create;
  try
     try
       f.loadFromFile(fname);
     except
       f.SaveToFile(fname);
     end;
     f.Delete(i);
     f.Insert(i,s);
     f.SaveToFile(fname);
  finally
      f.Free;
  end;
  SetGlobal('stealth','FileAccessFlag','0');
end;

Procedure AddToLog(var s:String);
var
f : TStringList;
begin
 while GetGlobal('stealth','FileAccessFlag') <> '0' do wait(20);
  SetGlobal('stealth','FileAccessFlag','1');
  f := TStringList.Create;
  try
     try
       f.loadFromFile(fname);
     except
       f.SaveToFile(fname);
     end;
     f.Add(s);
     addtosystemjournal('addtolog');
     f.SaveToFile(fname);
  finally
      f.Free;
  end;
  SetGlobal('stealth','FileAccessFlag','0');
end;


Procedure GoGive;
var
f,Line : TStringList;
i ,j,k,ChkG: Integer;
TmpGold, GoldInContainer, TransferGold, OpponentContainer, MyContainer : Cardinal;
TimeOperand : TDateTime;
TradeString, InsertString, Ok : String;

begin
  FrazeGoodbye:='; Для вас ничего нет.';
  uosay('; Добрый день, '+NameClient+'!');
  wait(2000);
  checklag;
  WaitConnectionEx(2000);
  //addtosystemjournal(GetGlobal('stealth',IntToStr(IdOtherBot)))
  if GetGlobal('stealth',IntToStr(IdOtherBot)) <> '1' then
  begin
    uosay('; Извините, сервис временно не доступен.');
    exit;
  end;
  //uosay('; Работаем');
  f := TStringList.Create;
  try
     f.loadFromFile(fname);
  except
     f.SaveToFile(fname);
  end;
  Line := TStringList.Create;
  if f.Count > 0 then for i := 0 to f.Count - 1 do
       begin
          StrBreakApart(f.Strings[i],'|',Line);
          if (Line.Strings[0] = intToStr(NumberBotOther)) and (Line.Strings[1] = '1') and (Line.Strings[2] = '0') and (Line.Strings[6] = intToStr(IdClient)) then 
            begin
               if (StrToDateTime(Line.Strings[3]) + (TimeToSaveSphere/86400) > Now) then
               begin
                  FrazeGoodbye:='; Вы сможете завершить операцию по прошествии 1 часа.';
                  break;
               end;
               //UOSAY('ok');
               TransferGold:=StrToInt(Line.Strings[4]);
               if not GetMoneyBank(TransferGold) then
               begin
                 FrazeGoodbye:='; Нету наличности в банке, или недоступен банк, оповесите сервис центр icq 9745475 .';
                 break;
               end;
               if not ((GetDistance(IdClient) < 3) and (GetDistance(IdClient) <> -1) and (GetZ(self) = GetZ(IdClient)) and (not IsDead(IdClient))) then
                 begin
                   FrazeGoodbye:='; Пожалуйста, подойдите ближе.';
                   break;
                 end;
                
               if TradeCount() >0 then for j:= TradeCount() - 1 DownTo 0 do CancelTrade(j); 
               checklag;
               WaitConnectionEx(2000);
               for j:=1 to 3 do
                 if (FindTypeEx (GoldCoin[j],$0000,backpack,True) > 0) then begin MoveItem(FindItem,TransferGold,IdClient,0,0,0); break; end;
                
               FrazeGoodbye:='; Извините, меня ждут другие дела'; 
               checklag;
               WaitConnectionEx(2000);
               repeat
               if TradeCount()>0 then
                 for k:= TradeCount() - 1 DownTo 0 do
                   begin
                     if (GetTradeOpponent(k) <> IdClient) then CancelTrade(k)
                     else 
                       begin
                          OpponentContainer := GetTradeContainer(k,2);
                          MyContainer :=  GetTradeContainer(k,1);
                          //AddToSystemJournal('Nomer '+inttostr(k)+' count '+inttostr(TradeCount()));
                          GoldInContainer:=0;
                          for j:=1 to 3 do  GoldInContainer := GoldInContainer + CountEx(GoldCoin[j],$0000,MyContainer);
                          TmpGold := TransferGold - GoldInContainer;
                          for j:=1 to 3 do  
                              while (GetDistance(MyContainer) = 0) and (GoldInContainer < TransferGold) and (CountEx(GoldCoin[j],$0000,backpack) > 0) do 
                              begin
                                if (FindTypeEx (GoldCoin[j],$0000,Backpack,True) > 0) then MoveItem(FindItem,TmpGold,MyContainer,0,0,0);
                                checklag;
                                GoldInContainer:=0;
                                  for ChkG:=1 to 3 do  GoldInContainer := GoldInContainer + CountEx(GoldCoin[ChkG],$0000,MyContainer);
                                TmpGold := TransferGold - GoldInContainer;
                              end;
                            
                          uosay('; Подтвердите передачу.');
                            
                          
                          if (FindType($FFFF,OpponentContainer) = 0) and TradeCheck(k,2) and (GoldInContainer = TransferGold) and (GetTradeOpponent(k) = IdClient) then 
                          begin
                            ConfirmTrade(k);
                            TimeClient := 0;
                            uosay('; Выдано денег : '+IntToStr(TransferGold));
                            checklag();
                            Synchronization; // synchronization
                            checklag;
                            WaitConnectionEx(2000);
                            if (Gold = MyGold - TransferGold) Then
                            begin //Ok trading
                              MyGold:=Gold; 
                              Ok:= IntToStr(i);
                            end
                            else // Bad Trading
                              Ok:= 'Err';
                            TimeOperand:=Now;
                            checklag;
                            WaitConnectionEx(2000);
                            while not RuneRename(Runa,DateTimeToStr(TimeOperand)) do begin wait(100); checklag; WaitConnectionEx(2000); end;
                            //if not RuneRename(Runa,DateTimeToStr(TimeOperand)) then Ok:='Err';
                            If Ok <> 'Err' then
                             begin 
                                Line.Delete(2);
                                Line.Insert(2,'1');
                                for j:=0 to Line.Count - 1 do 
                                begin 
                                  InsertString:=InsertString+Line.Strings[j]; 
                                  if (j <> Line.Count - 1) then InsertString:=InsertString+'|'; 
                                end; 
                                InsertInLog(i,InsertString);
                             end;
                           TradeString:=intToStr(NumberBot)+'|'+'2'+'|'+Ok+'|'+DateTimeToStr(TimeOperand)+'|'+intToStr(TransferGold)+'|'+intToStr(MyGold)+'|'+intToStr(IdClient)+'|'+NameClient+'|';
                            AddToLog(TradeString);
                            FrazeGoodbye:=('; Спасибо за использование наших услуг! Ждем вас снова!'); 
                          end;      
                       end; 
                   end;
                wait(3000);
               until (TimeClient + (20.0/86400) < Now);   
               break;
               
            end;
          Line.clear;
       end;
  Line.free;
  f.clear;
  f.free;
  uosay(FrazeGoodbye);
  //wait(5000);
  //CheckGive;
end;


Procedure GoTrade;
var
i,j,k: integer;
AllGold,TmpGold,TransferGold, MaxMaxGp: Cardinal;
Flag : Boolean;
UserList : TStringList;
TimeOperand: TDateTime;
TradeString, Ok:String;

OpponentContainer ,TypeItem ,ColorItem : Cardinal;
begin
 if GetGlobal('stealth',IntToStr(IdOtherBot)) <> '1' then
  begin
    uosay('; Извините, сервис временно не доступен.');
    exit;
  end;
 MaxMaxGp:=Round(StrToInt(GetGlobal('stealth','GoldO1'))*TradeKurs);
 If MaxMaxGp > MaxTradeGp then MaxMaxGp := MaxTradeGp;
 FrazeGoodbye:='; Извините, меня ждут другие дела';
 uosay('; Добрый день, '+NameClient+'! Здесь вы можете осуществить перевод денег с этого шарда на шард Оском Free по курсу '+ Copy(FloatToStr(TradeKurs),0,3));
 wait(2000);
 uosay('; Для этого положите на меня сумму в гп от '+IntToStr(Round(MinTradeGp))+' до '+IntToStr(MaxMaxGp)+', я вам пересчитаю по курсу ваши гп на ОFree');
 //wait(4000);
 //uosay('; После чего подтвердите перевод, перейдите на OFree, У MENALO2 командой !give заберите ваши гп');
 checklag;
 WaitConnectionEx(2000);
  repeat
   if TradeCount()>0 then
     for i:= TradeCount() - 1 DownTo 0 do
       begin
         if (GetTradeOpponent(i) <> IdClient) then CancelTrade(i)
         else 
           begin
              OpponentContainer := GetTradeContainer(i,2);
              AddToSystemJournal('Nomer '+inttostr(i)+' count '+inttostr(TradeCount()));
              if (FindType($FFFF,OpponentContainer)>0) then
                begin
                   UserList := TStringList.Create(); 
                   GetFindedList(UserList);
                   Flag := true; 
                        for k := 0 to (UserList.Count-1) do
                          begin
                            //AddToSystemJournal('GOGO');
                            TypeItem := GetType(StrToInt('$'+UserList.strings[k]));
                            ColorItem := GetColor(StrToInt('$'+UserList.strings[k]));
                            //AddToSystemJournal(IntToStr(TypeItem));
                            //AddToSystemJournal(IntToStr(ColorItem));
                            if not ((TypeItem = GoldCoin[1]) or (TypeItem = GoldCoin[2]) or (TypeItem = GoldCoin[3])) and (ColorItem = $0000) then Flag := false;
                          end;
                   UserList.free;
                   TmpGold:= AllGold;
                   AllGold:=0;
                   for j:=1 to 3 do  AllGold := AllGold + CountEx(GoldCoin[j],$0000,OpponentContainer);
                   if (not Flag) then uosay('; Уберите лишние предметы, только золотые монеты')
                   else 
                     begin
                       if TradeCheck(i,2) and (AllGold > MinTradeGp) and (AllGold < MaxMaxGp) then 
                         begin
                           ConfirmTrade(i);
                           TmpGold:=AllGold;
                           TransferGold:=Round(AllGold*TradeKurs);
                           uosay('; Получено денег : '+IntToStr(TmpGold));
                           uosay('; Будет выдано денег : '+IntToStr(TransferGold));
                           checklag();
                           Synchronization; // synchronization
                           checklag;
                           WaitConnectionEx(2000);
                           // Запись в файл
                           if (TmpGold + MyGold = Gold) Then
                           begin //Ok trading
                             MyGold:=Gold; 
                             Ok:= '0';
                           end
                           else // Bad Trading
                             Ok:= 'Err';
                           TimeOperand:=Now;
                           checklag;
                           WaitConnectionEx(2000);
                           while not RuneRename(Runa,DateTimeToStr(TimeOperand)) do begin wait(100); checklag; WaitConnectionEx(2000); end;
                           TradeString:=intToStr(NumberBot)+'|'+'1'+'|'+Ok+'|'+DateTimeToStr(TimeOperand)+'|'+intToStr(TransferGold)+'|'+intToStr(MyGold)+'|'+intToStr(IdClient)+'|'+NameClient+'|';
                           AddToLog(TradeString);
                           wait(2000);
                           uosay('; Чтобы получить деньги наберите в обменном пункте на шарде OFree команду "!give" этим же чаром');
                           FrazeGoodbye:=('; Спасибо за использование наших услуг! Ждем вас снова!'); 
                           TimeClient := 0;
                         end
                       else
                         begin
                           if (TmpGold<>AllGold) then uosay(';  Opay: '+IntToStr(AllGold)+' free: '+IntToStr(Round(AllGold*TradeKurs))+' . Подтвердите Перевод');
                           TimeClient:=TimeClient+(2.8/86400);
                         end;
                     end;
                end;
           end; 
       end;
    wait(3000);
  until (TimeClient + (30.0/86400) < Now);
  uosay(FrazeGoodbye);
  checklag;
  WaitConnectionEx(2000);
  PutMoneyBank;
  for i:= TradeCount() - 1 DownTo 0 do CancelTrade(i);
end;



Procedure ChooseCommand;
begin
   if BMSearch(0,Journal(LineIndex),'!trade')>0 then GoTrade
   else if BMSearch(0,Journal(LineIndex),'!give')>0 then GoGive
   else if BMSearch(0,Journal(LineIndex),'!kurs')>0 then GoKurs
   else if BMSearch(0,Journal(LineIndex),'!help')>0 then GoHelp
   else if BMSearch(0,Journal(LineIndex),'!me')>0 then GoMe
   else GoExit;
end;




begin
   GoldCoin[1] := $0EED;
   GoldCoin[2] := $0EEE;
   GoldCoin[3] := $0EEF;
   MyGold := Gold;
   SetARStatus(true);

   InfoTimer := setTimer(TimeToInfoMsg);
   SynchroTimer := setTimer(TimeToSynhro); // 300k - 5 min
   SetGlobal('stealth','FileAccessFlag','0');
   SetGlobal('stealth',IntToStr(self),'1');
  repeat
   starttime := Now;
   repeat
      //checklag;
      WaitConnectionEx(2000);
      //addtosystemjournal(inttostr(TradeCount()));
      if TradeCount() >0 then
        for i:= 0 To TradeCount()-1 do CancelTrade(i); 
      //if  (MsgTimeOut + (40.0/86400) < Now) then 
      if isTimer(InfoTimer) then
        begin
          resetTimer(InfoTimer);
          uosay('Работает обменный пункт, подробности команда "!hеlp"      http://admir.info');
        end; 
      if isTimer(SynchroTimer) then
        begin
          resetTimer(SynchroTimer);
          Synchronization;
          CheckGold;
        end; 
   until (InJournalBetweenTimes('!trade|!give|!help|!kurs|!me', starttime, Now)<>-1);
   if (LineName <> 'System') and (GetDistance(LineID) < 3) and (GetDistance(LineID) <> -1) and (GetZ(self) = GetZ(LineID)) and (not IsDead(LineID)) then
     begin
       IdClient := LineID;
       NameClient := LineName;
       TimeClient :=  LineTime;
       ChooseCommand;
     end;
  until (InJournalBetweenTimes('!stop', starttime, Now)<>-1); 
    //addtosystemjournal(inttostr(GetTradeOpponent(0)));
    //addtosystemjournal(inttostr(TradeCount()));
    //addtosystemjournal(GetTradeOpponentName(0));
    //addtosystemjournal(inttostr(GetTradeContainer(0,1))); // 1- я 2 - оппонент
    //ConfirmTrade(0);
    //CancelTrade(0);
    //if TradeCheck(0,2) then  addtosystemjournal('ok1');  // 2 - оппонент   1- себя
    //uosay('!asd');
    
    
end.                        
grundick
Developer
Developer
Posts: 272
Joined: 31.01.2008 21:16

Post by grundick »

Думаю, уже не актуально :)
Этот уродец чукотский разогнал последних игроков...
Antoska
Neophyte
Neophyte
Posts: 45
Joined: 10.07.2009 22:21
Location: Латвия, Рига

Post by Antoska »

Солидно!)
Post Reply