скрипт на бовкрафт

[Carlpots]

дайте скрипт плз по одной стреле на бовкрафт, в теме написано меньше смотрят написал сюда.

[Oasis]

дайте скрипт плз по одной стреле на бовкрафт, в теме написано меньше смотрят написал сюда.

если не дают - купи)

[Carlpots]

дайте скрипт плз по одной стреле на бовкрафт, в теме написано меньше смотрят написал сюда.

если не дают - купи)

Мб подскажет кто как подлатать

Код: Выделить всё

Program Bolts_v004;
{$Include 'all.inc'}



Const
CSize		= 350; // количество стрел в одном цикле
CNum		= 4; // количество циклов

Var
TTimer : TDateTime;
BCounter, CCounter, TCounter, TDone, TFail : Integer;

Begin
BCounter := 0;
CCounter := 0;

CheckStability;
Wait(5000);
While Connected Do Begin
If Not Dead Then
	Begin
	FindDistance:=2;
	FindType(TFeat, BackPack);
	If FindCount = 0 Then
		Begin
		AddToSystemJournal('Нет перьев');
		UOSay('Пёрышки закончились 8-(');
		AddToSystemJournal('Теоретически должны были сделать ' + IntToStr(CNum) + ' цикла по ' + IntToStr(CSize) + ' попыток');
		AddToSystemJournal('Судя по перехвату журнала всего сделано ' + IntToStr(Tcounter) + ' попыток, из них:');
		AddToSystemJournal(IntToStr(TDone) + ' успешных и ' + IntToStr(TFail) + ' неудачных');
		Exit;
		End;
	Wait(300);
	FindType(TShaft, Ground);
	If FindCount = 0 Then
		Begin
		AddToSystemJournal('Нет шафтов');
		UOSay('Заготовки стрел закончились 8-(');
		AddToSystemJournal('Теоретически должны были сделать ' + IntToStr(CNum) + ' цикла по ' + IntToStr(CSize) + ' попыток');
		AddToSystemJournal('Судя по перехвату журнала всего сделано ' + IntToStr(Tcounter) + ' попыток, из них:');
		AddToSystemJournal(IntToStr(TDone) + ' успешных и ' + IntToStr(TFail) + ' неудачных');
		Exit;
		End;
	Wait(300);
	If MenuPresent Then CancelMenu;
	MoveItem(FindItem, 1, BackPack, 0, 0, 0);
	Wait(400);
	If TargetPresent Then CancelTarget;
	TTimer := Now;
	UseObject(FindType(TFeat,Backpack));
	WaitTargetObject(FindType(TShaft, BackPack));
	WaitMenu('What you you','Bolt');
	WaitJournalLine(Now,'You create some|You destroy some', 1000);
	Wait(200);
	BCounter := BCounter + 1;
	If InJournalBetweenTimes('You create some',TTimer,Now) >= 0 Then
		Begin
		TCounter := TCounter + 1;
		TDone := TDone + 1;
		End;
	If InJournalBetweenTimes('You destroy some',TTimer,Now) >= 0 Then
		Begin
		TCounter := TCounter + 1;
		TFail := TFail + 1;
		End;
	Wait(200);
	If BCounter = CSize Then
		Begin
		CCounter := CCounter + 1;
		BCounter := 0;
		AddToSystemJournal('Теоретически должны были сделать ' + IntToStr(CSize) + ' попыток');
		AddToSystemJournal('Судя по перехвату журнала всего сделано ' + IntToStr(Tcounter) + ' попыток, из них:');
		AddToSystemJournal(IntToStr(TDone) + ' успешных и ' + IntToStr(TFail) + ' неудачных');
		CheckSave;
		Hungry(1,-1);
		Wait(500);
		End;
	If CCounter = CNum Then
		Begin
		UOSay('Заказ готов!');
		AddToSystemJournal('Скрипт завершён');
		AddToSystemJournal('Теоретически должны были сделать ' + IntToStr(CNum) + ' цикла по ' + IntToStr(CSize) + ' попыток');
		AddToSystemJournal('Судя по перехвату журнала всего сделано ' + IntToStr(Tcounter) + ' попыток, из них:');
		AddToSystemJournal(IntToStr(TDone) + ' успешных и ' + IntToStr(TFail) + ' неудачных');
		Beep;
		Wait(3000);
		Beep;
		Wait(5000);
		Beep;
		Exit;
		End;
	End;
End;
End.

[Far]

а чего ты не пишешь в дискорде?

[Mypaxa]

Program BowCraft_arrows;
var i : Integer;

Const
DaggerType = $0F51;
ShaftsType = $1BD4;
ArrowsType = $0F3F;
FeathersType = $1BD1;

{$Include 'all.inc'}

procedure CheckShafts;
var k : Integer;
begin
WaitConnection(3000);
CheckSave;
findtype(ShaftsType, ground);
if (findquantity >= 100) then Exit;
Disconnect;
wait(5000);
WaitConnection(3000);
AddToSystemJournal('Мало Shafts! Ждем, пока ктото подкинет');
while findquantity < 100 do
begin
WaitConnection(3000);
CheckSave;
UOSay('У меня мало Shafts! Подкиньте кто-то Shafts!');
k := 0;
while (k < 20) and (findquantity < 100) do
begin
wait(10000);
k := k + 1;
findtype(ShaftsType, ground);
end;
hungry(1, ground);
wait(1000);
findtype(ShaftsType, ground);
end;
AddToSystemJournal('Shafts появились! Продолжаем работать дальше!');
end;

procedure CheckFeathers;
var k : Integer;
begin
WaitConnection(3000);
CheckSave;
findtype(FeathersType, ground);
if (findquantity >= 100) then Exit;
Disconnect;
wait(5000);
WaitConnection(3000);
AddToSystemJournal('Мало Feathers! Ждем, пока ктото подкинет');
while findquantity < 100 do
begin
WaitConnection(3000);
CheckSave;
UOSay('У меня мало Feathers! Подкиньте кто-то Feathers!');
k := 0;
while (k < 20) and (findquantity < 100) do
begin
wait(10000);
k := k + 1;
findtype(FeathersType, ground);
end;
hungry(1, ground);
wait(1000);
findtype(FeathersType, ground);
end;
AddToSystemJournal('Feathers появились! Продолжаем работать дальше!');
end;


procedure CheckDaggers;
var c : Integer;
Begin
WaitConnection(3000);
CheckSave;
c := Count(DaggerType);
if c > 0 then Exit
else AddToSystemJournal('No daggers!');
End;

function GrabFeather : Boolean;
var c : Integer;
stime : TDateTime;
Feather : Cardinal;
begin
Feather := FindType(FeathersType,ground);
if Feather = 0 then
begin
AddToSystemJournal('Error with grab feather. Feather not finded at ground');
result := false;
Exit;
end;
stime := Now;
Grab(Feather, 1);
repeat
c := InJournalBetweenTimes('performing|doing', stime, Now);
wait(100);
until (Now > stime + (1.0/1440)) or (c >= 0) or (FindType(FeathersType,backpack) <> 0);
wait(100);
result := true;
end;

procedure Make;
var c : Integer;
stime : TDateTime;
Shafts : Cardinal;
Feather : Cardinal;
begin
if GrabFeather = false then
begin
wait(1000);
Exit;
end;
Shafts := FindType(ShaftsType,ground);
if Shafts = 0 then
begin
AddToSystemJournal('Error with make arrows. Shafts not finded at ground');
Exit;
end;
Feather := FindType(FeathersType,backpack);
if Feather = 0 then
begin
AddToSystemJournal('Error with make arrows. Feather not finded at backpack');
Exit;
end;
stime := Now;
UseObject(Feather);
WaitTargetObject(Shafts);
wait(200);
repeat
c := InJournalBetweenTimes('performing|doing', stime, Now);
InJournalBetweenTimes('create|make|destroy', stime, Now);
wait(100);
until (LineCount >= 1) or (Now > stime + (1.0/1440)) or (c >= 0);
wait(100);
end;

Begin
AutoMenu('create','Arrow');
FindDistance := 2;
WaitConnection(3000);
CheckSave;
wait(5000);
SetARStatus(true);

findtype(ArrowsType, backpack);
if FindFullQuantity > 1 then
begin
AddToSystemJournal('Stack');
Stack(ArrowsType, GetColor(finditem));
wait(1000);
end;

while true do
begin
findtype(ArrowsType, backpack);
if FindFullQuantity > 100 then
begin
AddToSystemJournal('Stack');
Stack(ArrowsType, GetColor(finditem));
wait(1000);
end;

FindType(FeathersType,ground);
AddToSystemJournal('Осталось '+IntToStr(FindFullQuantity)+' перьев.');
WaitConnection(3000);
CheckSave;
CheckDaggers;
CheckShafts;
CheckFeathers;
Hungry(1, ground);
wait(1000);
i := 0;
while i < 200 do
begin
Make;
i := i + 1;
end;
end;
End.

[Turner]

пожалуйста, заключай код скрипта в тег код.
спасибо.

[Carlpots]

Спасибо огромное!!!!

[Carlpots]

Program BowCraft_arrows;
var i : Integer;

включил скрипт, работает хотел переделать под делание болтов, не вышло дальше делал стрелы, положил больше стрел под ного начал сбиваться и дисконектит пишет нету перьев и вырубает клиент, вырезал все с форума по новой все равно выбивает клиент и пишет мало перьев, может гмы портят скрипт через время из за обстоятельств в стране , после благодарностей о скрипте. скиньте еще раз тот же скрипт если дело в этом

еще раз спасибо

[Carlpots]

перья на клетку прям чара надо было кинутьб работаетб как деланье болтов переставить подскажите плз

[Oasis]

перья на клетку прям чара надо было кинутьб работаетб как деланье болтов переставить подскажите плз

куда переставить?)