YoHoJo
2012-01-10 02:44:53
{/----------------------------------------------------------------------\\
| .: [D]warven [R]esource. [D]ungeon [I]nsane [C]oal [K]ollector :. |
\\----------------------------------------------------------------------//
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~} {
//----------------------------------------------------------------------\\
| .:Version History:. |
| ☼1.00: |
| -Initial Release, Should Work :p, Feedback Appreciated |
\------------------------------------------------------------------------/}
Program DrDick;
{$DEFINE SMART}
{$i SRL\SRL.simba}
{$i SRL\SRL\Misc\Debug.simba}
Const
SRLStats_Username = ''; // Your SRL Stats Username
SRLStats_Password = ''; // Your SRL Stats Password
NumbOfPlayers= 1; //How many players are you using
StartPlayer= 0; //Player to start auoting with! (0 means first char)
LoadsPerLogin= 15; //How Many Loads To Do Per Login!
LoadsTotal= 9999; //How Many Total Lods To Do Per Character!
YDebug= False; //Leave Alone
Version= '1.00'; //NO TOUCHY!
{*******************************************************************************
procedure DeclarePlayers;
By: SRL
Description: SRL's Player Setup
*******************************************************************************}
procedure DeclarePlayers;
var i:integer;
begin
NumberOfPlayers(NumbOfPlayers);
CurrentPlayer := StartPlayer;
for i := 0 to NumbOfPlayers-1 do
Players[i].BoxRewards := ['mote', 'ostume', 'XP', 'Gem', 'ithril', 'oal', 'une', 'oins'];
with Players[0] do
begin
Name := ''; //Player username.
Pass := ''; //Player password.
Active := True;
Integers[2] := 10; //Seconds to try mining rock before clicking another.
end;
end;
Var TOres,TLoads,WeMined,StartTime:Integer;
Var SleepTime,SleepCounter,SleepMinutes,RT,LoginWait:Integer;
{*******************************************************************************
Procedure StatsGuise(wat:String);
By: YoHoJo
Description: Combination of Status & Diguise
*******************************************************************************}
Procedure StatsGuise(wat:String);
Begin
Status(wat);
Disguise(wat);
End;
Procedure FailSafe(Reason:String);
Begin
Players[CurrentPlayer].Loc:=Reason;
Logout;
Stats_Commit;
//ProgressReport;
LogOut;
Writeln(Reason);
End;
{*******************************************************************************
Function CheckAndClick(X,Y:Integer):Boolean;
By: YoHoJo
Description: Moves mouse to x,y, checks for uptext, and clikcs if found
*******************************************************************************}
Function CheckAndClick(UpText:String; X,Y:Integer; RClick:String):Boolean;
Begin
MMouse(x, y, 5, 5);
If WaitUptext(UpText, 1500+Random(500)) Then
Begin
Result:=True;
GetMousePos(x, y);
Case RClick Of
'R':
Begin
Mouse(x, y, 0, 0, False);
Result:= WaitOption('own', 2000);
If Result Then FFlag(0);
End;
'L':
Begin
Mouse(x, y, 0, 0,True);
Wait(100+Random(50));
FFlag(0);
End;
End;
End;
End;
{Flght made these two}
Function Mining: Boolean;
var
PBox: TBox;
begin
PBox := IntToBox(245, 130, 285, 195);
Result := (AveragePixelShift(PBox, 250, 500) > 260);
end;
Function GetShiftCount: Integer;
var
PBox: TBox;
begin
PBox := IntToBox(245, 130, 285, 195);
Result := AveragePixelShift(PBox, 250, 500);
end;
{hope you enjoyed your flight}
{*******************************************************************************
Function OreInLast:Boolean;
By: YoHoJo
Description: Checks if an ore/gem is in last inventory slot
*******************************************************************************}
Function OreInLast:Boolean;
Begin
{If ( GetColor(703, 458) And GetColor(702, 441) = 131072 ) Or
( GetColor(696, 436) And GetColor(708, 456) = 131072 ) Then}
If InvFull Then
Result:=True;
End;
{*******************************************************************************
Procedure Antiban;
By: YoHoJo/SRL
Description: Multiple antiban procedures from SRL
*******************************************************************************}
Procedure Antiban;
Begin
Case Random(350) Of
0: HoverSkill('Mining', False);
1: Begin PickUpMouse; SleepAndMoveMouse(5000 + Random(500)); End;
2: ExamineInv;
3: RandomAngle(1);
4: Begin GameTab(Tab_Stats); Wait(1500 + Random(500)); GameTab(Tab_Inv); End;
5: HoverSkill('random', False);
End;
End;
function AC(What:String): Integer;
var
arP: TPointArray;
arC, ACInfoI: TIntegerArray;
ACInfoE: TExtendedArray;
tmpCTS, i, arL: Integer;
begin
Case What of
'GreyFloor': Begin ACInfoI:=[7171430, 5]; ACInfoE:=[9.45, 0.39]; End;
'BrownFloor': Begin ACInfoI:=[5994118, 5]; ACInfoE:=[0.51, 0.72]; End;
End;
tmpCTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(ACInfoE[0], ACInfoE[1]);
FindColorsTolerance(arP, ACInfoI[0], MMX1, MMY1, MMX2, MMY2, ACInfoI[1])
arC := GetColors(arP);
ClearSameIntegers(arC);
arL := High(arC);
Writeln(IntToStr(Length(arC)));
for i := 0 to arL do
begin
Result := arC[i];
Break;
end;
ColorToleranceSpeed(tmpCTS);
SetColorSpeed2Modifiers(0.2, 0.2);
end;
Function ClickObject(WhatObject:String):Boolean;
var I:Integer;
ObjectInfoI: TIntegerArray;
ObjectInfoE: TExtendedArray;
ObjString, Click: String;
GatePts:TPointArray;
GatePtsBox: T2DPointArray;
GatePt: TPoint;
HighGate, Pixels:Integer;
Begin
Case WhatObject of
{ObjectInfoI[Color, Tolerance, BoxX, BoxY, Xmov, Ymov, SortX, SortY]}
'DBox':
Begin
StatsGuise('Clicking Deposit Box');
ObjString:= 'Bank';
ObjectInfoE:=[0.15 , 0.58];
ObjectInfoI:=[6653850, 3, 20, 20, 0, 0, MSX2, MSY1];
Pixels:= 120;
Click:= 'L';
End;
{'DungeonDown':
Begin
StatsGuise('Trying To Go Down Broken Stairs');
ObjString:='ung';
ObjectInfoE:=[1.12 , 0.43];
ObjectInfoI:=[2237477, 10, 25, 25, 5, 0, MSCX, MSCY];
Pixels:= 400;
RiCli:= False;
End;}
End;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(ObjectInfoE[0] , ObjectInfoE[1]);
FindColorsSpiralTolerance(MSCX,MSCY,GatePts,ObjectInfoI[0],MSX1,MSY1,MSX2,MSY2,ObjectInfoI[1]);
SetColorSpeed2Modifiers(0.2,0.2);
ColorToleranceSpeed(1);
GatePtsBox:= TPAtoATPAEx(GatePts,ObjectInfoI[2],ObjectInfoI[3]);
//DebugATPA(GatePtsBox,'');
SortATPAFrom(GatePtsBox,Point(ObjectInfoI[6],ObjectInfoI[7]));
HighGate:=High(GatePtsBox);
For I:=0 To HighGate Do
Begin
If Not(LoggedIn) Then Break;
If GetArrayLength(GatePtsBox[I])>Pixels Then
Begin
GatePt:= MiddleTPA(GatePtsBox[I]);
//If GatePt.Y > 120 Then Continue;
If CheckAndClick( ObjString, GatePt.x + (ObjectInfoI[4]),GatePt.y + (ObjectInfoI[5]), Click) Then
Begin
Result:=True;
Break;
End Else
Continue;
End;
End;
End;
function Walking(Color, Tolerance, dX, dY: Integer; SortFrom: tpoint): Boolean;
var
i, x, y, rx, ry: Integer;
TPA: TPointArray;
begin
if not LoggedIn then Exit;
FindNormalRandoms;
FindColorsSpiralTolerance(MMCX, MMCY, TPA, Color, MMX1, MMY1, MMX2, MMY2, Tolerance);
//Writeln(IntToStr(Length(TPA)));
SortTPAFrom(TPA, SortFrom);
for i := 0 to High(TPA) do
begin
x := TPA[i].x;
y := TPA[i].y;
rx := RandomRange(-6, 6);
ry := RandomRange(-6, 6);
if (not rs_OnMinimap(x + rx, y + ry)) then
Continue;
Mouse(x + rx + dX, y + ry + dY, 0, 0, true);
FFlag(0);
Wait(200 + Random(500));
Result := True;
Break;
end;
end;
Procedure WalkToDBox;
//Var
///I, X, Y: Integer;
Begin
StatsGuise('Walking To DBox');
Walking(AC('BrownFloor'), 20, 0, 0,Point(MMX1, MMCY));
Wait(2000);
FFlag(2);
Walking(AC('GreyFloor'), 15, 0, 0,Point(MMX1, MMY1));
FFlag(2);
{If RadialWalkEx(WalkTPA, AC('BrownFloor'),230, 320, 65, -1, 0, 15) Then
Begin
For I:=0 To High(WalkTPA) Do
Begin
If MouseFlagEx(X, Y, 2, 2, -1, -1, 2, True, False) Then
Break;
End;
End;
If RadialWalkEx(WalkTPA, AC('BrownFloor'),340, 270, 30, -1, 0, 15) Then
Begin
For I:=0 To High(WalkTPA) Do
Begin
If MouseFlagEx(X, Y, 2, 2, -1, -1, 2, True, False) Then
Break;
End;
End; }
Repeat
Wait(100)
Until (Not(IsMoving))
StatsGuise('Reached DBox');
End;
Procedure WalkToRocks;
Begin
Walking(AC('BrownFloor'), 20, 0, 0,Point(MMX2, MMCY));
Wait(2000);
FFlag(2);
Case Random(2) Of
0:
Begin
Mouse(660, 45, 5, 5, True);
Wait(500+Random(100));
Flag;
End;
1:
Begin
Mouse(674, 129, 5, 5, True);
Wait(500+Random(100));
Flag;
End;
End;
End;
Procedure DepositOres;
Begin
If Not ClickObject('DBox') Then
Begin
Walking(AC('GreyFloor'), 15, 0, 0,Point(MMX1, MMY1));
FFlag(2);
End;
ClickObject('DBox');
FFlag(0);
If WaitColor(370, 39, 0, 0, 5000) Then
Mouse(312, 278, 10, 10, True)
Else
FailSafe('Deposit Box');
End;
Procedure DepositAndBank;
Begin
WalkToDBox;
DepositOres;
WalkToRocks;
End;
type
Custom = record
Bool: boolean;
Int: Integer;
end;
{*******************************************************************************
Function MineRock(WutRock:Integer):Boolean;
By: YoHoJo
Description: Mines rock, uses ATPAs, waits until ore recieved or timer reached
*******************************************************************************}
Function MineRock(WutRock:Integer):Custom;
var I,PlusOne,tMine,J:Integer;
OrePts, RockPts:TPointArray;
RockPtsBox, BingoBox: T2DPointArray;
BingoPt: TPoint;
SearchBox: TBox;
Begin
If Not(LoggedIn) Then Exit;
J:=0;
StatsGuise('Searching For Rock: '+ IntToStr(InvCount));
If OreInLast Then Exit;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.04, 1.27);
FindColorsSpiralTolerance(MSCX, MSCY, RockPts, 1461093, MSX1, MSY1, MSX2, MSY2, 10);
SetColorSpeed2Modifiers(0.2,0.2);
ColorToleranceSpeed(1);
RockPtsBox:=TPAtoATPAEx(RockPts,35,35);
{DebugATPABounds(RockPtsBox);
Writeln('This is RockPtsBox');}
//Writeln('RockPts ' + IntToStr (GetArrayLength(RockPts) ) );
For I:=0 To High(RockPtsBox) Do
Begin
If Not(LoggedIn) Then Break;
//Writeln('Searching Box ' +IntToStr (i));
SearchBox:= GetTPABounds(RockPtsBox[i]);
//Writeln( IntToStr(SearchBox.x1) + ',' + IntToStr(SearchBox.y1)+ ',' + IntToStr(SearchBox.x2)+ ',' + IntToStr(SearchBox.y2) );
If (GetArrayLength(RockPtsBox[I]) > 30) Then
Begin
If YDebug Then DebugATPA(RockPtsBox,'');
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(1.39,0.11);
FindColorsSpiralTolerance(MSCX,MSCY,OrePts,2434854,SearchBox.x1,SearchBox.y1,SearchBox.x2,SearchBox.y2,10);
//Writeln('OrePts ' + IntToStr (GetArrayLength(OrePts) ) );
SetColorSpeed2Modifiers(0.2,0.2);
ColorToleranceSpeed(1);
If High(OrePts) > 1 Then
Begin
BingoBox:=TPAtoATPAEx(OrePts, 10, 10);
For I:=0 To High(BingoBox) Do
Begin
//DebugTPA(OrePts,'');
//Writeln('This is BingoBox');
If GetArrayLength(BingoBox[I])>4 Then
Begin
BingoPt:= MiddleTPA(BingoBox[I]);
If CheckAndClick('ine', BingoPt.x,BingoPt.y, 'L') Then
Begin
Result.Bool:=True;
MarkTime(tMine);
StatsGuise('Mining Rock: '+ IntToStr(InvCount));
Players[CurrentPlayer].Loc:='Mining';
PlusOne:=InvCount+1;
Repeat
If Not(LoggedIn) Then Break;
Antiban;
LevelUp;
Wait(500);
RT:=GetSystemTime;
If FindNormalRandoms Then
IncEx(WeMined,GetSystemTime - RT);
If Random(50)=1 Then SleepAndMoveMouse(500+Random(100));
//If (Not(IsMoving)) Then Begin Writeln('a'); Break; End;
If InvCount=PlusOne Then
Begin
Inc(J);
TOres:=TOres + J;
Inc(Players[CurrentPlayer].Integers[81]);
End;
Until (InvCount = PlusOne) Or Not Mining Or (TimeFromMark(tMine) > ((Players[CurrentPlayer].Integers[2]*1000) + Random(500)));
Exit;
End;
End;
End;
End Else Continue;
End;
Wait(750+Random(250));
End;
End;
{*******************************************************************************
Procedure ProgXP;
By: YoHoJo
Description: Calculates player's XP for progress reprot
*******************************************************************************}
Procedure ProgXP;
var
I:Integer;
Begin
For I:=0 to HowManyPlayers -1 Do
Players[i].Extendeds[1]:=50;
End;
Procedure StatsCommit;
Var
OreMid{X, Y}:Integer;
HowMany, CoalInteger:Integer;
Begin
OreMid := DTMFromString('78DA63CC626260E0606440054C601226CA584' +
'C849A3C209F8F809A6C209F19BF1A00AD2101F4');
HowMany:=CountItemsIn('inv', 'DTM', OreMid, []);
//WriteLn('Coal Count:'+IntToStr(HowMany));
stats_IncVariable('Coal Ore (Mined)', HowMany );
stats_IncVariable('Mining EXP (Gained)', (HowMany) * 50);
stats_IncVariable('Loads Done', 1);
Inc(TLoads);
Inc(Players[CurrentPlayer].Integers[82]);
FreeDTM(OreMid)
End;
{*******************************************************************************
Procedure BasicSetup;
By: YoHoJo Mainly:Tarajunky/Dankness
Description: Mini progress reprot for each individual player
*******************************************************************************}
procedure PlayerStats;
var Active: string;
i: Integer;
begin
Writeln ('<~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~>');
Writeln('# : Nick = A : Level Worked Mined Loads XP Location');
for i := 0 to HowManyPlayers - 1 do
begin
if (Players[i].Active) then Active:='T' else Active:='F';
Writeln(Padr(Inttostr(I),2) + ': ' + Padr(Players[i].Nick,4) + ' = ' + Padr(Active,5)
+''+Padr(inttostr(Players[i].level[15]),5)+''
+''+Padr(MsToTime(Players[i].Worked,Time_Bare),11)+''
+''+Padr(IntToStr(Players[i].integers[80]),7)+''
+''+Padr(IntToStr(Players[i].integers[81]),6)+''
+''+Padr(FloatToStr((Players[i].integers[80])*(Players[i].Extendeds[1])),6)+''
+'L:'+Players[i].Loc);
end;
Writeln ('<~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~>');
end;
{*******************************************************************************
procedure ProgressReport;
By: YoHoJo Mainly:Tarajunky/Dankness
Description: Overall progress/randoms reprot
*******************************************************************************}
procedure ProgressReport;
var Sec,Orerate,LoadRate:integer;
begin
SRLRandomsReport;
Stats_Commit;
Sec:= (1+((Getsystemtime-StartTime)/1000));
OreRate:=(3600*(TOres))/(Sec);
LoadRate:=(3600*(TLoads))/(Sec);
Writeln('[REPORT]');
Writeln ('8=======================================D');
Writeln ('| --> Dr. Dick '+Version+' <-- |');
Writeln ('8=======================================D');
Writeln('|' + PadR( ('Worked for '+ TimeRunning), 39) + '|');
Writeln('|' + PadR( ('Mined '+IntToStr(TOres)+' ores at a rate of '+IntToStr(OreRate)+' per hour'), 39) + '|');
Writeln('|' + PadR( ('Mined '+IntToStr(TLoads)+' loads at a rate of '+IntToStr(LoadRate)+' per hour'), 39) + '|');
Writeln ('8=======================================D');
Writeln('[/REPORT]');
// PlayerStats;
end;
{*******************************************************************************
Function OverAnd:Boolean;
By: YoHoJo
Description: Checks if its time to switch players based on loads mined
*******************************************************************************}
Function OverAnd:Boolean;
Begin
If (not(Players[CurrentPlayer].Integers[82]=0)) Then
If (Players[CurrentPlayer].Integers[82] Mod LoadsPerLogin)=0 Then
Result:=True;
End;
Begin
SMART_Server:=35;
SMART_Signed:=True;
SMART_Members:=False;
SetupSRL;
if (SRLStats_Username = '') then
SetupSRLStats(331, 'Anonymous', 'anon1337')
else
SetupSRLStats(331, SRLStats_Username, SRLStats_Password);
MouseSpeed:=30;
StartTime:=GetSystemTime;
DeclarePlayers;
ProgXP;
Repeat
LoginPlayer; if (SRL_Logs < 1) then SRL_Logs := 1;
Players[CurrentPlayer].Integers[82]:=0; //Temp Loads
//Players[CurrentPlayer].Level[14]:=GetSkillLevel(14);
//StatsGuise(Players[CurrentPlayer].Nick + ' Mining Lv ' +IntToStr(Players[CurrentPlayer].Level[15]));
SetRun(True);
SetAngle(SRL_ANGLE_HIGH);
MarkTime(WeMined);
Repeat
If Not(LoggedIn) Then Break;
If MineRock(Players[CurrentPlayer].Integers[1]).Bool=True Then MarkTime(WeMined);
RT:=GetSystemTime;
If FindNormalRandoms Then
IncEx(WeMined,GetSystemTime - RT);
If (TimeFromMark(WeMined) > 90000) Then
Begin
SaveScreenShot(TheDate(1) + ' ' + Replace(TheTime, ':', '_') + '.bmp');
Players[CurrentPlayer].Loc:='Cant Find Rock :(';
StatsGuise('NP:Cnt.Fnd.Rock');
PlayerCurTime := GetSystemTime;
Players[CurrentPlayer].Worked := Players[CurrentPlayer].Worked + (PlayerCurTime - PlayerStartTime);
Logout;
Break;
End;
If OreInLast Then Begin MarkTime(WeMined);StatsCommit; DepositAndBank; ProgressReport; End;
If (Players[CurrentPlayer].Integers[81] = LoadsTotal) Then
Begin
Players[CurrentPlayer].Loc:='Finished Loads!';
StatsGuise('NP:Fin.All.Load');
PlayerCurTime := GetSystemTime;
Players[CurrentPlayer].Worked := Players[CurrentPlayer].Worked + (PlayerCurTime - PlayerStartTime);
Logout;
Break;
End;
Until (OverAnd);
Players[CurrentPlayer].Active := LoggedIn;
PlayerCurTime := GetSystemTime;
Players[CurrentPlayer].Worked := Players[CurrentPlayer].Worked + (PlayerCurTime - PlayerStartTime);
Logout;
StatsGuise('NP:NextPlayer');
ProgressReport;
If AllPlayersInactive Then
Begin
PlayerCurTime := GetSystemTime;
Players[CurrentPlayer].Worked := Players[CurrentPlayer].Worked + (PlayerCurTime - PlayerStartTime);
LogOut;
StatsGuise('All Players Inactive');
TerminateScript;
End;
Currentplayer:=NextPlayerIndex;
MarkTime(LoginWait);
While Not(RsReady) Do
Begin
Wait(1000);
If TimeFromMark(LoginWait)>30000 Then Break
End;
Until(False);
End.Getting
Exception in Script: Access violation