Stealth Client Forum

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

Code: Select all

const
Dager = $00000000//суда ID дагера
...
procedure ArmsLore;
begin
  CancelTarget; //на всякий случай уберем таргет
  UseSkill('Arms Lore'); //используем скилл
  ChekLag(15000); //проверка на лаг
  WaitForTarget(500); //ждем таргет половину секунды
  if TargetPresent then //если таргет появился
  begin
    TargetToObject(Dager); //таргет на дагер
    Wait(3500); //ждем пока отработает Arms Lore
  end;
end;

Code: Select all

{$Include 'all.inc'}

Code: Select all

program MiningAround;
var
ctime : TDateTime;
x, y, k, mn1, mf1, mf2, mf3, ms1 : Integer;
	Begin
		for x := -2 to 2 do
			begin
				for y := -2 to 2 do
					begin
						repeat							
							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.

Code: Select all

program MiningAround;
var
ctime : TDateTime;
x, y, k, mn1, mf1, mf2, mf3, ms1 : Integer;
   Begin
      for x := -2 to 2 do
         begin
            for y := -2 to 2 do
               begin
                  repeat                     
                     if TargetPresent then CancelTarget;
                     if WarMode = true then SetWarMode(false);
                     ctime := Now;
                     UseObject(ObjAtLayerEx(RhandLayer,self));
                     WaitForTarget(5000);
                     If TargetPresent then TargetToTile(0, GetX(self)+x, GetY(self)+y, GetZ(self)); // поменял на 0 так как тайлы разные в шахе (сейчас копает все)
                     k := 0;
                     repeat
                        wait(100);
                        k := k + 1;
                        //checksave;
                        mn1 := InJournalBetweenTimes('Здесь больше нет руды', ctime, Now);
                        mf1 := InJournalBetweenTimes('Вы не можете добывать здесь', ctime, Now);
                        mf2 := InJournalBetweenTimes('Вы не видите это место', ctime, Now);
                        mf3 := InJournalBetweenTimes('Вы поранились киркой', ctime, Now);
                        ms1 := InJournalBetweenTimes('Вы добыли', 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.

Code: Select all

      for x := -2 to 2 do
         begin
            for y := -2 to 2 do
               begin
                  repeat        

Code: Select all

      for x := -2 to 2 do
            for y := -2 to 2 do
                  repeat   

Code: Select all

List.LoadFromFile('D:\min_minoc.txt');