// --> // --> Name: Ultra Miner // --> Version: 0.5_133 // --> Author: BadAhr // --> Email: badahr@gmail.com // --> Date: 17/11/05 // ***************************************************************************** // ---------------------- IMPORTANT - READ ME - IMPORTANT ---------------------- // ***************************************************************************** // --> 1) Face a Wall in a Cave! Tilt the angle you mine! // --> 2) Only eats Steak!! Expand it! // --> 3) Open Invetory, Sort so Water is ABOVE Steak // --> 4) Start with FULL food + water // --> 4) IMPORTANT: SEE CONFIG AREA! Go to line 66 to set them // --> 5) Start the script, then leave the computer // ***************************************************************************** // ---------------------- IMPORTANT - READ ME - IMPORTANT ---------------------- // ***************************************************************************** // --> If you enjoy my scripts, please support me by // --> donating. I can be contacted by email. // --> // --> Special Thanks to those that have supported me. You know // --> who you are. // --> // --> Known BUGS!: Please READ the Revision History! // --> // --> Email: // --> All emails directed to me should be in ENGLISH. That means // --> spelling, puncuation, and grammar are a must. // --> // --> Please email any bugs you find, be sure to // --> include the following in your email: // --> 1) Script Name + Version // --> 2) Description of bug // --> // --> Email me any Questions/Comments/Suggestions. // --> // --> If you enjoy my scripts. Please support me. Email me to inquire. // --> // --> Revision History: // --> v0.1_132 = Initial Release 10/11/2005 // --> v0.2_132 = Bug Fixes 11/11/2005 // --> Features: Added some basic Statistics to Report Box // --> Resolved: Pickaxe stuck Anti Random // --> Regressions: No known Regressions // --> v0.3_132 = Bug Fixes 11/11/2005 // --> Features: Added automation of Water and Food Coords. // --> you can still set them manually if you wish // --> Added Time Procedure. For now is only implemented // --> in statistics. // --> Resolved: Failing to detect Stamina/Food/Water Bar // --> Regressions: No known regressions. // --> v0.3_132r2 = Bug Fix 11/11/2005 // --> Resolved: Will find Steak and Water now // --> v0.4_132 = Bug Fix 12/11/2005 // --> Features: Faster :D And more reliable. // --> Auto finds everything... no setting coords // --> Resolved: Not moving forward // --> Freeing pickaxe should be more optimized // --> Fixed issue with custom window themes // --> Regressions: Mining anything other than rock is broken. // --> v0.5_133 = Improvements Features 17/11/05 // --> Features: More optimizations/Finds everything automatically // --> Option to set Error Level, see config area. // --> Option to Mine + Prospect, see config area. // --> Option to Logout if you run out of fatigue. // --> Resolved: Mining any ore type, up to 8 Tile types. Including // --> rock outside a cave. // --> program UltraMiner; const // ***************************************************************************** // ---------------------- USER CONFIG AREA - CHANGE THESE ---------------------- // ***************************************************************************** Client = 'Wurm Online 1.3.3'; //Set Client Name OreLimit = 500; //0 = Infinite; TileType = 1; //0 = Rock; 1 = Cave Wall; 2 = Iron; 3 = Silver; 4 = Gold; 5 = Lead; 6 = Zinc; 7 = Tin; 8 = Copper; MinePath = 0; //0 = Straight; 1 = Down; 2 = Up; ErrorLvl = 1; //0 = Halt Script; 1 = Retry Once; 2 = Retry Indefinatly; Prospect = False; //False = No; True = Mine/Prospect/Mine/Prospect; Logout = True; //True = will log out once done mining. Or run out of fat. // ***************************************************************************** // ---------------------- SCRIPT AREA - DONT CHANGE BELOW ---------------------- // ***************************************************************************** function IsTextAtFromMouse(x, y, Chars: Integer; S: String): Boolean; var mx, my: Integer; begin GetMousePos(mx, my); Result := IsTextAtEx(mx + x, my + y, S, 0, Chars , False, False, 0, 1, $FFFFFF); end; var StatOre, StatDrink, StatEat, StatStuck, StatFwd, pbarx, pbary, miny, minx, wax, way, stx, sty, dx, dy, x, y, Count, Chars, MoveStuck, wbarx, wbary, fbarx, fbary, nbarx, nbary: Integer; Tile, ErrorMsg, MineAngle: String; Error: Boolean; ST: LongInt; Procedure ReportStatistics; var RHours, Minutes, Seconds, RMinutes, RSeconds, AvTime: LongInt; Time: string; begin Seconds := (GetSystemTime - ST) div 1000; Minutes := Seconds div 60; RHours := Minutes div 60; Time := IntToStr(Seconds) + ' Seconds'; if(Count > 0)then AvTime := Seconds/Count; if(Minutes <> 0)then begin RSeconds := Seconds Mod(Minutes * 60); Time := IntToStr(Minutes) + ' Minutes and ' + IntToStr(RSeconds) + ' Seconds'; end; if(RHours <> 0)then begin RMinutes := Minutes Mod(RHours * 60); RSeconds := Seconds Mod(Minutes * 60); Time := IntToStr(RHours)+' Hours, '+IntToStr(RMinutes) + ' Minutes and ' + IntToStr(RSeconds) + ' Seconds'; end; ClearReport; AddToReport('Ultra Miner v0.5_133'); AddToReport('I have mined a total of ' + IntToStr(StatOre) + ' ores.'); AddToReport('I have broken through ' + IntToStr(StatFwd) + ' walls.'); AddToReport('I have consumed water ' + IntToStr(StatDrink) + ' times.'); AddToReport('I have eaten steak ' + IntToStr(StatEat) + ' times.'); AddToReport('I have gotten my pickaxe stuck ' + IntToStr(StatStuck) + ' times.'); AddToReport('I am averaging ' + IntToStr(avtime) + ' seconds per Ore.'); AddToReport('I have been mining for ' + Time + '.'); end; procedure Init; var n, sx, sy, rep: Integer; begin if not(GetSCARVersion = 203)then begin ErrorMsg := 'Error: you do not have the required software, please'; Error := True; exit; end else if not(FindWindowTitlePart(Client, True))then begin ErrorMsg := 'Error: Could not find the client specified.'; Error := True; exit; end; ActivateClient; GetClientDimensions(dx, dy); SetMouseMode(False); if(IsFontSmoothingEnabled)then SetFontSmoothing(False); Chars:= LoadCharsFromFont2('Arial', 8, False, False, False, False); case TileType of 0 : Tile := 'Rock'; 1 : Tile := 'Cave wall'; 2 : Tile := 'Iro'; 3 : Tile := 'Silver'; 4 : Tile := 'Gold'; 5 : Tile := 'Lead'; 6 : Tile := 'Zi'; 7 : Tile := 'Ti'; 8 : Tile := 'Copper'; end; MoveMouseSmooth(dx div 2, dy div 2); while not(IsTextAtFromMouse(15, 4, Chars, Tile))and(rep < 150)do begin GetMousePos(minx, miny); if(minx < 100)or(miny < 100)or(minx > dx - 200)or(miny > dy - 160)or(n > 14)then begin MoveMouseSmooth(dx div 2 + Random(3), dy div 2 - Random(3)); GetMousePos(minx, miny); n := 2; end; MoveMouseSmooth(minx + (n * Random(10)), miny - (n * Random(10))); wait(150); if(IsTextAtFromMouse(15, 4, Chars, Tile)) then break; GetMousePos(minx, miny); MoveMouseSmooth(minx - Random(2), miny + (n * Random(15))); wait(150); if(IsTextAtFromMouse(15, 4, Chars, Tile)) then break; GetMousePos(minx, miny); MoveMouseSmooth(minx - (n * Random(10)), miny + Random(2)); wait(150); if(IsTextAtFromMouse(15, 4, Chars, Tile)) then break; GetMousePos(minx, miny); MoveMouseSmooth(minx - Random(2), miny - (n * Random(10))); wait(150); if(IsTextAtFromMouse(15, 4, Chars, Tile))then break; wait(150); rep := rep + 1; n := n + 1; end; GetMousePos(minx, miny); if(IsTextInAreaEx(0, 0, dx, dy, x, y, 'water', 0, Chars, False, False, 0, 1, $FFFFFF))then begin wax := x + 10; way := y + 5; end else begin Error := True; ErrorMsg := 'Error: Failed to find Water Coordinates, please make sure invetory is open.'; exit; end; if(IsTextInAreaEx(0, 0, dx, dy, x, y, 'steak', 0, Chars, False, False, 0, 1, $FFFFFF))then begin MoveMouseSmooth(x, y); Wait(100); if(IsTextAtFromMouse(15, 4, Chars, 'Pi'))then begin stx := x + 10; sty := y + 20; end else if(IsTextAtFromMouse(15, 4, Chars, 'steak'))then begin stx := x; sty := y; end; end else begin Error := True; ErrorMsg := 'Error: Failed to find Steak Coordinates, please make sure invetory is open.'; exit; end; sx := dx - (dx div 2); sy := dy; FindColorTolerance(pbarx, pbary, 2694943, sx, sy -100, sx + 20, sy, 0); case MinePath of 0 : MineAngle := 'Mi'; 1 : MineAngle := 'dow'; 2 : MineAngle := 'upwards'; end; Error := False; end; procedure MineTest(Prospect: Boolean); var rep, xx ,yy: Integer; begin if(IsTextAtEx(382, 360, 'You are too far', 0, Chars, False, False, 0, 1, $FFFFFF))or(IsTextAtEx(382, 344, 'The wall breaks', 0, Chars, False, False, 0, 1, $FFFFFF))then begin SendArrowSilentWait(0, 2000); StatFwd := StatFwd + 1; end; if(IsTextAtEx(382, 344, 'You have to', 0, Chars, False, False, 0, 1, $FFFFFF))then begin while not(IsTextAtEx(458, 360, 'free your pickaxe', 0, Chars, False, False, 0, 1, $FFFFFF))do begin SendArrowSilentWait(2, 1000); if(MoveStuck > 1)then begin KeyDownSilent(GetKeyCode('d')); Wait(2000) KeyUpSilent(GetKeyCode('d')); KeyDownSilent(GetKeyCode('a')); Wait(2000); KeyUpSilent(GetKeyCode('a')); end; MoveStuck := MoveStuck + 1; if(MoveStuck > 10)then break; end; if(MoveStuck > 0)then begin MoveStuck := MoveStuck * 1000 + 1000; SendArrowSilentWait(0, MoveStuck); end; MoveStuck := 0; StatStuck := StatStuck + 1; end; MoveMouse(minx, miny); Wait(500); if not(IsTextAtFromMouse(15, 4, Chars, Tile))then begin ErrorMsg := 'Error: Could not find Wall! Please edit your constants'; Error := True exit; end else begin while not(IsTextAtFromMouse(-4 ,-16, Chars, Tile))do begin ClickMouse(minx, miny, False); MoveMouseSmooth(minx, miny + 10); Wait(50); end; MoveMouseSmooth(minx, miny); while not(IsTextAtFromMouse(-4, 91, Chars, 'Mi'))do Wait(50); GetMousePos(x, y); MoveMouse(x, y + 100); Wait(500); GetMousePos(x, y); MoveMouse(x + 85, y); GetMousePos(x, y); if(Prospect)then begin MoveMouseSmooth(x, y + 45); end else if(MinePath = 1)then begin MoveMouseSmooth(x, y + 15); end else if(MinePath = 2)then begin MoveMouseSmooth(x, y + 30); end; GetMousePos(x, y); while(GetColor(pbarx, pbary) = 13408665) do wait(100); while not(FindColorTolerance(xx, yy, 3644729, nbarx, nbary , nbarx, nbary + 10, 50)) do wait(100); ClickMouse(x, y, True); end; while(FindColor(x, y, 2694943, pbarx, pbary, pbarx, pbary))do begin wait(500); rep := rep + 1; if(rep > 10)then break; end; StatOre := StatOre + 1; end; procedure EatTest; var rep: Integer; begin MoveMouse(stx, sty); Wait(200); if not(IsTextAtFromMouse(15, 4, Chars, 'steak'))then begin ErrorMsg := 'Error: Could not find Steak! Please edit your constants'; Error := True exit; end else begin while not(IsTextAtFromMouse(11,-6, Chars, 'ak'))do begin ClickMouse(stx, sty, False); Wait(50); end; while not(IsTextAtFromMouse(-4, 75, Chars, 'Eat'))do Wait(50); GetMousePos(x, y); MoveMouse(x, y + 84); Wait(100); GetMousePos(x, y); ClickMouse(x, y, True); end; while(FindColor(x, y, 2694943, pbarx, pbary, pbarx, pbary))do begin wait(500); rep := rep + 1; if(rep > 10)then break; end; StatEat := StatEat + 1; end; procedure DrinkTest; var rep: Integer; begin MoveMouse(wax, way ); Wait(200); if not(IsTextAtFromMouse(15, 4, Chars, 'water'))then begin ErrorMsg := 'Error: Could not find water! Please edit your constants'; Error := True exit; end else begin while not(IsTextAtFromMouse(12,-6, Chars, 'ter'))do begin ClickMouse(wax, way, False); Wait(50); end; while not(IsTextAtFromMouse(-4, 91, Chars, 'Dri'))do Wait(50); GetMousePos(x, y); MoveMouse(x, y + 100); Wait(100); GetMousePos(x, y); ClickMouse(x, y, True); end; while(FindColor(x, y, 2694943, pbarx, pbary, pbarx, pbary))do begin wait(500); rep := rep + 1; if(rep > 10)then break; end; StatDrink := StatDrink + 1; end; procedure ErrorTest; begin writeln(ErrorMsg); case ErrorLvl of 0 : exit; 1 : Init; 2 : while(Error)do Init; end; end; // ***************************************************************************** // ---------------------- MAIN LOOP - DO NOT CHANGE BELOW ---------------------- // ***************************************************************************** begin ClearDebug; ClearReport; Init; FindColorTolerance(nbarx, nbary, 3644729 , dx - 200, 0, dx, dy, 5); FindColorTolerance(fbarx, fbary, 3043228, dx - 200, 0, dx, dy, 5); FindColorTolerance(wbarx, wbary, 10971947, dx - 200, 0, dx, dy, 5); ST := GetSystemTime; ClearDebug; Changereportwidth(400); repeat if(Error)then begin status('Error! Halting.'); writeln(ErrorMsg); case ErrorLvl of 1 : Init; 2 : while(Error)do Init; end; if(Error)then exit; end; if not(FindColorTolerance(x, y, 10971947, wbarx, wbary + 7, wbarx, wbary + 7, 5))then DrinkTest; if not(FindColorTolerance(x, y, 3043228, fbarx, fbary + 10, fbarx, fbary + 12, 5))then EatTest; MineTest(False); if(Prospect)then MineTest(True); ReportStatistics; Count := Count + 1; until(Count = OreLimit); FreeChars2(Chars); end.