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

Includes

Only working scripts
Miralex
Developer
Developer
Posts: 656
Joined: 11.03.2005 19:12
Contact:

Includes

Post by Miralex »

Думаю стоит стандартизировать общие "include", поэтому выкладываю первый вариант:

checksave.inc

Code: Select all

procedure CheckSave; 
var Time : TDateTime; 
begin 
Time:= Now - (0.5 / 1440); 
if InJournalBetweenTimes('Saving World State',Time,Now) >= 0 then Wait(30000) 
end;

checktargeterror.inc

Code: Select all

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;

hungry.inc

Code: Select all

procedure Hungry(NeededLevel : Integer; Container : Cardinal);
var HArray : array [0..10] of String;
    CurrentLevel : Integer;
    HasError : Boolean;
    TimeSayHungry : TDateTime;
    FoodID : Cardinal;
    i,c,difference : Integer;
begin
if Not Connected then Exit;
if (NeededLevel < 0) or (NeededLevel > 10) then Exit;
   HArray[0] := 'You are absolutely stuffed!';
   HArray[1] := 'You are stuffed';
   HArray[2] := 'hungry at all';
   HArray[3] := 'You are a little hungry';
   HArray[4] := 'You are somewhat hungry';
   HArray[5] := 'You are REALLY hungry';
   HArray[6] := 'Your stomash hurts';
   HArray[7] := 'Your stomash hurts and you feel dizzy';
   HArray[8] := 'You are starving';
   HArray[9] := 'You are almost dying of hunger';
   HArray[10] := 'You are DYING of hunger...';
HasError := true;
TimeSayHungry := Now;
UOSay('.hungry');
wait(100);
i:=0;
while i < 100 do
   begin
   for c := 0 to 10 do
   if InJournalBetweenTimes(HArray[c],TimeSayHungry,Now) >= 0 then
	begin
	CurrentLevel := c;
	HasError := false;
	i := 100;
	end;
   wait(100);
   i := i + 1;
   end;
if HasError then
   begin
   AddToSystemJournal('Error with Hungry: Lag? Conection error? Something else?');
   Exit;
   end;
difference := CurrentLevel - NeededLevel;
FindType($097B,Container);
if (difference > 0) and (FindCount > 0) then for i := 1 to difference do
   begin
   FoodID := FindType($097B,Container);
   if FoodID <> $00 then UseObject(FoodID);
   wait(200);
   end;
if FindType($097B,Container) = 0 then AddToSystemJournal('No Food');
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;

stack.inc

Code: Select all

procedure stack(ObjType, Color : word); 
var PackItem, GroundItem : Cardinal; 
begin 
   PackItem := 0; 
   GroundItem := 0; 
   Findtype(ObjType,backpack);                    
   IF FindFullQuantity > 0 then PackItem := finditem; 
   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;

all.inc

Code: Select all

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

Код будет дополняться и изменяться. Следите за изменениями :!:
Acronym
Novice
Novice
Posts: 114
Joined: 10.05.2005 18:42
Location: Odessa, NDW
Contact:

Post by Acronym »

Если добавить в инклюд хангри после строки:
FindType($097B,Container);
строку:

Code: Select all

AddToSystemJournal('Найдено еды: '+IntToStr(FindFullQuantity));
то получим: вывод в системном журнале информации о количестве еды и сможем отслеживать её окончание.
Last edited by Acronym on 18.02.2008 12:57, edited 1 time in total.
Alex
Moderator
Moderator
Posts: 351
Joined: 07.04.2005 4:41

Post by Alex »

Hungry.inc вида hungry(1);

Code: Select all

procedure Hungry(NeededLevel : Integer);
var HArray : array [0..10] of String;
    CurrentLevel,stopflag : Integer;
    Container : Cardinal;
    HasError : Boolean;
    TimeSayHungry : TDateTime;
    FoodID : Cardinal;
    i,c,difference : Integer;
begin
if Not Connected then Exit;
if (NeededLevel < 0) or (NeededLevel > 10) then Exit;
   HArray[0] := 'You are absolutely stuffed!';
   HArray[1] := 'You are stuffed';
   HArray[2] := 'hungry at all';
   HArray[3] := 'You are a little hungry';
   HArray[4] := 'You are somewhat hungry';
   HArray[5] := 'You are REALLY hungry';
   HArray[6] := 'Your stomash hurts';
   HArray[7] := 'Your stomash hurts and you feel dizzy';
   HArray[8] := 'You are starving';
   HArray[9] := 'You are almost dying of hunger';
   HArray[10] := 'You are DYING of hunger...';
stopflag:=0;
HasError := true;
TimeSayHungry := Now;
UOSay('.hungry');
wait(100);
i:=0;
while i < 100 do
   begin
   for c := 0 to 10 do
   if InJournalBetweenTimes(HArray[c],TimeSayHungry,Now) >= 0 then
	begin
	currentLevel := c;
	hasError := false;
	i:= 100;
	end;
   wait(100);
   i := i + 1;
   end;

if HasError then
   begin
   AddToSystemJournal('Error with Hungry: Lag? Conection error? Something else?');
   Exit;
   end;

difference := CurrentLevel - NeededLevel;

container:=ground;

findtype($097B,ground);
if (findfullquantity > 0) then container:=ground
else stopflag:=stopflag+1;

findtype($097B,backpack);
if (findfullquantity > 0) then container:=backpack
else stopflag:=stopflag+1;


FindType($097B,Container);
if (difference > 0) and (FindCount > 0) then for i := 1 to difference do
   begin
   FoodID := FindType($097B,Container);
   if FoodID <> $00 then UseObject(FoodID);
   wait(200);
   end;

if stopflag = 2 then begin
 for i:= 1 to 5 do begin
  UOSay('Закончилась еда!');
  Wait(48000);
  if (countground($097B) > 0) or (count($097B) > 0) then exit;
 end;  
SetARStatus(false);
Disconnect;
end;

end;
Alex
Moderator
Moderator
Posts: 351
Joined: 07.04.2005 4:41

Post by Alex »

Stack вида 60000

Code: Select all

procedure stack(ObjType, Color : word); 
var PackItem, GroundItem : Cardinal; 
    PackQuantity,LessQuantity : integer;
begin 
   PackItem := 0; 
   GroundItem := 0; 
   Findtype(ObjType,backpack);                    
   IF FindFullQuantity > 0 then 
    begin
     PackItem := finditem; 
     PackQuantity := findquantity;
    end
   else exit;
  Findtype(ObjType,ground);                    
   IF FindFullQuantity > 0 then IgnoreReset; 
   repeat
      FindtypeEx(ObjType,Color,ground,false); 
      IF FindCount > 0 then begin 
       if FindQuantity = 60000 then Ignore(finditem) 
       else begin
	LessQuantity:=(Findquantity+PackQuantity)-60000;
	if lessquantity > 0 then Drop(Packitem,lessquantity,getx(self),gety(self),getz(self));
        GroundItem := finditem; 
	end;
      FindtypeEx(ObjType,Color,ground,false); 
      end;
   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); 
   IgnoreReset; 
end;
Edred
Moderator
Moderator
Posts: 559
Joined: 28.03.2006 21:29

Post by Edred »

Все-таки одну функцию из инжекта я портировал. Очень был удивлен, что никто этого еще не сделал (по крайней мере, не запостил). Или вы все без лагов играете? :shock:

Code: Select all

procedure CheckLag;
var starttime : TDateTime;
begin
	starttime := Now;
	ClickOnObject(backpack);
	repeat
		wait(50);
	until (InJournalBetweenTimes('backpack', starttime, Now)<>-1);
end;
я ее в include засунул для себя лично.
CFA
Developer
Developer
Posts: 492
Joined: 20.04.2006 6:03
Contact:

Post by CFA »

таймеры

Code: Select all

type
	TTimer = record
		timer : TDateTime;
		expireTime : TDateTime;
	end;

function setTimer(expireTime : cardinal) : TTimer;
begin
	result.expireTime := double(expireTime) / 86400000;
	result.timer := now + result.expireTime;
end;

procedure resetTimer(var timer : TTimer);
begin
	timer.timer := now + timer.expireTime;
end;

function isTimerExpire(timer : TTimer) : boolean;
begin
	result := now > timer.timer;
end;
expireTime задаеться в миллисекундах.
пример использования

Code: Select all

{$Include 'timer.inc'}

const 
	horse	= $00000000;
	bandage	= $0E21;
	
var healTimer, anatomyTimer : TTimer;

begin
	setWarMode(true);
	attack(horse);
	wait(1000);
	setWarMode(false);
	
	healTimer := setTimer(4500);
	anatomyTimer := setTimer(11000);
	
	repeat
		if (isTimerExpire(healTimer)) then
		begin
			if (targetPresent) then cancelTarget();
			useFromGround(bandage, 0);
			waitForTarget(1500);
			if (targetPresent) then waitTargetSelf();
			resetTimer(healTimer);
		end;

		if (isTimerExpire(healTimer)) then
		begin
			if (targetPresent) then cancelTarget();
			useSkill('Anatomy');
			waitForTarget(1500);
			if (targetPresent) then waitTargetObject(horse);
			resetTimer(anatomyTimer);
		end;
		
	until false;
end.
CFA
Developer
Developer
Posts: 492
Joined: 20.04.2006 6:03
Contact:

Post by CFA »

ведение журнала приростов скиллов.

Code: Select all


////////////////////////////////////////////////////////////////////////////////
type
	TSkill = record
		skillName	: string;
		lastValue	: double;
		lastTime	: TDateTime;
	end;

	TLoggerProc	= procedure(logString : string);


function makeSkill(skillName : string) : TSkill;
begin
	result.skillName := skillName;
	result.lastValue := getSkillValue(skillName);
	result.lastTime := now;
end;
////////////////////////////////////////////////////////////////////////////////

procedure fileLogger(logString : string);
var
	ls : TStringList;
	fname : string;
begin
	fname := 'skills-0x' + intToHex(self, 8) + '.txt';

	ls := TSTringList.Create();
	try
		ls.loadFromFile(fname);
	except
		//создаем файл, если нету
		ls.saveToFile(fname);
	end;

	ls.add(logString);

	ls.saveToFile(fname)
	ls.free();
end;


procedure journalLogger(logString : string);
begin
	addToSystemJournal(logString);
end;


////////////////////////////////////////////////////////////////////////////////
function formatSkillChange_1(skillName : string; prevSkill, nowSkill: double; prevTime, nowTime : TDateTime) : string;
var
	h, m, s, ms : word;
	timestr : string;
begin
	DecodeTime(nowTime-prevTime, h, m, s, ms);
	timestr := padz(intToStr(h), 2) + 'h:' + padz(intToStr(m), 2) + 'm:' + padz(intToStr(s), 2) + 's';

	result :=
		skillName + ' ' +
		floatToStr(nowSkill) +
		' (' + floatToStr(round((nowSkill-prevSkill)*1000)/1000) + '), ' + timestr;

end;


function formatSkillChange_2(skillName : string; prevSkill, nowSkill: double; prevTime, nowTime : TDateTime) : string;
begin

	result := skillName + #9 + intToStr(round((nowTime-prevTime)*86400)) + #9 + floatToStr(nowSkill-prevSkill);

end;

////////////////////////////////////////////////////////////////////////////////
procedure skillLogger(var skills : array of TSkill; loggerProc : TLoggerProc);
var
	s : string;
	f : integer;
begin
	for f := 0 to getArrayLength(skills) - 1 do
	begin
		if (skills[f].lastValue <> getSkillValue(skills[f].skillName)) then
		begin
			s := formatSkillChange_1
				(
					skills[f].skillName,
					skills[f].lastValue, getSkillValue(skills[f].skillName),
					skills[f].lastTime, now
				);

			if (loggerProc <> nil) then loggerProc(s);

			skills[f].lastValue := getSkillValue(skills[f].skillName);
			skills[f].lastTime := now;
		end;
	end;
end;
главная функция - skillLogger(var skills : array of TSkill; loggerProc : TLoggerProc)
где skills - массив со скиллами, приросты которых нада протоколировать
loggerProc - функция осуществляющая протоколирование. в комплекте идут:
fileLogger - запись в файл (имя файла skills-CHAR_SERIAL.txt)
journalLogger - вывод в системный журнал.

пример

Code: Select all

{$Include 'skillLogger.inc'}

const horse = $00000000;

var skills : array of TSkill;

begin
    skills := [makeSkill('Anatomy')];
    repeat
        waitTargetObject(horse);
        useSkill('Anatomy');
        wait(10000);
        skillLogger(skills, @fileLogger);
//        skillLogger(skills, @journalLogger);
    until false;
end.
Edred
Moderator
Moderator
Posts: 559
Joined: 28.03.2006 21:29

Post by Edred »

Эту строку добавить в файл all.inc:

Code: Select all

{$Include 'GetResFromGround.inc'} 
Этот код сохранить как GetResFromGround.inc:

Code: Select all

procedure GetResFromGround(tmptyp : cardinal; tmpcnt : integer; tmpstr : string);
// tmptyp	- тип ресурса
// tmpcnt	- количество (которое необходимо взять)
// tmpstr	- название ресурса (для сообщений)
// Функция ищет на полу указанный ресурс по типу и берет указанное количество.
// Взятие гарантированное, с проверкой коннекта. Ресурс берется только в том
// случае, если его количество в паке меньше требуемого. Если ресурс на полу отсутствует,
// процедура пишет об этом сообщение в журнал и входит в цикл ожидания появления
// этого ресурса под ногами.
// v.1.03 (c) Edred
Var m, p : integer;
begin
	p := Count(tmptyp);
	if p >= tmpcnt then exit;
	waitconnection(3000);
	findtype(tmptyp,ground);
	if GetQuantity(Finditem) < tmpcnt then
	begin
		repeat
			addtosystemjournal('Warning: Мало ' + tmpstr + ' на полу, добавьте');
			wait(10000);
			findtype(tmptyp,ground);
		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;
Пример употребления в скрипте:

Code: Select all

FindDistance := 1;
GetResFromGround($1BD4,100,'шафтов');
Last edited by Edred on 15.12.2006 11:17, edited 4 times in total.
Edred
Moderator
Moderator
Posts: 559
Joined: 28.03.2006 21:29

Post by Edred »

Эту строку добавить в файл all.inc:

Code: Select all

{$Include 'DropCrafts.inc'} 
Этот код сохранить как DropCrafts.inc:

Code: Select all

procedure DropCrafts(tmptyp : cardinal; tmpcnt : integer; tmpstr : string);
// tmptyp	- тип скрафченного
// tmpcnt	- количество (которое необходимо сбросить)
// tmpstr	- название скрафченного (для сообщений)
// Если количество указанного крафта в паке больше или равно заданного -
// то все скрафченное будет сброшено под ноги.
// Сброс гарантированный, с проверкой коннекта.
// v.1.01 (c) Edred
var tmp1 : cardinal;
    tmp2, tmp3 : Integer;
begin
	waitconnection(3000);
	if Count(tmptyp) < tmpcnt then exit;
	tmp3 := 0;
	tmp1 := findtype(tmptyp,backpack);
	while findcount > 0 do
	begin
		tmp2 := GetQuantity(tmp1);
		while not Drop(tmp1,tmp2,0,0,0) do
		begin
			waitconnection(3000);
			wait(500);
			checksave;
		end;
		wait(500);
		tmp3 := tmp3 + tmp2;
		addtosystemjournal('Сбросил ' + inttostr(tmp3) + ' ' + tmpstr);
		tmp1 := findtype(tmptyp,backpack);
	end;
end;
Пример употребления в скрипте:

Code: Select all

DropCrafts($0F3F,100,'стрел');
MeLFiS
Novice
Novice
Posts: 147
Joined: 02.02.2008 12:21

Post by MeLFiS »

Code: Select all

{$Include 'DropCrafts.inc'} 
Как зделать чтобы в етом инклюде он стаковал итемы ато он просто кидает на пол и не стекует (
Edred
Moderator
Moderator
Posts: 559
Joined: 28.03.2006 21:29

Post by Edred »

Переделать функцию на кидание не под ноги, а в кучку. То есть поиск существующей кучки под ногами и далее ее сериал использовать как приемный контейнер для скидывания.
MeLFiS
Novice
Novice
Posts: 147
Joined: 02.02.2008 12:21

Post by MeLFiS »

Он всеравно в 1 кучю не кидает все поверх друг друга
WladL
Apprentice
Apprentice
Posts: 240
Joined: 27.07.2009 17:21
Location: DRW
Contact:

Post by WladL »

Инклюд для минера.

Code: Select all

// *** Ingots.inc v.1.1 ****
// *** for DRW shard ****
// *** Crafted by WladL ****

Type TIngots=record
	Name:String;		//Ingot name
	iType:Cardinal;		//Ingot type
	Color:Cardinal;		//Ingot color
	BS_Skill: Single;	//Skill BS for craft
	Counter:Integer;	//for free use
	end;

var
AIngots:Array[0..29] of TIngots;

procedure InitIngots;
begin
AIngots[0].Name:='Iron';
AIngots[0].iType:=$1BEF;
AIngots[0].Color:=$0000;
AIngots[0].Counter:=0;
AIngots[0].BS_Skill:=20;

AIngots[1].Name:='Rusty';
AIngots[1].iType:=$1BEF;
AIngots[1].Color:=$0750;
AIngots[1].Counter:=0;
AIngots[1].BS_Skill:=60;

AIngots[2].Name:='Old Copper';
AIngots[2].iType:=$1BEF;
AIngots[2].Color:=$0590;
AIngots[2].Counter:=0;
AIngots[2].BS_Skill:=64;

AIngots[3].Name:='Dull Copper';
AIngots[3].iType:=$1BEF;
AIngots[3].Color:=$060A;
AIngots[3].Counter:=0;
AIngots[3].BS_Skill:=68;

AIngots[4].Name:='Copper';
AIngots[4].iType:=$1BE3;
AIngots[4].Color:=$0000;
AIngots[4].Counter:=0;
AIngots[4].BS_Skill:=72;

AIngots[5].Name:='Bronze';
AIngots[5].iType:=$1BEF;
AIngots[5].Color:=$0488;
AIngots[5].Counter:=0;
AIngots[5].BS_Skill:=76;

AIngots[6].Name:='Silver';
AIngots[6].iType:=$1BF5;
AIngots[6].Color:=$0000;
AIngots[6].Counter:=0;
AIngots[6].BS_Skill:=78.5;

AIngots[7].Name:='Gold';
AIngots[7].iType:=$1BE9;
AIngots[7].Color:=$0000;
AIngots[7].Counter:=0;
AIngots[7].BS_Skill:=80;

AIngots[8].Name:='Shadow';
AIngots[8].iType:=$1BEF;
AIngots[8].Color:=$096B;
AIngots[8].Counter:=0;
AIngots[8].BS_Skill:=82.5;

AIngots[9].Name:='Rose';
AIngots[9].iType:=$1BEF;
AIngots[9].Color:=$0014;
AIngots[9].Counter:=0;
AIngots[9].BS_Skill:=85;

AIngots[10].Name:='Agapite';
AIngots[10].iType:=$1BEF;
AIngots[10].Color:=$0193;
AIngots[10].Counter:=0;
AIngots[10].BS_Skill:=87.5;

AIngots[11].Name:='Blood rock';
AIngots[11].iType:=$1BEF;
AIngots[11].Color:=$04C2;
AIngots[11].Counter:=0;
AIngots[11].BS_Skill:=90;

AIngots[12].Name:='Verite';
AIngots[12].iType:=$1BEF;
AIngots[12].Color:=$07D5;
AIngots[12].Counter:=0;
AIngots[12].BS_Skill:=92.5;

AIngots[13].Name:='Valorite';
AIngots[13].iType:=$1BEF;
AIngots[13].Color:=$00CE;
AIngots[13].Counter:=0;
AIngots[13].BS_Skill:=95;

AIngots[14].Name:='Mitheril';
AIngots[14].iType:=$1BEF;
AIngots[14].Color:=$052D;
AIngots[14].Counter:=0;
AIngots[14].BS_Skill:=96;

AIngots[15].Name:='Black Rock';
AIngots[15].iType:=$1BEF;
AIngots[15].Color:=$0455;
AIngots[15].Counter:=0;
AIngots[15].BS_Skill:=97;

AIngots[16].Name:='Obsidian';
AIngots[16].iType:=$1BEF;
AIngots[16].Color:=$0028;
AIngots[16].Counter:=0;
AIngots[16].BS_Skill:=98;

AIngots[17].Name:='Plutonium';
AIngots[17].iType:=$1BEF;
AIngots[17].Color:=$08AF;
AIngots[17].Counter:=0;
AIngots[17].BS_Skill:=99;

AIngots[18].Name:='Dragon';
AIngots[18].iType:=$1BEF;
AIngots[18].Color:=$0085;
AIngots[18].Counter:=0;
AIngots[18].BS_Skill:=100;

AIngots[19].Name:='Crystaline';
AIngots[19].iType:=$1BEF;
AIngots[19].Color:=$09A4;
AIngots[19].Counter:=0;
AIngots[19].BS_Skill:=100;

AIngots[20].Name:='Krynite';
AIngots[20].iType:=$1BEF;
AIngots[20].Color:=$010F;
AIngots[20].Counter:=0;
AIngots[20].BS_Skill:=100;

AIngots[21].Name:='Vulcan';
AIngots[21].iType:=$1BEF;
AIngots[21].Color:=$09DA;
AIngots[21].Counter:=0;
AIngots[21].BS_Skill:=100;

AIngots[22].Name:='Sand Rock';
AIngots[22].iType:=$1BEF;
AIngots[22].Color:=$008F;
AIngots[22].Counter:=0;
AIngots[22].BS_Skill:=100;

AIngots[23].Name:='Blood Crest';
AIngots[23].iType:=$1BEF;
AIngots[23].Color:=$09EC;
AIngots[23].Counter:=0;
AIngots[23].BS_Skill:=100;

AIngots[24].Name:='Steel';
AIngots[24].iType:=$1BEF;
AIngots[24].Color:=$09D3;
AIngots[24].Counter:=0;
AIngots[24].BS_Skill:=100;

AIngots[25].Name:='Elvin';
AIngots[25].iType:=$1BEF;
AIngots[25].Color:=$09E6;
AIngots[25].Counter:=0;
AIngots[25].BS_Skill:=100;

AIngots[26].Name:='Gorgan';
AIngots[26].iType:=$1BEF;
AIngots[26].Color:=$09F0;
AIngots[26].Counter:=0;
AIngots[26].BS_Skill:=100;

AIngots[27].Name:='Acid';
AIngots[27].iType:=$1BEF;
AIngots[27].Color:=$09B9;
AIngots[27].Counter:=0;
AIngots[27].BS_Skill:=100;

AIngots[28].Name:='Aqua';
AIngots[28].iType:=$1BEF;
AIngots[28].Color:=$0060;
AIngots[28].Counter:=0;
AIngots[28].BS_Skill:=100;

AIngots[29].Name:='Eldar';
AIngots[29].iType:=$1BEF;
AIngots[29].Color:=$0BA7;
AIngots[29].Counter:=0;
AIngots[29].BS_Skill:=100;
end;

//===================
//    FUNCTIONS
//+++++++++++++++++++

//Вернет номер инга в массиве по его типу и цвету
Function GetIngId(iType,Color:Cardinal):integer;
Var
I:integer;
Begin
Result:=-1;
If Length(AIngots)=0 then exit;
I:=0;
While (i<high(AIngots)) and (AIngots[i].iType<>iType) and (AIngots[i].Color<>Color) do i:=i+1;
If (AIngots[i].iType=iType) and (AIngots[i].Color = Color) then
Result:=i;
End;

//Вернет тип инга по его номеру
Function GetIngType(ID:integer):cardinal;
Begin
Result:=0;
If Length(AIngots)=0 then exit;
If id<=high(AIngots) then Result:=AIngots[id].iType;
End;

//Вернет цвет инга по его номеру
function GetIngColor(ID:Integer):Cardinal;
begin
if Length(AIngots)=0 then Exit;
Result:=AIngots[ID].Color;
end;

//Вернет название инга по его номеру
function GetIngName(ID:Integer):String;
begin
if Length(AIngots)=0 then Exit;
Result:='';
if (ID > -1) then 
	Result:=AIngots[ID].Name;
end;

//Вернет название инга по его типу и цвету
function GetIngNameEx(iType,Color:Cardinal):String;
var
i:Integer;
begin
if Length(AIngots)=0 then Exit;
Result:='';
i:=GetIngId(iType,Color);
if (i > -1) then Result:=AIngots[i].Name;
end;

//Вернет название инга по его цвету(если есть одинаковые цвета имя инга с меньшим номером)
function GetIngNameExC(Color:Cardinal):String;
Var
I:integer;
Begin
Result:='';
If Length(AIngots)=0 then exit;
I:=0;
While (i<high(AIngots)) and (AIngots[i].Color<>Color) do i:=i+1;
If (AIngots[i].Color = Color) then Result:=AIngots[i].Name;
end;

//Вернет максимальный номер инга с которым можно работать прискилле Cur_skill
function GetIngMaxIDWithSkill(Cur_Skill:Single):Integer;
var
i:Integer;
begin
if Length(AIngots)=0 then Exit;
for i := 0 to Integer(High(AIngots)) do begin 
	if (AIngots[i].BS_Skill<=Cur_Skill) then
		Result:=i;
end;
end;

//Вернет показания счетчика инга с номером ID
Function GetIngCounter(id:integer):integer;
begin
Result:=0;
If Length(AIngots)=0 then exit;
If (id>-1) and (id<high(AIngots)) then Result:=AIngots[id].Counter;
End;

//Вернет показания счетчика инга по типу ицвету
Function GetIngCounterEx(iType,Color:Cardinal):integer;
Var id:integer;
Begin
Result:=0;
If Length(AIngots)=0 then exit;
Id:=GetIngId(iType,Color);
If id >-1 then Result:=AIngots[id].Counter;
End;

//установить показания счетчика ингу с номером ID (Старое значение затирается)
Procedure SetIngCounter(id,value:integer);
Begin
If Length(AIngots)=0 then exit;
If id<=high(AIngots) then AIngots[id].Counter:=value;
End;

//установить показания счетчика ингу по типу и цвету (Старое значение затирается)
Procedure SetIngCounterEx(iType,Color:Cardinal; value:integer);
Var id:integer;
Begin
If Length(AIngots)=0 then exit;
Id:=GetIngId(iType,Color);
If id=-1 then exit;
AIngots[id].Counter:=value;
End;

//Увеличить показания счетчика для инга с номером ID на значение  Value
Procedure IncIngCounter(id,value:integer);
Begin
If Length(AIngots)=0 then exit;
If id<=high(AIngots) then AIngots[id].Counter:=AIngots[id].Counter+value;
End;

//Увеличить показания счетчика для инга с Типом и Цветом на значение  Value
Procedure IncIngCounterEx(iType,Color:Cardinal; value:integer);
Var id:integer;
Begin
If Length(AIngots)=0 then exit;
Id:=GetIngId(iType,Color);
If id=-1 then exit;
AIngots[id].Counter:=AIngots[id].Counter+value;
End;

//Сохранить текущий массив как "Имя = кол-во" в файл;
procedure SaveIngots(fName:String);
var
SL:TStringList;
i:Integer;
begin
SL:=TStringList.Create;
try
	for i:=0 to High(AIngots) do
		SL.Append(GetIngName(i)+' = '+IntToStr(GetIngCounter(i)));
	SL.SaveToFile(fName);
finally
	SL.free;
end;
Как подключить модуль?

Code: Select all

program Any;
{$Include 'Ingots.inc'}
begin
InitIngots;  //<------------Обязательная инициализация
....далее ваш код скрипта
1)Задача: Подсчет ингов добытых скриптом.
Во время очередной разгрузки ищем инги в паке, и увеличиваем значение Counter для этого инга.
В результате например после 24ч работы скрипта по минингу имеем полный список ингов с количеством добытого :Rusty=594; Rose=345;.... все это можно засейвить в файл .
Решение:

Code: Select all

for i:=0 to 29 do begin
   FindTypeEx(GetIngType(i),GetIngColor(i),backpack,true);
   if FindCount>0 then IncIngCounter(i,FindFullQuantity);
end;
SaveIngots('Any_file.txt');
2)Задача: Вывести в журнал текущее количество по каждому ингу вида Rusty=594
Решение:

Code: Select all

for i:=0 to 29 do 
   AddToSystemJournal(GetIngName(i)+' = '+IntToStr(GetIngCounter(i)));
3)Задача: Опознать инг в паке и выдать количество таких ингов прошедших через чара.
Решение:

Code: Select all

for i:=0 to 29 do begin
FindTypeEx(GetIngType(i),GetIngColor(i),backpack,true);
if FindCount>0 then begin 
    AddToSystemJournal(GetIngName(i)+' '+IntToStr( GetIngCounter(i)));
    break;
end;
end;
4)Задача: Сложить определенного вида инги в отдельный контейнер
Решение:

Code: Select all

for i:=0 to 29 do begin
FindTypeEx(GetIngType(i),GetIngColor(i),backpack,true);
   if FindCount>0 then begin
        if i<5 then 
            MoveItem(findItem, TrashCont, ....) //move trash metal      
       else if i<18 then
            MoveItem(findItem, AnyCont, .....)//обычные металы 
       else
            MoveItem(findItem, HighCont, .....) // высшие руды
   end;
5)Задача: Крафтим что-либо из всего что есть , с оглядкой на допустимый уровень скилла.
Решение:

Code: Select all

AddToSystemJournal('Максимально крафтится '+GetIngName(GetIngMaxIDWithSkill(GetSkillValue('Blacksmithy'))));
for i:=0 to GetIngMaxIDWithSkill(GetSkillValue('Blacksmithy')) do begin
   //Here craft items
end;

end.
Last edited by WladL on 01.10.2009 16:02, edited 7 times in total.
Edred
Moderator
Moderator
Posts: 559
Joined: 28.03.2006 21:29

Post by Edred »

А теперь прошу пояснения: зачем предлагать в общие инклюды функции, заточенные под конкретный шард? Названия, цвета металлов, требуемый скилл - это одно из первых, что на разных шардах изменяют под себя.
WladL
Apprentice
Apprentice
Posts: 240
Joined: 27.07.2009 17:21
Location: DRW
Contact:

Post by WladL »

Edred wrote:А теперь прошу пояснения: зачем предлагать в общие инклюды функции, заточенные под конкретный шард? Названия, цвета металлов, требуемый скилл - это одно из первых, что на разных шардах изменяют под себя.
Предлагается общая модель, которую можно модифицировать по свой шард.

К примеру выложенные здесь "Общие" инклюды, такие как СheckSave и Hungry на ДРВ в том виде как они есть не работают, ибо
строка сейва на на упомянутом выше шарде выглядет так: "World is saving now"
А основой скрипта Hungry является команда .hungry на ДРВ заблоченная.

Но это все не означает что я не могу использовать общую концепцию этих инклюдов , немного их модифицировав.
Post Reply