Буду очень признателен....
ЗЫ: сам скрипт рабочий,ходит по указанным тайлам в файле,копает,скидывает мапы и ненужную руду по цвету....
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, mf3, ms1 : Integer;
ctime : TDateTime;
List : TStringList;
NTH : Integer;
Color : array[1..12] of cardinal;
s: string;
const
Pickaxe1 = $0E85; // Oeiu ee?ie
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(1343, 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);
mf3 := InJournalBetweenTimes('mine', ctime, Now);
ms1 := InJournalBetweenTimes('way', ctime, Now);
until (mn1<>-1) or (mf1<>-1) or (mf2<>-1) or (mf3<>-1) or (ms1<>-1) or (k > 300);
until (mn1<>-1);
end;
end;
End;
procedure DropOre;
begin
//Color[1] := $0001;// iron
//Color[2] := $0602;//coper
//Color[3] := $0455;//black draft
//Color[4] := $;//silver
//Color[5] := $;// pagan
//Color[6] := $;// spectral
//Color[7] := $;//ice
//Color[8] := $;//lava
//Color[9] := $;//mythril
//Color[10] := $;//basilik
//Color[11] := $;//dedra
//Color[12] := $;//sun
for c:=1 to 1 do
begin
//Addtosystemjournal('Aua?anuaa? ?oaoi');
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('Aua?anuaa? ea?ou');
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:\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.
for script work you need place in D:\ a file called min_minoc.txt with positions of places to mining, if you dont know how you take positions say ,infotile and click in floor.
this script drop any ore you want, for script not drop ore change the line:
for c:=1 to 1 do
begin
//Addtosystemjournal('Aua?anuaa? ?oaoi');
FindTypeEx($19B9,Color[c],backpack,False);
if (FindCount>0) then
begin
MoveItem(FindItem,0,ground,0,0,0);
wait(200);
checksave;
end;
end;
end;
to if (FindCount<0) then
cпасибо 
