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

Ковка фуллармов в указанном кол-ве

Only working scripts
Post Reply
Edred
Moderator
Moderator
Posts: 559
Joined: 28.03.2006 21:29

Ковка фуллармов в указанном кол-ве

Post by Edred »

Куем армы в указанном количестве из указанного металла с раскладкой по указанному количеству мешков :lol:

Шард: Forest Wars

Code: Select all

Program bcVeriteArmor;
// Крафт всех частей арморов из выбранного металла
// по N шт. каждого элемента, с раскладкой этих армов по мешкам.
// Инги берутся из одного контейнера, пустые мешки из другого, помещается все
// в третий контейнер.
//
// v.1.00b (c) Edred

{$Include 'all.inc'}

const
CurrentChoice = 1;					// Какой тип металла использовать
HowMany2Bag = 10;					// Сколько армов на один мешок
HowManyOfBag = 5;					// Сколько мешков сделать
//
SundukIngots = $40038105;			// тут хранятся инги
SundukEmptyBag = $40053D27;			// тут лежат пустые мешки
Sunduk2Craft = $40053D34;			// сюда кладем скрафченное
BagType = $0E76;					// тип мешка
MenuL1Up = 'Blacksmithing';				// Шапка меню первого уровня
MenuL1Dn = 'Colored Armor';				// Выбор в меню первого уровня
MenuL2Up = 'Armor';						// спереди добавить металл

var
LastContOpen : TDateTime;
curbag : cardinal;
countbag, countinbag, meter1 : integer;
flag1, flag2 : boolean;
NameIngots : array[1..3] of string;		// названия металлов (на конце пробел для меню)
TypeIngot : array[1..3] of cardinal;	// типы
ColorIngot : array[1..3] of cardinal;	// цвета
PunktMenu : array[1..7] of string;	// пункты меню, спереди добавить металл
TypePunktMenu1 : array[1..7] of cardinal;		// типы соответствующих частей армов
TypePunktMenu2 : array[1..7] of cardinal;		// типы соответствующих частей армов
CountPunktMenu : array[1..7] of integer;		// сколько ингов на части армов



	procedure IniArrays;
	begin
		NameIngots[1] := 'Verite ';
		TypeIngot[1] := $1BEF;
		ColorIngot[1] := $07D1;
		NameIngots[2] := 'Valorite ';
		TypeIngot[2] := $1BEF;
		ColorIngot[2] := $0515;
		NameIngots[3] := 'Shadow ';
		TypeIngot[3] := $1BEF;
		ColorIngot[3] := $0381;		
		TypePunktMenu1[1] := $1412;						// в зависимости от ориентации
		TypePunktMenu2[1] := $1419;
		TypePunktMenu1[2] := $1413;
		TypePunktMenu2[2] := $1413;
		TypePunktMenu1[3] := $1414;
		TypePunktMenu2[3] := $1418;
		TypePunktMenu1[4] := $1410;
		TypePunktMenu2[4] := $1417;
		TypePunktMenu1[5] := $1411;
		TypePunktMenu2[5] := $141A;
		TypePunktMenu1[6] := $1415;
		TypePunktMenu2[6] := $1416;
		TypePunktMenu1[7] := $1B76;
		TypePunktMenu2[7] := $1B77;
		PunktMenu[1] := 'Plate Helm';
		PunktMenu[2] := 'Platemail Gorget';
		PunktMenu[3] := 'Platemail Gauntlets';
		PunktMenu[4] := 'Platemail Arms';
		PunktMenu[5] := 'Platemail Legs';
		PunktMenu[6] := 'Platemail Breastplate';
		PunktMenu[7] := 'Heater Shield';
		CountPunktMenu[1] := 15;
		CountPunktMenu[2] := 10;
		CountPunktMenu[3] := 12;
		CountPunktMenu[4] := 18;
		CountPunktMenu[5] := 20;
		CountPunktMenu[6] := 25;
		CountPunktMenu[7] := 18;
	end;

	function GetEmptyBag : cardinal;
	// берет пустой мешок из одного контейнера и помещает в другой
	// возвращает сериал пустого мешка
	var tmp1 : cardinal;
	begin
		Result := 0;
		waitconnection(3000);
		tmp1 := FindType(BagType,SundukEmptyBag);
		if tmp1 = 0 then
		begin
			Addtosystemjournal('Error: кончились мешки');
			exit;
		end;
		MoveItem(tmp1,1,Sunduk2Craft,0,0,0);
		wait(1000);
		CheckSave;
		UseObject(tmp1);
		wait(1000);
		CheckSave;
		Result := tmp1;
	end;

	function GetIngots(t,c : integer) : boolean;
	// берет из сундука нужное количество нужных инготов
	// t - какие инги брать (номер), c - какой номер пункта крафта (для кол-ва)
	// если в паке есть часть нужных ингов - возьмет только недостающее
	// если не хватает 1 инга - возьмет 2
	// возвращает true - если успех, false - если нет ингов
	var k, b : integer;
	begin
		Result := false;
		waitconnection(3000);
		k := CountEx(TypeIngot[t],ColorIngot[t],backpack);
		if k < CountPunktMenu[c] then
		begin
			if FindTypeEx(TypeIngot[t],ColorIngot[t],SundukIngots,false) = 0 then
			begin
				Addtosystemjournal('Error: кончились инги');
				exit;
			end;
			b := CountPunktMenu[c] - k;
			if b = 1 then b := 2;
			if FindQuantity < b then
			begin
				Addtosystemjournal('Error: Мало ингов в сундуке');
				exit;
			end;
			Grab( FindItem, b );
			wait(1000);
			checksave;
			Addtosystemjournal('Взял еще ' + inttostr(b) + ' ингов из ' + inttostr(FindQuantity));
		end;
		Result := True;
	end;
	
	function CraftOneItem(t,c : integer; f : boolean) : boolean;
	// крафтит указанный предмет c из ингов t. Параметры такие же как и ранее.
	// f - флаг способа крафта. true - через меню, false - через .makelast
	// Возвращает true - если крафт успешен, false - если физл
	var tmpingot : cardinal;
		s : TDateTime;
		k : integer;
	begin
		waitconnection(3000);
		tmpingot := FindTypeEx(TypeIngot[t],ColorIngot[t],backpack,false);
		if tmpingot = 0 then
		begin
			addtosystemjournal('Error: не могу найти инги в паке!');
			repeat
				wait(10000);
				tmpingot := FindTypeEx(TypeIngot[t],ColorIngot[t],backpack,false);
			until tmpingot <> 0;
		end;
		if f = true then
		begin
			CancelMenu;
			WaitMenu(MenuL1Up,MenuL1Dn);
			WaitMenu(NameIngots[t]+MenuL2Up, PunktMenu[c]);
			// крафтим
			if TargetPresent then CancelTarget;
			s := Now;
			k := 0;
			UseObject(ObjAtLayer(RHandLayer,self));
			WaitForTarget(5000);
			If TargetPresent then TargetToObject(tmpingot);
			repeat
				wait(100);
				k := k + 1;
				checksave;
			until (InJournalBetweenTimes('You put|failed', s, Now)<>-1) or (k > 300);
			if InJournalBetweenTimes('You put', s, Now)<>-1 then Result := true else Result := false;
			CancelMenu;
		end
		else
		begin
			if TargetPresent then CancelTarget;
			s := Now;
			k := 0;
			UOSay('.makelast');
			repeat
				wait(100);
				k := k + 1;
				checksave;
			until (InJournalBetweenTimes('You put|failed', s, Now)<>-1) or (k > 300);
			if InJournalBetweenTimes('You put', s, Now)<>-1 then Result := true
			else Result := false;
		end;
	end;

	procedure DropOneItem(c : integer; b : cardinal);
	// c - номер пункта крафта, b - сериал мешка
	// Ищем в паке скрафченный предмет и скидываем в мешок.
	begin
		waitconnection(3000);
		repeat
			if FindType(TypePunktMenu1[c],backpack) = 0 then FindType(TypePunktMenu2[c],backpack);
			if FindItem <> 0 then
			begin
				MoveItem(FindItem,1,b,0,0,0);
				wait(1000);
				checksave;
				addtosystemjournal(PunktMenu[c] + ' сброшен в мешок' + inttohex(b,8));
			end;
		until finditem = 0;
	end;

	procedure OpenContainer(f : boolean);
	// если f - true - просто открываем все нужные контейнеры, то есть:
	// SundukIngots,SundukEmptyBag,Sunduk2Craft и curbag (если он не равен 0)
	// если f - false - проверяем, был ли реконнект чара после последнего
	// открывания контейнеров, если был - переоткрываем контейнеры и записываем
	// новое значение в переменную LastContOpen, если не был - ничего не делаем
	begin
		waitconnection(3000);
		if (f = true) or (LastContOpen < ConnectedTime) then
		begin
			UseObject(SundukIngots);
			wait(1000);
			checksave;
			UseObject(SundukEmptyBag);
			wait(1000);
			checksave;
			UseObject(Sunduk2Craft);
			wait(1000);
			checksave;
			if curbag <> 0 then
			begin
				UseObject(curbag);
				wait(1000);
				checksave;
			end;
			LastContOpen := Now;
			addtosystemjournal('Контейнеры открыты в ' + DateTimeToStr(Now));
		end;
	end;


Begin									// включаем логику :)
	IniArrays;
	curbag := 0;
	LastContOpen := Now;
	OpenContainer(true);
	countbag := 0;
	repeat								// Цикл по заказанному количеству мешков
		OpenContainer(false);
		curbag := GetEmptyBag;
		if curbag = 0 then exit;
		countbag := countbag + 1;
		for meter1 := 1 to 7 do		// Цикл по частям арма (их 7)
		begin
			countinbag := 0;
			flag2 := true;
			repeat							// Цикл по количеству армов в мешке
				repeat						// цикл попыток крафта одной вещи
					OpenContainer(false);
					if not GetIngots(CurrentChoice,meter1) then exit;
					flag1 := CraftOneItem(CurrentChoice,meter1,flag2);
				until flag1 = true;
				flag2 := false;
				OpenContainer(false);
				DropOneItem(meter1,curbag);
				countinbag := countinbag + 1;
				addtosystemjournal('INFO: bag ' + inttostr(countbag) + ' of ' + inttostr(HowManyOfBag) + '; part ' + inttostr(meter1) + ' of 7; count ' + inttostr(countinbag) + ' of ' + inttostr(HowMany2Bag));
			until countinbag = HowMany2Bag;
		end;
	until countbag = HowManyOfBag;
End.
Scripts Writer
Novice
Novice
Posts: 130
Joined: 06.05.2008 18:03

Post by Scripts Writer »

Немного подправил Меню, убрал 'self' из ObjAtLayer.
Спасибо за труд.
Daroo
Posts: 3
Joined: 23.04.2011 22:48
Contact:

Post by Daroo »

Подскажите, а возможно ли этот скрипт перенастроить для шарда ДРВ, и если это так, то был бы благодарен за готовый вариант, если нет, то подскажите хотябы, что именно нужно переменить!?
Post Reply