Code: Select all
Program mining;
{$Include 'all.inc'}
type LumbRecord = Record
x,y,tt : integer;
end;
var
MineDim : array [0..5000] of LumbRecord;
MaxPosL : integer;
k, x, y, c, i : Integer;
mn1, mf1, mf2, ms1 : Integer;
ctime : TDateTime;
List : TStringList;
NTH : Integer;
Color : array[1..12] of cardinal;
s: string;
const
Pickaxe1 = $0E85; // Типы кирок
Pickaxe2 = $0E86;
function CheckPickaxe : Boolean;
var tmpser : Cardinal;
begin
Result := true;
if (ObjAtLayerEx(RhandLayer,self) = 0) then
begin
tmpser := findtype(Pickaxe1,backpack);
if tmpser = 0 then tmpser := findtype(Pickaxe2,backpack);
if tmpser = 0 then
begin
Result := false;
exit;
end;
if not equip(RhandLayer,tmpser) then
begin
wait(1000);
if not equip(RhandLayer,tmpser) then
begin
Result := false;
exit;
end;
end;
wait(500);
checksave;
end;
end;
procedure MiningAround;
Begin
for x := -2 to 2 do
begin
for y := -2 to 2 do
begin
repeat
waitconnection(5000);
if not CheckPickaxe then
begin
exit;
end;
if TargetPresent then CancelTarget;
if WarMode = true then SetWarMode(false);
ctime := Now;
UseObject(ObjAtLayerEx(RhandLayer,self));
WaitForTarget(5000);
If TargetPresent then TargetToTile(1342, GetX(self)+x, GetY(self)+y, GetZ(self));
k := 0;
repeat
wait(100);
k := k + 1;
checksave;
mn1 := InJournalBetweenTimes('stop', ctime, Now);
mf1 := InJournalBetweenTimes('you can', ctime, Now);
mf2 := InJournalBetweenTimes('fail', ctime, Now);
ms1 := InJournalBetweenTimes('way', ctime, Now);
until (mn1<>-1) or (mf1<>-1) or (mf2<>-1) or (ms1<>-1) or (k > 300);
until (mn1<>-1);
end;
end;
End;
procedure DropOre;
begin
Color[1] := $0000;// iron
Color[2] := $0602;//coper
Color[3] := $0455;//black draft
Color[4] := $03E9;//silver
Color[5] := $0502;// pafan
Color[6] := $0483;// spectral
Color[7] := $0480;//ice
Color[8] := $0486;//lava
Color[9] := $0492;//mythril
Color[10] := $0487;//basilik
Color[11] := $0494;//dedra
Color[12] := $0514;//sun
for c:=1 to 12 do
begin
//Addtosystemjournal('Выбрасываю чугун');
FindTypeEx($19B9,Color[c],backpack,False);
if (FindCount>0) then
begin
MoveItem(FindItem,0,ground,0,0,0);
wait(200);
checksave;
end;
end;
end;
procedure DropMap;
begin
//Addtosystemjournal('Выбрасываю карты');
repeat
FindTypeEx($14ED,$ffff,backpack,False);
if (findcount > 0) then Drop(finditem, 0, 0, 0, 0);;
wait(100);
checksave;
until findcount = 0;
end;
procedure GotoXY(x,y,prec : integer; runflag : boolean);
var ld, ldc, dx, dy, mx, my, tmpdir : Integer;
begin
ld := 0; ldc := 0;
while true do
begin
waitconnection(3000);
DropOre;
DropMap;
dx := GetX(self) - x; if dx < 0 then dx := 0 - dx;
dy := GetY(self) - y; if dy < 0 then dy := 0 - dy;
if dy > dx then dx := dy;
if dx <= prec then exit;
mx := GetX(self); my := GetY(self);
dx := mx - x; if dx < 0 then dx := 0 - dx;
dy := my - y; if dy < 0 then dy := 0 - dy;
if dy > dx then dx := dy;
if dx <= prec then exit;
if ld = dx then begin
ldc := ldc + 1;
if ldc > 10 then
begin
tmpdir := Random(8);
DropOre;
Raw_Move(tmpdir,runflag);
DropOre;
Raw_Move(tmpdir,runflag);
DropOre;
Raw_Move(tmpdir,runflag);
end;
if ldc > 200 then begin addtosystemjournal( 'GotoXY: Cannot reach location!' ); { exit; } end;
end
else ld := dx;
waitconnection(5000);
if mx = x then begin
if my = y then exit;
// North
if my > y then begin Raw_Move(0,runflag); continue; end;
// South
DropOre;
Raw_Move(4,runflag); continue;
end;
if mx < x then begin
// Northeast
if my > y then begin DropOre; Raw_Move(1,runflag); continue; end;
// East
if my = y then begin DropOre; Raw_Move(2,runflag); continue;
end;
// Southeast
DropOre; Raw_Move(3,runflag); continue;
end;
// Southwest
if my < y then begin DropOre; Raw_Move(5,runflag); continue; end;
// West
if my = y then begin DropOre; Raw_Move(6,runflag); continue; end;
// Nortwest
DropOre; Raw_Move(7,runflag); continue;
end;
end;
Begin
List := TStringList.Create;
List.LoadFromFile('D:\Ultima Online\stealth\Scripts\min_minoc.txt');
for i := 0 to List.Count-1 do
begin
s:=List.strings[i]+' ';
MineDim[i].tt:=StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
MineDim[i].x:=StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
MineDim[i].y:=StrToInt(Copy(s,1,Pos(' ',s)-1));
Delete(s,1,Pos(' ',s));
end;
MaxPosL:=i;
while (connected) do
begin
For NTH := 0 to MaxPosL-1 do
begin
GotoXY(MineDim[NTH].x,MineDim[NTH].y,0,false);
if MineDim[NTH].tt <> 0 then MiningAround;
end;
end;
End.GotoXY: Cannot reach location!
При более старой версии при запуске скрипта пишет:
Exception: '' is not a valid integer value at 0.493
Помогите кто-то.
