НЕ УСТАЕТ. НЕ СПОТЫКАЕТСЯ.
Если не хотите разбираться с тем как он делает кирки просто следите чтобы у него всегда было в сумке с криками 10 и более кирок. тогда он не будет их делать, а будет просто брать готовые. Ну хз чо еще написать . короче бот работает пока даю берите.
проверял на рануо.
АХ ДА ОН КОПАЕТ СКАЛЫ ВОКРУГ!!!!! А НЕ В ШАХТЕ!!!!!!!!
Code: Select all
program mining ;//
//Made by Shinma
//TheAbyss
//
{$Include 'all.inc'}
const
PickType = $0E86 ;
PickType2 = $0E85;
sunduk = $400CFB79 ;//сундук в который складываем добычу и берем кирки.
bagpickaxe = $40212447 ;//сумка в сундуке из которой берем кирки для копания
bagjuvelir=$4009E379 ;//Сумка в сундуке в которую складываем камни ювелира
BugOre=$401149FC ;//Сумка в сундуке в которую складываем руду
IDBoxIngot=$400CFB9E ; //ID сумки где лежат инготы и тинкер тулсы
TinkerTool=$1EB8 ;
ingot=$1BF2 ;
tong=$0FBB ;
//возле сундука X,Y
VozleX = 111;
VozleY = 222;
Точка с которой начать обход скалы
MineX= 333;
MineY= 444;
zapasW=50; //макс вес - zapasW = вес при котором будет капать-не используется в скрипте
var
MinTile:array of word;
i,j,h:word;
start_p: TFoundTile;
ctime : TDateTime;
checkW,Xmin,Xmax,Ymin,Ymax : Integer;
kol_mine:word;
sum:word;
agump:word;
arr_sum:word;
rs:word;
tfta:TFoundTilesArray;
k:word;
temp:TFoundTilesArray;
res_arr:TFoundTilesArray;
color: array of word;
DropOreType: array of word;
DropJuvType: array of word;
procedure init;
begin
Xmin := getx(self)-50;//////////////////////<<<<<<<<<<<<<<<<< Вот тут указываем расстояние +/- Х,У ,
Xmax := getx(self)+50;/////////////////////<<<<<<<<<<<<<<<<< точки с которой начинаете обход скалы
Ymin := gety(self)-50;///////////////////////,<<<<<<<<<<<<<<< Сколько добавите по такой площади он и будет ходить
Ymax := gety(self)+50;///////////////////////<<<<<<<<<<<<<<<
MinTile :=[561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579];
color:=[$0000,$0966,$096D,$08A5,$0973,$0972,$0979,$089F,$08AB];
DropOreType:=[$19B9,$1779];//руда, скала
DropJuvType:=[$3193,$3197,$3198,$0F2D,$0F15,$3195,$0F13,$0F26,$0F10,$3194,$0F25 ,$0F21,$0F19,$0F16,$3192 ];
end;
procedure GotoOnHome;
begin
//h:=0;
//while ((GetX(self)<>vozleX) and (GetY(self) <> vozleY))and (Not dead)and (h<5) do
// begin
checklag(60000);
// AddToSystemJournal('175 иду домой');
NewMoveXY(vozleX,vozleY, True, 0, True);
// h:=h+1
//end;
end;
Procedure CheckItem; //Проверка инготов, тинкер тулс,тонгс.
begin
///////////////
// Check Ingot
///////////////
checklag(50000);
FindType(ingot,backpack);
while FindFullQuantity <50 do
begin
If IDBoxIngot = 0 then
begin
AddToSystemJournal('Инги кончились');
repeat
wait(1000);
FindType(ingot,backpack);
until (FindFullQuantity > 50) or dead;
end
else
begin
checklag(50000);
UseObject(IDBoxIngot);
wait(2000);
FindType(ingot,IDBoxIngot);
if FindFullQuantity > 50 then
begin
checklag(50000);
AddToSystemJournal('кол-во ингов= '+Inttostr(FindFullQuantity));
MoveItem(Finditem,1000,backpack,0,0,0);
end
else
begin
AddToSystemJournal('Инги кончились');
repeat
wait(10000);
checklag(50000);
UseObject(IDBoxIngot);
wait(2000);
FindType(ingot,IDBoxIngot);
until dead or (FindFullQuantity > 50);
end;
end;
end;
//////////////////
// Check TinkerTools
/////////////////
checklag(50000);
while count(TinkerTool) <1 do
begin
checklag(50000);
UseObject(IDBoxIngot);
wait(2000);
FindType(TinkerTool,IDBoxIngot);
//grab(TinkerTool,1);
MoveItem(Finditem,1,backpack,0,0,0);
end;
checklag(50000);
UseObject(IDBoxIngot);
wait(2000)
FindType(TinkerTool,IDBoxIngot);
while finditem <2 do
begin
for i:=0 to GetGumpsCount do
begin
wait(500);
CloseSimpleGump(i);
end;
agump := GetGumpsCount;
checklag(50000);
UseObject(FindType(TinkerTool,Backpack));
wait(1000);
while agump = GetGumpsCount do
Wait(60);
NumGumpButton(GetGumpsCount-1,9002);
wait(600);
NumGumpButton(GetGumpsCount-1,11);
AddToSystemJournal('Скрафтил тинкер тул');
wait(5000);
MoveItems(backpack, TinkerTool, $FFFF, IDBoxIngot, 0,0,0, 700);
FindType(TinkerTool,IDBoxIngot);
end;
for i:=0 to GetGumpsCount do
begin
wait(500);
CloseSimpleGump(i);
end;
end;
procedure PickAxeInBug;
begin
if not dead and (count(TinkerTool)>0) then
begin
NewMoveXY( 869,1244,true,0,true);
checklag(60000);
useobject(IDBoxIngot);
wait(1000);
while not dead and (count(TinkerTool)>0) do
begin
checklag(60000);
FindType(TinkerTool,BackPack);
MoveItem(Finditem,0,IDBoxIngot,0,0,0);
wait(600);
AddToSystemJournal('1');
end;
end;
if not dead and (count(ingot)>0) then
begin
NewMoveXY( 869,1244,true,0,true);
checklag(60000);
useobject(IDBoxIngot);
wait(1000);
while not dead and (count(ingot)>0) do
begin
NewMoveXY( 869,1244,true,0,true);
FindType(ingot,BackPack);
checklag(60000);
MoveItem(Finditem,0,IDBoxIngot,0,0,0);
wait(600);
AddToSystemJournal('2');
end;
end;
if not dead and (count(PickType)>10) then
begin
NewMoveXY( 869,1244,true,0,true);
checklag(60000);
useobject(sunduk);
wait(1000);
while not dead and (count(PickType)>10) do
begin
FindType(PickType,BackPack);
MoveItem(Finditem,1,bagpickaxe,0,0,0);
wait(600);
AddToSystemJournal('3');
end;
end;
end;
procedure CreapePick;
begin
while (count(TinkerTool)>0) and not dead and (count(PickType)<60) do
begin
for i:=0 to GetGumpsCount do
begin
wait(500);
CloseSimpleGump(i);
end;
agump := GetGumpsCount;
checklag(50000);
UseObject(FindType(TinkerTool,Backpack));
wait(1000);
while agump = GetGumpsCount do
Wait(60);
NumGumpButton(GetGumpsCount-1,9002);
wait(600);
NumGumpButton(GetGumpsCount-1,24);
AddToSystemJournal('Создаю PickAxe');
wait(1000);
checkW:=0;
while not dead and connected and IsObjectExists(FindItem) and (count(ingot)>50) and (count(PickType)<10) do
begin
checklag(50000);
WaitGump('1999');
Wait(700);
checkW:=checkW+1;
if checkW = 20 then
begin
UseObject(FindType(TinkerTool,Backpack));
checkW:=0;
end;
end;
end;
end;
Procedure GiveMePick;
var
agump:Word;
begin
//////////////////////////////////////////////////////////////
///////////Набираем кирки для копания, если они кончаются
///////////////////////////////////////////
//AddToSystemJournal('Набираем кирки');
if count(PickType) < 3 then
begin
GotoOnHome;
finddistance := 2;
checklag(60000);
useobject(sunduk);
wait(1000);
checklag(60000);
useobject(bagpickaxe);
wait(1000);
while count(PickType)<10 do
begin
checklag(60000);
FindType(PickType,bagpickaxe);
Grab(FindItem, 1);
wait(900);
if FindCount<2 then
begin
////////////////////////////////////////
CheckItem;
CreapePick;
PickAxeInBug;
end;
end;
end;
end;
procedure DropOre;
var g,hh : integer;
oreid,oresundukid: Cardinal;
Begin
finddistance := 2;
///////////////////////////////////
/////Выгружаем руду
//////////////////////////////
//AddToSystemJournal('Выгружаем руду');
for hh := 0 to (GetArrayLength(DropOreType)-1) do
for g := 0 to (GetArrayLength(color)-1) do
begin
checklag(60000);
FindTypeEx(DropOreType[hh],color[g],backpack,false);
if FindCount > 0 then
begin
checklag(60000);
useobject(sunduk);
wait(1000);
checklag(60000);
useobject(BugOre);
wait(1000);
h:=0;
oreid:=FindItem ;
repeat
checklag(60000);
// AddToSystemJournal('196');
oresundukid:=FindTypeEx(DropOreType[hh],color[g],BugOre,false);
if (FindQuantity = 0) or (FindQuantity > 59000) then
MoveItem(oreid,0,BugOre,0,0,0)
else
MoveItem(oreid,0,oresundukid,0,0,0);
wait (900);
h:=h+1;
FindTypeEx(DropOreType[hh],color[g],backpack,false);
until (FindCount = 0) or dead or(h>30);
end;
end;
//////////////////////////////////////////////////////
///////Выгружаем камни
///////////////////////////////////
//AddToSystemJournal('Выгружаем камни');
for hh := 0 to (GetArrayLength(DropJuvType)-1) do
begin
checklag(60000);
FindTypeEx(DropJuvType[hh],$FFFF,backpack,false);
if FindCount > 0 then
begin
checklag(60000);
useobject(sunduk);
wait(1000);
checklag(60000);
useobject(bagjuvelir);
wait(1000);
h:=0;
oreid:=FindItem ;
repeat
checklag(60000);
// AddToSystemJournal('196');
oresundukid:=FindTypeEx(DropJuvType[hh],$FFFF,bagjuvelir,false);
if FindCount = 0 then
MoveItem(oreid,0,bagjuvelir,0,0,0)
else
MoveItem(oreid,0,oresundukid,0,0,0);
wait (900);
h:=h+1;
FindTypeEx(DropJuvType[hh],$FFFF,backpack,false);
until (FindCount = 0) or dead or(h>30);
end;
end;
GiveMePick;
End;
procedure gotoshahta;
begin
// AddToSystemJournal('gotoshahta');
//checksave;
checklag(60000);
NewMoveXY(MineX,MineY, false, 0, True);
end;
procedure checkweight;
begin
if (Weight>=(MaxWeight-zapasW))and(not dead) then
begin
GotoOnHome;
DropOre;
gotoshahta;
end;
end;
function sqr(a:LongInt):LongInt;
begin
result:=a*a;
end;
function vector_length(c_1,c_2:TFoundTile):LongInt;
begin
result:=Round(sqrt(sqr(c_1.X-c_2.X)+sqr(c_1.Y-c_2.Y)));
end;
procedure QuickSort(var item:TFoundTilesArray; count:integer; point:TFoundTile);
var
temp_index,temp_value, tempo,i,j:LongInt;
t_c:TFoundTile;
begin
kol_mine:=count;
// AddToSystemJournal('60 сортируем массив '+IntToStr(count)+' ');
t_c:=point;
temp_index:=0;
temp_value:=vector_length(t_c,item[temp_index]);
for i:=0 to count-2 do
begin
for j:=i to count-1 do
begin
tempo:=vector_length(t_c,item[j]);
if tempo<temp_value then
begin
temp_index:=j;
temp_value:=tempo;
end;
end;
t_c:=item[temp_index];
item[temp_index]:=item[i];
item[i]:=t_c;
temp_value:=vector_length(item[i],item[i+1]);
end;
i:=0;
end;
procedure cancel;
begin
CloseMenu;
CancelMenu;
If TargetPresent Then CancelTarget;
end;
procedure poisk_ore;
begin
SetArStatus(true);
init;
sum:=0;
arr_sum:=0;
rs:=0;
j:=0 ;
for i:=0 to (GetArrayLength(MinTile)-1) do
begin
//rs:=GetStaticTilesArray(Xmin,Ymin,Xmax,Ymax,WorldNum,MinTile[i],tfta);
//rs:=GetStaticTileData (Xmin,Ymin,Xmax,Ymax,WorldNum,MinTile[i],tfta);
rs:=GetLandTilesArray (Xmin,Ymin,Xmax,Ymax,WorldNum,MinTile[i],tfta);
if rs>0 then
for k:=0 to rs-1 do temp[arr_sum+k]:=tfta[k];
arr_sum:=arr_sum+rs;
end;
//AddToSystemJournal('arr_sum = '+inttostr(arr_sum));
QuickSort(temp,arr_sum,start_p);
//AddToSystemJournal('QuickSort 2');
for k:=0 to arr_sum-1 do
res_arr[sum+k]:=temp[k];
sum:=sum+arr_sum;
//AddToSystemJournal('exit');
if arr_sum<=0 then
begin
AddToSystemJournal('Object not found');
wait(360000);
end;
// end;
end;
procedure Wait_Target(time_ms:Cardinal);
var
TempTime,SumTime:Cardinal;
begin
SumTime:=0;
repeat
checklag(60000);
wait(500);
TempTime:=Timer;
SumTime:=SumTime+(Timer-TempTime);
until ((targetpresent) or (dead) or (not connected) or (SumTime>time_ms));
end;
procedure kirka;
begin
if (count(PickType)>0) and (Weight<=(MaxWeight-zapasW)) then
usetype(PickType,$FFFF);
end;
Procedure DoitBaby(f_tile:TFoundTile);
begin
h:=0;
repeat
cancel;
// AddToSystemJournal('Me X='+inttostr(GetX(self))+' Y= '+inttostr(GetY(self))+ ' Z= '+inttostr(GetZ(self)));
//AddToSystemJournal('target X='+inttostr(f_tile.X)+' Y= '+inttostr(f_tile.Y)+' Z= '+inttostr(f_tile.Z)) ;
WaitTargetXYZ (f_tile.X,f_tile.Y,f_tile.Z);
kirka;
ctime := Now;
repeat
//AddToSystemJournal('338');
wait(2000);
//check_war;
h:=h+1;
// AddToSystemJournal('352 h = '+inttostr(h));
until (InJournalBetweenTimes('You can''t mine that|no metal|in your backpack|Target cannot be seen|There is nothing|You loosen|no line of sight|You cannot mine so close to yourself|Targeting cancelled|That is too far away', ctime, Now)>= 0)or dead or (h>20);
until (InJournalBetweenTimes('You can''t mine that|no metal|Target cannot be seen|There is nothing here to mine|no line of sight|You cannot mine so close to yourself|Targeting cancelled|That is too far away', ctime, Now)>= 0)or dead or (h>20) or (Weight>=(MaxWeight-zapasW));
//CharDead;
end;
procedure Unicode_Speech(text,SenderName : String; SenderID : Cardinal);
begin
// AddToSystemJournal('Event! Unicode Speech: SenderID = $'+ IntToHex(SenderID,8) + ' ; SenderName = ' + SenderName + '; SenderText : ' + text);
if text='The world will save in 5 seconds.' then
begin
wait(15000);
end;
end;
///////////////////////////////////////////
BEGIN
AddToSystemJournal('BEGIN');
SetPauseScriptOnDisconnectStatus(True);
SetARStatus(True);
PickAxeInBug;
GiveMePick;
checkweight;
SetEventProc(evUnicodeSpeech,'Unicode_Speech');
//SetEventProc(evSpeech,'Unicode_Speech');
gotoshahta;
while not dead do
begin
//AddToSystemJournal('poisk_ore');
poisk_ore;
//AddToSystemJournal('poisk_ore_exit');
j:=sum-1;
i:=0;
while (i<j)and(Not Dead) do
begin;
ClearBadLocationList;
//AddToSystemJournal('372 I ==== '+inttostr(i));
if i< kol_mine then
begin
// Addtosystemjournal('376');
while (res_arr[i].X=0)and(res_arr[i].Y=0)do
i:=i+1;
checkweight;
NewMoveXY(res_arr[i].X,res_arr[i].Y,true,1,false);
// Addtosystemjournal('379');
DoitBaby(res_arr[i]);
// Addtosystemjournal('385');
i:=i+3;
// AddToSystemJournal('387 I === '+inttostr(i));
end;
if i>=kol_mine then
begin
i:=0;
while (res_arr[i].X=0)and(res_arr[i].Y=0)do
i:=i+1;
checkweight;
NewMoveXY(res_arr[i].X,res_arr[i].Y,true,1,false);
DoitBaby(res_arr[i]);
i:=i+3;
AddToSystemJournal('Начинаем все с начало i:= '+inttostr(i));
end;
// AddToSystemJournal('403 I === '+inttostr(i));
checkweight;
end;
end;
END.