1. Из логов крафтим доски, скилл не растет
2. Из досок крафтим бумагу (в паке должно быть корыто с водой), бумага не складывается в стопки.
3. Из бумаги и ткани крафтятся partchments, причем у них такой же тип и цвет как у бумаги. В стопки не складываются.
4. Из partchments крафтятся бланкскроллы.
Плюс ко всему для пункта 3 для крафта нужен больший скилл, нежели для 2, для 4 - больший, нежели для 3.
К тому же на шарде глючат меню крафта, очень часто проскакивают ошибки и крафтится совсем не то, что заказывали.
Но на шарде есть команда .makelast для повтора предыдущего крафта.
Вот мое решение всех этих проблем:
Потребуется: в пак пилу, корыто с водой. Под ноги чару кучу логов и ткани. Рядом с чаром два сундука или ящика, в первый - кучу пустых мешков.
Весь крафт состоит из нескольких скриптов, объединять лень. Запускайте их по очереди, каждый на денек-другой.
ЭТАП 1. Крафтим доски.
Code: Select all
Program Carpentry1UP; 
// v.1.02b (c) Edred 
{$Include 'all.inc'} 
// 1 этап. Из логов делаем доски.
// 2 этап. Из досок делаем бумагу. В паке должен быть water trough
// 3 этап (с 20.7 скилла). Из бумаги и folded cloth делаем Parchment
// 4 этап (с 25.7 скилла). Из parchment делаем Blank Scroll
 
var 
ctime : TDateTime; 
k : integer; 
b : integer;
OldSkill : Double;
const 
ToolsType = $1034;      // saw 
TypBoards = $1BD7;      // Тип досок 
CountLogsForBoard = 20; 
HowGetLogs = 100; 
HowDropBoards = 20; 
TypLogs = $1BDD;
TrashID = $4005198D; 
	procedure CheckLogs; 
	begin 
		waitconnection(5000); 
		If Count(TypLogs) < CountLogsForBoard then 
		begin 
			FindType(TypLogs, ground); 
			if FindCount > 0 then 
			begin 
				k := FindQuantity; 
				Grab( FindItem, HowGetLogs ); 
				wait(1000); 
				checksave; 
				Addtosystemjournal('Взял еще ' + inttostr(HowGetLogs) + ' логов из ' + inttostr(k)); 
			end 
			else 
			begin
				Addtosystemjournal('Нет логов на полу, добавьте'); 
				repeat 
					wait(1000); 
					findtype(TypLogs, ground)
				until FindCount > 0;
				k := FindQuantity; 
				Grab(FindItem, HowGetLogs); 
				wait(1000); 
				checksave; 
				Addtosystemjournal('Взял еще ' + inttostr(HowGetLogs) + ' логов из ' + inttostr(k)); 
			end; 
		end; 
	end;
                
	procedure CheckBoards; 
	begin 
		waitconnection(5000); 
		If Count(TypBoards) > (HowDropBoards - 1) then 
		begin 
			b := Count(TypBoards); 
			FindType(TypBoards, backpack); 
			while FindCount > 0 do 
			begin 
				Drop(FindItem, 0, 0, 0, 0); 
				wait(1000); 
				checksave; 
				Addtosystemjournal('Сбросил ' + inttostr(b) + ' досок'); 
				FindType(TypBoards, backpack); 
			end; 
		end; 
	end; 
Begin 
	FindDistance := 2;
	OldSkill := GetSkillValue('Carpentry');
	CancelMenu; 
	AutoMenu('Carpentry', 'boards'); 
	// Первый раз через меню
	CheckLogs; 
	findtype(ToolsType, backpack); 
	if FindCount > 0 then 
	begin 
		ctime := Now; 
		k := 0; 
		UseObject( FindItem ); 
		repeat 
            wait(100); 
            k := k + 1; 
            checksave; 
         until (InJournalBetweenTimes('You put|failed.', ctime, Now)<>-1) or (k > 200); 
         CheckBoards;
      end;
   // Теперь через makelast
   repeat 
      CheckLogs; 
      findtype(ToolsType, backpack); 
      if FindCount > 0 then 
      begin 
         ctime := Now; 
         k := 0; 
		 UOSay('.makelast'); 
         repeat 
            wait(100); 
            k := k + 1; 
            checksave; 
         until (InJournalBetweenTimes('You put|failed.', ctime, Now)<>-1) or (k > 200); 
         CheckBoards; 
      end 
      else 
      begin 
         repeat 
            waitconnection(5000); 
            findtype(ToolsType, ground); 
            if FindCount > 0 then 
            begin 
               Grab( FindItem, 0 ); 
               wait(1000); 
               checksave; 
            end 
            else 
            begin 
               Addtosystemjournal('Нет инструментов в паке, киньте на пол'); 
               repeat 
                  wait(1000); 
                  findtype(ToolsType, ground); 
               until (FindCount > 0); 
               Grab( FindItem, 0 ); 
               wait(1000); 
               checksave; 
            end; 
         until (Count(ToolsType) > 0); 
      end;
	  if GetSkillValue('Carpentry') > OldSkill then
	  begin
		 AddToSystemJournal('Скилл Carpentry вырос. Теперь он равен ' + FloatToStr(GetSkillValue('Carpentry')));
		 OldSkill := GetSkillValue('Carpentry');
	  end;
   until GetSkillValue('Carpentry') >= 100.0;
End.Code: Select all
Program Carpentry2UP; 
// v.1.00b (c) Edred 
{$Include 'all.inc'} 
// 1 этап. Из логов делаем доски.
// 2 этап. Из досок делаем бумагу. В паке должен быть water trough
// 3 этап (с 20.7 скилла). Из бумаги и folded cloth делаем Parchment
// 4 этап (с 25.7 скилла). Из parchment делаем Blank Scroll
 
var 
ctime : TDateTime;
LastContOpen : TDateTime;
k, s, m : integer; 
curbag : cardinal;
FirstTime : boolean;
OldSkill : Double;
const
WhatYouDo = 'Paper';		// можно написать, например: '(last)'
TypBoards = $1BD7;					// Тип досок
TypPaper = $1F24;
CountBoards = 5;
HowGetBoards = 100;
HowDropPapers = 20;
TrashID = $4005198D;
SundukEmptyBag = $40053D27;			// тут лежат пустые мешки
Sunduk2Craft = $40053D34;			// сюда кладем скрафченное
BagType = $0E76;
ToolsType = $1034;      // saw 
	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(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;
	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;
		Addtosystemjournal('Взял новый мешок');
	end;
	function CheckCountPaper : Boolean;
	begin
		Result := False;
		findtype(TypPaper,curbag);
		if findcount > 250 then exit;
		Result := True;
	end;
	function GetRes : boolean;
	begin
		Result := True;
		if Count(TypBoards) < CountBoards then
		begin
			waitconnection(3000);
			findtype(TypBoards,ground);
			if GetQuantity(Finditem) < HowGetBoards then
			begin
				repeat
					addtosystemjournal('Warning: Мало досок на полу');
					wait(10000);
					findtype(TypBoards,ground);
				until GetQuantity(Finditem) >= HowGetBoards;
			end;
			m := GetQuantity(finditem);
			Grab(FindItem,HowGetBoards);
			wait(1000);
			checksave;
			addtosystemjournal('Взял ' + inttostr(HowGetBoards) + ' boards из ' + inttostr(m));
		end;
	end;
	procedure DropPapers(a : integer);
	var tmp1 : cardinal;
		tmp2, tmp3 : Integer;
	begin
		waitconnection(3000);
		if Count(TypPaper) < HowDropPapers then exit;
		tmp3 := 0;
		tmp1 := findtype(TypPaper,backpack);
		while findcount > 0 do
		begin
			OpenContainer(false);
			if not CheckCountPaper then curbag := GetEmptyBag;
			tmp2 := GetQuantity(tmp1);
			MoveItem(tmp1,tmp2,curbag,0,0,0);
			wait(500);
			checksave;
			tmp3 := tmp3 + 1;
			tmp1 := findtype(TypPaper,backpack);
		end;
		addtosystemjournal('Сбросил ' + inttostr(tmp3) + ' Papers. Всего скрафчено ' + inttostr(a));
	end;
Begin 
	FindDistance := 2; 
	s := 0;
	CancelMenu; 
	AutoMenu('Carpentry', WhatYouDo); 
	FirstTime := true;
	// Первый раз через меню
	LastContOpen := Now;
	OpenContainer(true);
	curbag := GetEmptyBag;
	OldSkill := GetSkillValue('Carpentry');
	repeat
		if not GetRes then exit;
		waitconnection(3000);
		ctime := Now;
		k := 0;
		if FirstTime then
		begin
			if TargetPresent then CancelTarget;
			UseType(ToolsType, $FFFF);
			FirstTime := false;
		end
		else UOSay('.makelast');
		repeat 
			wait(100); 
			k := k + 1; 
			checksave; 
		until (InJournalBetweenTimes('You put|You fail', ctime, Now)<>-1) or (k > 200);
		if InJournalBetweenTimes('You put', ctime, Now)<>-1 then s := s + 1;
		wait(2000)
		DropPapers(s);
		if GetSkillValue('Carpentry') > OldSkill then
		begin
			AddToSystemJournal('Скилл Carpentry вырос. Теперь он равен ' + FloatToStr(GetSkillValue('Carpentry')));
			OldSkill := GetSkillValue('Carpentry');
		end;
	until GetSkillValue('Carpentry') >= 100.0;
End.Code: Select all
Program Carpentry3UP; 
// v.2.00b (c) Edred 
{$Include 'all.inc'} 
// 3 этап (с 20.7 скилла). Из бумаги и folded cloth делаем Parchment
// 4 этап (с 25.7 скилла). Из parchment делаем Blank Scroll
// Новый алгоритм:
//1. Функция поиска в сундуке мешка с бумагой, взять его в пак, открыть
//2. Пока в этом мешке есть бумага делай:
//3. Проверить есть ли ткань, взять 50
//4. Крафт партчментов, проверка на 'You put' и таймер на 15 сек. Первый крафт через меню,
//   последующие через .makelast
//5. Когда бумага кончилась в мешке, делаем:
//6. Пока в паке есть партчменты, делай:
//7. Крафтим бланкскроллы, первый крафт через меню, последующие через .makelast
//8. Когда партчментов нет, скидываем бланки на пол и пустой мешок в первый сундук
var 
ctime : TDateTime;
LastContOpen : TDateTime;
k : integer; 
curbag : cardinal;
OldSkill : Double;
FirstTime : Boolean;
const
WhatYouDo = 'Parchment';		// можно написать, например: '(last)'
WhatYouDo2 = 'blank scroll';
TypPaper = $1F24;
TypScroll = $0E34;
TypCloth = $175D;
MinCloth = 1;
MaxCloth = 50;
MinPapers = 1;
MaxPapers = 1;
HowDropScroll = 20;
SundukEmptyBag = $40053D27;			// тут лежат пустые мешки
Sunduk2Craft = $40053D34;			// сюда кладем скрафченное
BagType = $0E76;
ToolsType = $1034;      // saw 
	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(Sunduk2Craft);
			wait(1000);
			checksave;
			if curbag <> 0 then
			begin
				UseObject(curbag);
				wait(1000);
				checksave;
			end;
			LastContOpen := Now;
			addtosystemjournal('Контейнеры открыты в ' + DateTimeToStr(Now));
		end;
	end;
	function FindBagWithPapers : Cardinal;
	var tmpid : Cardinal;
		tmpflag : Boolean;
	begin
		Result := 0;
		repeat
			waitconnection(3000);
			tmpid := Findtype(BagType,Sunduk2Craft)
			if tmpid = 0 then exit;
			UseObject(tmpid);
			wait(1000);
			checksave;
			if CountEx(TypPaper,$FFFF,tmpid) > 0 then
			begin
				waitconnection(3000);
				repeat
					tmpflag := MoveItem(tmpid,1,backpack,0,0,0);
//				Grab(tmpid,GetQuantity(tmpid));
					wait(1000);
					checksave;
				until tmpflag;
				UseObject(tmpid);
				wait(1000);
				checksave;
				Result := tmpid;
				addtosystemjournal('Найден мешок с бумагой, взят в пак ' + inttostr(tmpid));
				exit;
			end;
			Ignore(tmpid);
		until tmpid = 0;
		IgnoreReset;
	end;
	procedure DropEmptyBag(tmpid : Cardinal);
	begin
		waitconnection(3000);
		OpenContainer(false);
		MoveItem(tmpid,GetQuantity(tmpid),SundukEmptyBag,0,0,0);
		wait(1000);
		checksave;
		AddtosystemJournal('Сбросил пустой мешок');
	end;
	function GrabResources : Boolean;
	var tmpid : Cardinal;
		tmpnum : integer;
	begin
		Result := False;
		waitconnection(3000);
		tmpnum := 0;
		if (Count(TypCloth) < MinCloth) then
		begin
			OpenContainer(false);
			tmpid := Findtype(TypCloth,ground);
			if tmpid = 0 then exit;
			Grab(finditem,MaxCloth);
			wait(1000);
			checksave;
			addtosystemjournal('Взял ' + inttostr(MaxCloth) + ' cloths. В мешке: ' + inttostr(CountEx(TypPaper,$FFFF,curbag)) + ' листов бумаги');
		end;
		Result := True;
	end;
	procedure DropScroll;
	var tmp1 : cardinal;
		tmp2, tmp3 : Integer;
	begin
		waitconnection(3000);
		if Count(TypScroll) < HowDropScroll then exit;
		tmp3 := 0;
		tmp1 := findtype(TypScroll,backpack);
		while findcount > 0 do
		begin
			tmp2 := GetQuantity(tmp1);
			Drop(tmp1,tmp2,0,0,0);
			wait(500);
			checksave;
			tmp1 := findtype(TypScroll,backpack);
		end;
		addtosystemjournal('Сбросил ' + inttostr(tmp2) + ' blank scrolls');
	end;
	function CheckParthcment : Boolean;
	var tmp1 : Cardinal;
		tmptime : TDateTime;
	begin
		Result := false;
		tmp1 := FindType(TypPaper,backpack);
		while tmp1 <> 0 do
		begin
			tmptime := Now;
			ClickOnObject(tmp1);
			wait(1000);
			checksave;
			if InJournalBetweenTimes('Parchment', tmptime, Now)<>-1 then
			begin
				addtosystemjournal('test1: yes');
				Result := true;
				IgnoreReset;
				exit;
			end;
			Ignore(tmp1);
			tmp1 := FindType(TypPaper,backpack);
		end;
		IgnoreReset;
	end;
Begin
	IgnoreReset;
	curbag := 0;
	OldSkill := GetSkillValue('Carpentry');
	LastContOpen := Now;
	OpenContainer(true);
	repeat
		//1. Функция поиска в сундуке мешка с бумагой, взять его в пак, открыть
		curbag := FindBagWithPapers;
		if curbag = 0 then
		begin
			Addtosystemjournal('Бумага кончилась');
			exit;
		end;
		FirstTime := True;
		//2. Пока в этом мешке есть бумага делай:
		While (CountEx(TypPaper,$FFFF,curbag) > 0) do
		begin
			//3. Проверить есть ли ткань, взять 50
			if not GrabResources then
			begin
				Addtosystemjournal('Нету ткани на полу');
				exit;
			end;
			//4. Крафт партчментов, проверка на 'You put' и таймер на 20 сек. Первый крафт через меню,
			//   последующие через .makelast
			if FirstTime then
			begin
				waitconnection(3000);
				OpenContainer(false);
				CancelMenu;
				if TargetPresent then CancelTarget;
				ctime := Now;
				WaitMenu('Carpentry', WhatYouDo);
				if UseType(ToolsType,$FFFF) = 0 then exit;
				k := 0;
				repeat
					wait(100);
					k := k + 1;
					checksave;
				until (InJournalBetweenTimes('You put', ctime, Now)<>-1) or (k > 200);
				if InJournalBetweenTimes('You put', ctime, Now)<>-1 then FirstTime := False;
			end
			else
			begin
				waitconnection(3000);
				OpenContainer(false);
				if TargetPresent then CancelTarget;
				ctime := Now;
				UOSay('.makelast');
				k := 0;
				repeat
					wait(100);
					k := k + 1;
					checksave;
				until (InJournalBetweenTimes('You put', ctime, Now)<>-1) or (k > 200);
				if GetSkillValue('Carpentry') > OldSkill then
				begin
					AddToSystemJournal('Скилл Carpentry вырос. Теперь он равен ' + FloatToStr(GetSkillValue('Carpentry')));
					OldSkill := GetSkillValue('Carpentry');
				end;
			end;
			OpenContainer(false);
		end;
		//5. Когда бумага кончилась в мешке, делаем:
		//6. Пока в паке есть партчменты, делай:
		FirstTime := True;
		//7. Крафтим бланкскроллы, первый крафт через меню, последующие через .makelast
		While (Count(TypPaper) > 0) do
		begin
			if FirstTime then
			begin
				waitconnection(3000);
				CancelMenu;
				if TargetPresent then CancelTarget;
				ctime := Now;
				WaitMenu('Carpentry', WhatYouDo2);
				if UseType(ToolsType,$FFFF) = 0 then exit;
				k := 0;
				repeat
					wait(100);
					k := k + 1;
					checksave;
				until (InJournalBetweenTimes('You put', ctime, Now)<>-1) or (k > 200);
				if InJournalBetweenTimes('You put', ctime, Now)<>-1 then FirstTime := False;
			end
			else
			begin
				waitconnection(3000);
				if TargetPresent then CancelTarget;
				ctime := Now;
				UOSay('.makelast');
				k := 0;
				repeat
					wait(100);
					k := k + 1;
					checksave;
				until (InJournalBetweenTimes('You put', ctime, Now)<>-1) or (k > 200);
				if GetSkillValue('Carpentry') > OldSkill then
				begin
					AddToSystemJournal('Скилл Carpentry вырос. Теперь он равен ' + FloatToStr(GetSkillValue('Carpentry')));
					OldSkill := GetSkillValue('Carpentry');
				end;
			end;
		end;
		//8. Когда партчментов нет, скидываем бланки на пол и пустой мешок в первый сундук
		DropScroll;
		DropEmptyBag(curbag);
	until GetSkillValue('Carpentry') >= 100.0;
End.
