Code:
program GoblinShredder;
{.include SRL/SRL/Misc/Smart.scar}
{.include SRL/SRL.scar}
const
CheckForUpdates= True; //Check for script updates? True if yes.
PickAndBury= False; {Pick up and Bury the Bones True if Yes. Note
you may get lost.}
World_SMART= 16; //The RuneScape world you want.
{Script By: Quickmarch}
//----------------------------------------------\\
// Goblin Shredder \\
//__________________________________________________\\
{ Instructions )
( - Quickmarch )
( 1. Put players around Lumbridge Goblin House. )
( 2. Choose what RuneScape world you want on )
( Line 10. )
( 3. Press run and fill in the form. )
( 4. Skill options: 'Attack', 'Stength', )
( 'Defence'. )
( 5. If you want, you can choose to pick up the )
( Bones. Line 6. )
( 6. Please post bugs and reports on my thread. )
( )
(____________________________________________________)
//__________________________________________________\\
( What It Does: )
( - Quickmarch )
( 1. Kills Goblins around Lumbridge Goblin House )
( And picks up the bones. )
( 2. Burys bones. (BETA) )
( 3. Supports multiple players. )
( 4. Includes SRL Stats. )
( 5. Opens doors. (BETA) )
( 6. User friendly. )
( 7. Saves progress reports. )
( 8. Death walk. (ALPHA) (Might Not Work) )
( 9. Includes form. )
( 10. Includes save and load Procedure. )
( 11. Eats food. )
( 12. Repositioning. )
( 13. DDTMs. )
( 14. ATPA Goblin finding. )
( )
( ___________________________________________________)
//__________________________________________________\\
( Things I Might Add: )
( - Quickmarch )
( 1. Range and mage support. )
( 2. Better door opener. )
( 3. Support for spiders. )
( 4. Better death walker. )
( 5. Better bone burier. )
( )
(____________________________________________________)
//__________________________________________________\\
( Credits: )
( 1. unhappy egg for Testing. )
( 2. Narcle for the InFightGoblin Function. )
( 3. munk for the QuickFlag Procedure. )
( 4. BH for the DrawImages Procedure. )
( 5. A G E N T for the Explode Function. )
( 6. Widget for the Encrypt and Decrypt Functions. )
( )
(____________________________________________________)
//__________________________________________________\\
( Disclaimer )
( - Quickmarch )
( 1. It's not my responsibility if your account )
( Gets BANNED for any reason. )
( )
(____________________________________________________)
( Thanks for reading )
\\--------------------------------------------------//
{Start Script}
{--------------------Script Below--------------------}
var
Bone, Bones, Gobs, Doors: Integer;
//Form Vars
frmDesign: TForm;
ActiveTxt, NickTxt, PassTxt, UserTxt, Author, Ver: TLabel;
StatIdLab, StatPassLab: TLabel;
ActiveCom: TComboBox;
CurPlayerSet, PlayerListSet, StatSet: TGroupBox;
NickEd: TEdit;
PassEd, UserEd, StatIdEd, StatPassEd: TEdit;
PlayerListScr: TListBox;
RunBTN, AddBTN, DelBTN, ViewSiteBTN: TButton;
New, New2, New3, New4, New5: Integer;
Start: Boolean;
SkillToTrain: TGroupBox;
SkillLab, LevelLab: TLabel;
LevelEd, SkillEd: TEdit;
FoodCom: TComboBox;
FoodTxt: TLabel;
procedure Logo;
begin
ClearDebug;
WriteLn(' ________ ___. .__ .__ ');
WriteLn(' / _____/ ____\_ |__ | | |__| ____ ');
WriteLn('/ \ ___ / _ \| __ \| | | |/ \ ');
WriteLn('\ \_\ ( <_> ) \_\ \ |_| | | \ ');
WriteLn(' \______ /\____/|___ /____/__|___| / ');
WriteLn(' \/ \/ \/ ');
WriteLn(' _________.__ .___ .___ ');
WriteLn(' / _____/| |_________ ____ __| _/__| _/___________ ');
WriteLn(' \_____ \ | | \_ __ \_/ __ \ / __ |/ __ |/ __ \_ __ \ ');
WriteLn(' / \| Y \ | \/\ ___// /_/ / /_/ \ ___/| | \/ ');
WriteLn('/_______ /|___| /__| \___ >____ \____ |\___ >__| ');
WriteLn(' \/ \/ \/ \/ \/ \/ ');
Wait(1000);
end;
function MyMessageDialog(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; Captions: array of string; CaptionDlg: string): Integer; forward;
procedure Food; forward;
procedure SetupDTMS;
begin
Bone := DTMFromString('78DA639CCACCC0708B9101196C5EB19C41124' +
'88344FF0301E344A09A27A86A20B23012482F00AAB94D40CD24A0' +
'9A4B04D4B403D5DC20A0661650CD55026AFA08BB0700EA401042');
end;
{*******************************************************************************
function FindDirtRoadColor2: Integer;
By: ZephyrsFury Edited the WriteLns
Description: Autodetects Dirt Road Color on Minimap (Lummy-Draynor Road Colour).
*******************************************************************************}
function FindDirtRoadColor2: Integer;
var
CTS, II, Count, PCount: Integer;
ColourDensity: Extended;
TPA, CPts: TPointArray;
TIA: TIntegerArray;
TB: TBox;
begin
Result := 0;
CTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.44, 1.42);
if (FindColorsTolerance(TPA, 1915466, MMX1, MMY1, MMX2, MMY2, 10)) then
begin
FilterPointsPie(TPA, 0.0, 360.0, 0.0, 76.0, MMCX, MMCY);
TIA := GetColors(TPA);
ClearSameIntegersAndTPA(TIA, TPA);
for II := 0 to High(TIA) do
begin
FindColorsTolerance(CPts, TIA[II], MMX1, MMY1, MMX2, MMY2, 0);
TB := GetTPABounds(CPts);
Count := Length(CPts);
try
ColourDensity := Count / ((TB.x2 - TB.x1) * (TB.y2 - TB.y1));
except end;
if (Count < 300) or (ColourDensity < 0.08) or (Count <= PCount) then Continue;
Result := TIA[II];
PCount := Count;
end;
end;
SetColorSpeed2Modifiers(0.2, 0.2);
ColorToleranceSpeed(CTS);
end;
{*******************************************************************************
function FindLumbyRoadColor2: Integer;
By: ZephyrsFury Edited the WriteLns
Description: Autodetects Lumbridge Road Colour on the minimap.
*******************************************************************************}
function FindLumbyRoadColor2: Integer;
var
II, CTS: Integer;
TPA: TPointArray;
TIA: TIntegerArray;
begin
Result := 0;
CTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.52, 0.25);
if (FindColorsTolerance(TPA, 6387069, MMX1, MMY1, MMX2, MMY2, 9)) then
begin
FilterPointsPie(TPA, 0.0, 360.0, 0.0, 76.0, MMCX, MMCY);
SortTPAFrom(TPA, Point(MMCX, MMCY));
TIA := GetColors(TPA);
for II := 0 to High(TIA) do
if (CountColor(TIA[II], MMX1, MMY1, MMX2, MMY2) > 300) then
begin
Result := TIA[II];
Break;
end;
end;
SetColorSpeed2Modifiers(0.2, 0.2);
ColorToleranceSpeed(CTS);
end;
procedure SetLoc(s: String);
begin
Players[CurrentPlayer].Loc := s;
end;
procedure SetLocations;
var
i: Integer;
begin
for i := 0 to GetArrayLength(Players) - 1 do
begin
Players[i].Loc := 'Start';
end;
end;
function DTM(s: string): Integer;
var
dtmMainPoint: TDTMPointDef;
dtmSubPoints: array of TDTMPointDef;
TempTDTM: TDTM;
begin
case Lowercase(s) of
'goblin house':
begin
SetArrayLength(dtmSubPoints, 4);
dtmMainPoint.x := 943;
dtmMainPoint.y := 334;
dtmMainPoint.AreaSize := 0;
dtmMainPoint.AreaShape := 0;
dtmMainPoint.Color := FindDirtRoadColor2;
dtmMainPoint.Tolerance := 0;
dtmSubPoints[0].x := 943;
dtmSubPoints[0].y := 334;
dtmSubPoints[0].AreaSize := 0;
dtmSubPoints[0].AreaShape := 0;
dtmSubPoints[0].Color := FindDirtRoadColor2;
dtmSubPoints[0].Tolerance := 0;
dtmSubPoints[1].x := 974;
dtmSubPoints[1].y := 334;
dtmSubPoints[1].AreaSize := 0;
dtmSubPoints[1].AreaShape := 0;
dtmSubPoints[1].Color := FindDirtRoadColor2;
dtmSubPoints[1].Tolerance := 0;
dtmSubPoints[2].x := 948;
dtmSubPoints[2].y := 349;
dtmSubPoints[2].AreaSize := 0;
dtmSubPoints[2].AreaShape := 0;
dtmSubPoints[2].Color := FindDirtRoadColor2;
dtmSubPoints[2].Tolerance := 0;
dtmSubPoints[3].x := 934;
dtmSubPoints[3].y := 349;
dtmSubPoints[3].AreaSize := 0;
dtmSubPoints[3].AreaShape := 0;
dtmSubPoints[3].Color := FindDirtRoadColor2;
dtmSubPoints[3].Tolerance := 0;
TempTDTM.MainPoint := dtmMainPoint;
TempTDTM.SubPoints := dtmSubPoints;
Result := AddDTM(TempTDTM);
end;
'lumby 1':
begin
SetArrayLength(dtmSubPoints, 5);
dtmMainPoint.x := 1013;
dtmMainPoint.y := 206;
dtmMainPoint.AreaSize := 0;
dtmMainPoint.AreaShape := 0;
dtmMainPoint.Color := FindLumbyRoadColor2;
dtmMainPoint.Tolerance := 0;
dtmSubPoints[0].x := 1013;
dtmSubPoints[0].y := 206;
dtmSubPoints[0].AreaSize := 0;
dtmSubPoints[0].AreaShape := 0;
dtmSubPoints[0].Color := FindLumbyRoadColor2;
dtmSubPoints[0].Tolerance := 0;
dtmSubPoints[1].x := 1031;
dtmSubPoints[1].y := 244;
dtmSubPoints[1].AreaSize := 0;
dtmSubPoints[1].AreaShape := 0;
dtmSubPoints[1].Color := FindLumbyRoadColor2;
dtmSubPoints[1].Tolerance := 0;
dtmSubPoints[2].x := 1012;
dtmSubPoints[2].y := 255;
dtmSubPoints[2].AreaSize := 0;
dtmSubPoints[2].AreaShape := 0;
dtmSubPoints[2].Color := FindLumbyRoadColor2;
dtmSubPoints[2].Tolerance := 0;
dtmSubPoints[3].x := 1000;
dtmSubPoints[3].y := 247;
dtmSubPoints[3].AreaSize := 0;
dtmSubPoints[3].AreaShape := 0;
dtmSubPoints[3].Color := FindLumbyRoadColor2;
dtmSubPoints[3].Tolerance := 0;
dtmSubPoints[4].x := 1013;
dtmSubPoints[4].y := 278;
dtmSubPoints[4].AreaSize := 0;
dtmSubPoints[4].AreaShape := 0;
dtmSubPoints[4].Color := FindLumbyRoadColor2;
dtmSubPoints[4].Tolerance := 0;
TempTDTM.MainPoint := dtmMainPoint;
TempTDTM.SubPoints := dtmSubPoints;
Result := AddDTM(TempTDTM);
end;
'goblin house 2':
begin
SetArrayLength(dtmSubPoints, 4);
dtmMainPoint.x := 1055;
dtmMainPoint.y := 151;
dtmMainPoint.AreaSize := 0;
dtmMainPoint.AreaShape := 0;
dtmMainPoint.Color := FindDirtRoadColor2;
dtmMainPoint.Tolerance := 0;
dtmSubPoints[0].x := 1055;
dtmSubPoints[0].y := 151;
dtmSubPoints[0].AreaSize := 0;
dtmSubPoints[0].AreaShape := 0;
dtmSubPoints[0].Color := FindDirtRoadColor2;
dtmSubPoints[0].Tolerance := 0;
dtmSubPoints[1].x := 1079;
dtmSubPoints[1].y := 150;
dtmSubPoints[1].AreaSize := 0;
dtmSubPoints[1].AreaShape := 0;
dtmSubPoints[1].Color := FindLumbyRoadColor2;
dtmSubPoints[1].Tolerance := 0;
dtmSubPoints[2].x := 1081;
dtmSubPoints[2].y := 170;
dtmSubPoints[2].AreaSize := 0;
dtmSubPoints[2].AreaShape := 0;
dtmSubPoints[2].Color := FindLumbyRoadColor2;
dtmSubPoints[2].Tolerance := 0;
dtmSubPoints[3].x := 1056;
dtmSubPoints[3].y := 180;
dtmSubPoints[3].AreaSize := 0;
dtmSubPoints[3].AreaShape := 0;
dtmSubPoints[3].Color := FindLumbyRoadColor2;
dtmSubPoints[3].Tolerance := 0;
TempTDTM.MainPoint := dtmMainPoint;
TempTDTM.SubPoints := dtmSubPoints;
Result := AddDTM(TempTDTM);
end;
end;
end;
procedure PlayerOptions;
var
Level, Skill: Integer;
s: String;
begin
if not(LoggedIn) then Exit;
Level := Players[CurrentPlayer].Integers[0];
Retaliate(True);
case Lowercase(Players[CurrentPlayer].Strings[0]) of
'attack', 'att', 'a', 'attk', 'atk', '1':
begin
Skill := GetSkillInfo('Stength', False);
if Skill >= Level then
begin
WriteLn('Player''s '+ Capitalize(s) +' is '+IntToStr(Level) +'; Player finished');
NextPlayer(False);
end;
SetFightMode(1);
Exit;
end;
'strength', 'str', 's', '2':
begin
Skill := GetSkillInfo('Attack', False);
if Skill >= Level then
begin
WriteLn('Player''s '+ Capitalize(s) +' is '+IntToStr(Level) +'; Player finished');
NextPlayer(False);
end;
SetFightMode(2);
Exit;
end;
'defence', 'def', 'd', '3':
begin
Skill := GetSkillInfo('Defence', False);
if Skill >= Level then
begin
WriteLn('Player''s '+ Capitalize(s) +' is '+IntToStr(Level) +'; Player finished');
NextPlayer(False);
end;
SetFightMode(4);
Exit;
end;
'all', 'a', '4':
begin
SetFightMode(3);
Exit;
end;
end;
WriteLn('Error: Unknown fighting style');
NextPlayer(False);
end;
procedure DeathWalk; forward;
function InFightGoblin: Boolean;
var
G, R, TPA: TPointArray;
begin
FindColorsTolerance(G, 65280, 240, 134, 275, 172, 0);
FindColorsTolerance(R, 255, 240, 134, 275, 172, 0);
TPA := CombineTPA(G, R);
Result := High(TPA) > 10;
end;
function FindDeadQM: Boolean;
begin
Result := False;
if FindTextTPA(0, 0, MCX1, MCY1, MCX2, MCY2, 'dear', SmallChars, Nothing) then
if FindTextTPA(0, 0, MCX1, MCY1, MCX2, MCY2, 'dead', SmallChars, Nothing) then
begin
Result := True;
SetLoc('Dead');
SaveToChatLog;
end;
end;
procedure AntiRandoms;
var
HP: Integer;
begin
if not(LoggedIn) then Exit;
HP := HPPercent;
if (HP > 100) then Players[CurrentPlayer].Level[8] := GetSkillInfo('hp', False);
Status('HP: '+ IntToStr(HPPercent)+ '%');
DeathWalk;
if Players[CurrentPlayer].Booleans[1] then Food;
FindNormalRandoms;
end;
function RunAmount: Integer;
var
S: String;
begin
Result := GetMMLevels('run', S);
end;
procedure QuickFlag;
var
T: Integer;
begin
MarkTime(T);
while (FlagPresent) do
begin
AntiRandoms;
if TimeFromMark(T) > 10000 then exit;
Wait(250);
if RunAmount > 0 then SetRun(True);
end;
end;
function EnemyUnderAttack(x, y: Integer): Boolean;
var
rx, ry: Integer;
begin
if not(LoggedIn) then Exit;
if (FindColorSpiral(rx, ry, 65280, x - 5, y - 40, x + 5, y + 20) or
FindColorSpiral(rx, ry, 255, x - 5, y - 40, x + 5, y + 20)) then
begin
Result := True;
Exit;
end;
end;
procedure DeathWalk;
var
x, y: Integer;
begin
if (FindDeadQM) then
begin
MakeCompass('N');
SetRun(True);
WriteLn('Oh dear, you are dead!');
if DTMRotated(DTM('lumby 1'), x, y, MMX1, MMY1, MMX2, MMY2) then
begin
Mouse(x, y, 3, 3, True);
FFlag(0);
end else
begin
if FindSymbol(x, y, 'water') then
begin
Mouse(x, y, 3, 3, True);
FFlag(0);
end;
end;
RadialRoadWalk(FindLumbyRoadColor2, 75, 105, 34, + 4, + 3);
FFlag(0);
RadialRoadWalk(FindLumbyRoadColor2, 70, 95, 66, + 4, - 4);
FFlag(0);
RadialRoadWalk(FindDirtRoadColor2, 330, 350, 74, - 2, + 4);
FFlag(0);
if (not(LoggedIn)) then NextPlayer(False);
end;
end;
procedure Proggy;
var
i, s: Integer;
begin
s := Length(' ' + IntToStr(i) + ': ' + Players[i].Nick + ': ' + 'Loc = ' + Players[i].Loc + ' | ' + 'Goblins = ' + IntToStr(Players[i].Integers[3]) + ' | ' + 'Bones = ' + IntToStr(Players[i].Integers[5]) + ' | ' + 'Doors = ' + IntToStr(Players[i].Integers[4]));
WriteLn('//---------------------------------------------------------\\');
WriteLn('|| Goblin Shredder Report ||');
WriteLn('\\---------------------------------------------------------//');
WriteLn(' Goblins Killed: '+ IntToStr(Gobs));
if (PickAndBury) then
begin
WriteLn(' Bones Buried: '+ IntToStr(Bones));
end;
WriteLn(' Doors Opened: '+ IntToStr(Doors));
WriteLn(' Time Running: '+ TimeRunning);
WriteLn('//' + Replicate('-', s) + '\\');
for i := 0 to New4 - 1 do
begin
WriteLn(' ' + IntToStr(i) + ': ' + Players[i].Nick + ': ' + 'Loc = ' + Players[i].Loc + ' | ' + 'Goblins = ' + IntToStr(Players[i].Integers[3]) + ' | ' + 'Bones = ' + IntToStr(Players[i].Integers[5]) + ' | ' + 'Doors = ' + IntToStr(Players[i].Integers[4]));
end;
WriteLn('\\' + Replicate('-', s) + '//');
SRLRandomsReport;
end;
procedure SaveProggy;
var
List: TStringList;
i, s: Integer;
begin
s := Length(' ' + IntToStr(i) + ': ' + Players[i].Nick + ': ' + 'Loc = ' + Players[i].Loc + ' | ' + 'Goblins = ' + IntToStr(Players[i].Integers[3]) + ' | ' + 'Bones = ' + IntToStr(Players[i].Integers[5]) + ' | ' + 'Doors = ' + IntToStr(Players[i].Integers[4]));
List := TStringList.Create;
List.Add('//---------------------------------------------------------\\');
List.Add('|| Goblin Shredder Report ||');
List.Add('\\---------------------------------------------------------//');
List.Add(' Goblins Killed: '+ IntToStr(Gobs));
List.Add(' Bones Buried: '+ IntToStr(Bones));
List.Add(' Doors Opened: '+ IntToStr(Doors));
List.Add(' Time Running: '+ TimeRunning);
List.Add('//' + Replicate('-', s) + '\\');
for i := 0 to New4 - 1 do
begin
List.Add(' ' + IntToStr(i) + ': ' + Players[i].Nick + ': ' + 'Loc = ' + Players[i].Loc + ' | ' + 'Goblins = ' + IntToStr(Players[i].Integers[3]) + ' | ' + 'Bones = ' + IntToStr(Players[i].Integers[5]) + ' | ' + 'Doors = ' + IntToStr(Players[i].Integers[4]));
end;
List.Add('\\' + Replicate('-', s) + '//');
SaveToFile(List, AppPath + 'Quickmarch\Proggy\GSProggy ' + TheDate(3) + '.txt');
end;
function RandomAngle(Ang: Integer): Boolean;
begin
if not LoggedIn then Exit;
Result := MakeCompass(IntToStr(random(Ang)));
end;
function BuryDTM(DTM, x1, y1, x2, y2: Integer): Integer;
var
x, y, i: Integer;
begin
if not(LoggedIn) then Exit;
for i := 1 to 28 do
begin
If not(FindDTM(DTM, x, y, x1, y1, x2, y2)) then Break;
if (FindDTM(DTM, x, y, x1, y1, x2, y2)) then
begin
Inc(Result);
Inc(Bones);
Inc(Players[CurrentPlayer].Integers[5]);
SetLoc('Burying');
ReportVars[1] := ReportVars[1] + 1;
Mouse(x, y, 3, 3, True);
Wait(1500+random(500));
AntiRandoms;
end;
end;
Exit;
end;
function InFightWithMe: Boolean;
var
Time: Integer;
begin
if (InFightGoblin) then
begin
MarkTime(Time);
while InFightGoblin do
begin
AntiRandoms;
if(TimeFromMark(Time) > 120000) then
begin
GameTab(RandomRange(1, 12));
Inc(Gobs);
Inc(Players[CurrentPlayer].Integers[3]);
Exit;
end;
end;
Result := True;
Inc(Gobs);
Inc(Players[CurrentPlayer].Integers[3]);
ReportVars[0] := ReportVars[0] + 1;
Exit;
end;
end;
function PickUpBones: Boolean;
var
TPA: TPointArray;
ATPA: T2DPointArray;
x, y, i, CTS: Integer;
begin
if not(LoggedIn) then Exit;
if (PickAndBury) then
begin
x := MSCX;
y := MSCY;
CTS := GetColorToleranceSpeed;
Colortolerancespeed(2);
SetColorspeed2Modifiers(1.0, 1.0)
FindColorsSpiralTolerance(x, y, TPA, 11908799, MSX1, MSY1, MSX2, MSY2, 1);
SetColorspeed2Modifiers(0.2, 0.2);
Colortolerancespeed(CTS);
if Length(TPA) = 0 then Exit;
ATPA := TPAtoATPAEx(TPA, 50, 50);
for i := 0 to High(ATPA) do
begin
if (MiddleTPAEx(ATPA[i], x, y)) then
MMouse(x, y, 3, 3);
Wait(200+Random(100));
if (IsUpText('ake')) then
begin
Mouse(x, y, 3, 3, False);
Result := ChooseOption('ones');
SetLoc('Taking Bones');
if Result then
begin
QuickFlag;
Exit;
end;
end;
Result := False;
Exit;
end;
end;
end;
function HPLow: Boolean;
begin
Result := HPPercent < 50;
end;
procedure EatFood;
var
i, x, y: Integer;
begin
if not(LoggedIn) then Exit;
for i := 1 to 28 do
begin
if (ExistsItem(i)) then
begin
MMouseItem(i);
Wait(100+Random(50));
if (IsUpText('Eat')) then
begin
GetMousePos(x, y);
Mouse(x, y, 3, 3, True);
Wait(2000+random(500));
Exit;
end;
end;
end;
Exit;
end;
procedure BuryBones;
begin
if PickAndBury then
begin
PickUpBones;
if (InvFull) then
begin
BuryDTM(Bone, MIX1, MIY1, MIX2, MIY2);
AntiRandoms;
Proggy;
SaveProggy;
Exit;
end;
end;
Exit;
end;
var
Count: Integer;
function Reposition: Boolean;
var
x, y: Integer;
begin
MakeCompass('N');
x := MMCX;
y := MMCY;
if DTMRotated(DTM('Goblin House'), x, y, MMX1, MMY1, MMX2, MMY2) then
begin
Result := True;
Count := 0;
Mouse(x, y, 3, 3, True);
QuickFlag;
Exit;
end;
Mouse(MMCX, MMCY + 10, 3, 3, True);
QuickFlag;
Exit;
end;
function OpenDoor: Boolean;
var
TPA, TPA2, TPA3: TPointArray;
ATPA: T2DPointArray;
x, y, i, CTS: Integer;
begin
if not(LoggedIn) then Exit;
Wait(2500+random(500));
if (InFightWithMe) then Exit;
MakeCompass('E');
x := MSCX;
y := MSCY;
FFlag(0);
CTS := GetColorToleranceSpeed;
Colortolerancespeed(2);
SetColorspeed2Modifiers(0.2, 0.4)
FindColorsSpiralTolerance(x, y, TPA, 2897729, MSX1, MSY1, MSX2, MSY2, 2);
FindColorsSpiralTolerance(x, y, TPA2, 2700349, MSX1, MSY1, MSX2, MSY2, 2);
SetColorspeed2Modifiers(0.2, 0.2);
Colortolerancespeed(CTS);
if Length(TPA) = 0 then Exit;
TPA3 := CombineTPA(TPA, TPA2);
ATPA := TPAtoATPAEx(TPA3, 50, 50);
for i := 0 to High(ATPA) do
begin
if(MiddleTPAEx(ATPA[i], x, y)) then
MMouse(x, y, 0, 0);
Wait(100);
if (IsUpText('pen')) then
begin
Mouse(x, y, 0, 0, False);
Result := ChooseOption('pen');
if Result then
begin
AntiRandoms;
QuickFlag;
Inc(Doors);
ReportVars[2] := ReportVars[2] + 1;
Inc(Players[CurrentPlayer].Integers[4]);
WriteLn('Successfully opened door');
SetLoc('Opening Door');
Exit;
end;
end;
Result := False;
if IsUpText('lose') then Exit;
end;
end;
procedure Food;
begin
if (HPLow) then
begin
EatFood;
end;
end;
function FindGoblin(MoveAngle: Boolean): Boolean; forward;
function NewAngleGoblin: Boolean;
var
i, x, y: Integer;
begin
i := 0;
x := MSCX;
y := MSCY;
for i := 1 to 10 do
begin
Inc(Count);
RandomAngle(360);
if FindGoblin(False) then
begin
Count := 0;
Result := True;
Exit;
end;
end;
i := 0;
if Count >= 10 then
if DTMRotated(DTM('Goblin House 2'), x, y, MMX1, MMY1, MMX2, MMY2) then
begin
Mouse(x, y, 3, 3, True);
QuickFlag;
Count := 0;
end;
Reposition;
Exit;
end;
function ClickedOb(x, y: Integer): Boolean;
var
rx, ry: Integer;
begin
GetMousePos(rx, ry);
Result := FindColor(rx, ry, 255, x - 5, y - 5, x + 5, y + 5);
end;
function FindGoblin(MoveAngle: Boolean): Boolean;
var
TPA: TPointArray;
ATPA: T2DPointArray;
x, y, i, ii, CTS: Integer;
Colors: TIntegerArray;
begin
if not(LoggedIn) then Exit;
Colors := [4040095, 8502441, 3909023, 6070135, 7184518, 3510667, 2649449];
CTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
for ii := 0 to Length(Colors) - 1 do
begin
FindColorsSpiralTolerance(MSCX, MSCY, TPA, Colors[ii], MSX1, MSY1, MSX2, MSY2, 8);
if Length(TPA) = 0 then
if MoveAngle then
begin
NewAngleGoblin;
end;
ATPA := SplitTPAEx(TPA, 50, 50);
SortATPAFrom(ATPA, Point(MSCX, MSCY));
for i := Low(ATPA) to High(ATPA) do
begin
if (MiddleTPAEx(ATPA[i], x, y)) then
begin
if not EnemyUnderAttack(x, y) then
begin
MMouse(x, y, 3, 3);
Wait(100+random(100));
if (IsUpText('ttack') and IsUpText('oblin')) then
begin
if EnemyUnderAttack(x, y) then Exit;
Mouse(x, y, 3, 3, True);
Result := ClickedOb(x, y);
Wait(100);
if Result then
begin
Wait(100);
if FlagPresent then
begin
QuickFlag;
MakeCompass('N');
SetAngle(True);
Wait(1000);
FixChat;
SetLoc('Fighting');
InFightWithMe;
AntiRandoms;
PickUpBones;
BuryBones;
Exit;
end;
OpenDoor;
Exit;
end;
end;
if not(Result) then
begin
QuickFlag;
Exit;
end;
end;
end;
end;
ColorToleranceSpeed(CTS);
Exit;
end;
end;
procedure ScriptTerminate;
begin
FreeDTM(Bone);
FreeDTM(DTM('Goblin House'));
FreeDTM(DTM('Lumby 1'));
FreeDTM(DTM('Goblin House 2'));
end;
procedure AttackGoblins;
begin
if not(LoggedIn) then Exit;
FindGoblin(true);
end;
procedure Clear;
begin
UserEd.Text := '';
PassEd.Text := '';
NickEd.Text := '';
ActiveCom.Text := 'Active';
FoodCom.Text := 'Food';
SkillEd.Text := 'Attack';
LevelEd.Text := '0';
end;
var
AddPlayers: Integer;
procedure SavePlayers; forward;
function Encrypt(text:string):string;
var
i:integer;
begin
for i := 1 to length(text) do
result := result+Chr(ord(text[i])-8);
end;
function Decrypt(text:string):string;
var
i:integer;
begin
for i := 1 to length(text) do
result := result+Chr(ord(text[i])+8);
end;
function GetArrayIndex(PlayerName: String; Arr: array of TUser): Integer;
var
i: Integer;
begin
Result := - 1;
for i := Low(Arr) to High(Arr) do
begin
if Lowercase(PlayerName) = Lowercase(Arr[i].Name) then Result := i;
end;
end;
procedure FixList;
var
i: Integer;
begin
PlayerListScr.Clear;
for i := 0 to High(Players) do
begin
PlayerListScr.Items.Add(Players[i].Name);
end;
end;
function ErrorType: String;
begin
if UserEd.Text = '' then
begin
Result := 'Please add a Username';
Exit;
end;
if PassEd.Text = '' then
begin
Result := 'Please add a Password';
Exit;
end;
if NickEd.Text = '' then
begin
Result := 'Please add a Nickname';
Exit;
end;
if (ActiveCom.Text <> 'True') and (ActiveCom.Text <> 'False') then
begin
Result := 'Please add an Active value';
Exit;
end;
if (FoodCom.Text <> 'True') and (FoodCom.Text <> 'False') then
begin
Result := 'Please add a Food value';
Exit;
end;
if (SkillEd.Text = '') then
begin
Result := 'Please set a Skill to Train';
Exit;
end;
if (LevelEd.Text = '') then
begin
Result := 'Please set a Level';
Exit;
end;
end;
procedure Changes(Index: Integer; Settings: array of String);
begin
Players[Index].Name := Settings[0];
Players[Index].Pass := Settings[1];
Players[Index].Nick := Settings[2];
Players[Index].Strings[0] := Settings[3];
Players[Index].Integers[0] := StrToInt(Settings[4]);
Players[Index].Active := StrToBool(Settings[5]);
Players[Index].Booleans[1] := StrToBool(Settings[6]);
end;
function ArrayContains(Player: String; Arr: array of TUser): Boolean;
begin
Result := GetArrayIndex(Player, Arr) <> - 1;
end;
function Error: Boolean;
begin
if ErrorType <> '' then
begin
MyMessageDialog(ErrorType, mtWarning, [mbOk], ['OK'], 'Goblin Shredder ©');
Result := True;
Exit;
end;
end;
var
Index: Integer;
procedure AddPlayer(Sender: TObject);
begin
if Error then Exit;
if ArrayContains(UserEd.Text, Players) then
begin
MyMessageDialog('You have already added that player', mtWarning, [mbOk], ['OK'], 'Goblin Shredder ©');
Exit;
end;
try
New2 := New2 + 1;
New3 := New3 + 1;
New4 := New4 + 1;
New5 := New5 + 1;
HowManyPlayers := HowManyPlayers + 1;
NumberOfPlayers(HowManyPlayers);
Players[New].Name := UserEd.Text;
Players[New].Pass := PassEd.Text;
Players[New].Nick := NickEd.Text;
Players[New].Strings[0] := SkillEd.Text;
Players[New].Integers[0] := StrToInt(LevelEd.Text);
Players[New].Booleans[1] := StrToBool(FoodCom.Text);
Players[New].Active := StrToBool(ActiveCom.Text);
New := HowManyPlayers;
PlayerListScr.Items.Add(UserEd.Text);
Inc(AddPlayers);
New4 := AddPlayers;
Index := GetArrayIndex(UserEd.Text, Players);
except
MyMessageDialog(ErrorType, mtWarning, [mbOk], ['OK'], 'Goblin Shredder ©');
HowManyPlayers := HowManyPlayers - 1;
New3 := New3 - 1;
New4 := New4 - 1;
New2 := New2 - 1;
New5 := New5 - 1;
Exit;
end;
end;
var
Show2: Boolean;
Send: TObject;
procedure RunPlayers(Sender: TObject);
begin
if Error then Exit;
if (New3= 0) then
begin
AddPlayer(Send);
end;
try
Changes(Index, [UserEd.Text, PassEd.Text, NickEd.Text, SkillEd.Text, LevelEd.Text, ActiveCom.Text, FoodCom.Text]);
CurrentPlayer := 0;
SRLId := StatIdEd.Text;
SRLPassword := StatPassEd.Text;
Show2 := False;
SavePlayers;
frmDesign.Close;
Start := True;
except
WriteLn('ahh');
Start := False;
Exit;
end;
end;
procedure Dialog(URL, FileName: String);
var
T: TSaveDialog;
Version, Download: String;
i: Integer;
begin
Version := GetPage('http://www.freewebs.com/quickmarch/GSVersion.txt');
T := TSaveDialog.Create(frmDesign);
T.Title := 'Save to Folder';
T.Options := [ofFileMustExist, ofReadOnly];
T.Filter := 'SCAR Files (*.scar)|*.scar|' +
'All Files|*|';
T.InitialDir := ScriptPath;
T.FileName := FileName;
T.DefaultExt := '.scar';
if (T.Execute) then
begin
try
WriteLn(T.FileName);
Status('Downloading Script...');
i := RewriteFile(T.FileName, False);
Download := GetPage(URL);
if (WriteFileString(i, Download)) then
begin
WriteLn('Successfully saved to: ' + T.FileName);
Status('Done.');
Exit;
end;
T.Free;
except
WriteLn('Could not download');
Exit;
end;
end;
T.Free;
end;
var
CurVersion: String;
procedure VersionChecker;
var
Version: String;
Errors: TStringArray;
i: Integer;
begin
Version := GetPage('http://www.freewebs.com/quickmarch/GSVersion.txt');
Errors := ['Connection', 'Socket Error', 'Refused'];
for i := 0 to Length(Errors) - 1 do
begin
if Pos(Errors[i], GetDebugText) > 0 then
begin
WriteLn('Connection Error');
Exit;
end;
end;
if (Version <> CurVersion) then
begin
WriteLn('There is a new version of the script');
WriteLn('Would you like to download?');
if (MyMessageDialog('Would you like to download the new version?', mtConfirmation, [mbYes, mbNo, mbCancel], ['Yes', 'No', 'Cancel'], 'Goblin Shredder BETA ©')= mrYes) then
begin
case MyMessageDialog('Would you like the SMART version?', mtConfirmation, [mbYes, mbNo, mbCancel], ['Yes', 'No', 'Cancel'], 'Goblin Shredder BETA ©') of
mrYes:
begin
Dialog('http://www.freewebs.com/quickmarch/Goblin%20Shredder%20SMART%20v'+ Version +'.scar', 'Goblin Shredder SMART v' + Version);
Exit;
end;
mrNo:
begin
Dialog('http://www.freewebs.com/quickmarch/Goblin%20Shredder%20v'+ Version +'.scar', 'Goblin Shredder v' + Version);
Exit;
end;
mrCancel:
begin
frmDesign.ModalResult := mrNone;
Exit;
end;
end;
end else
Exit;
end;
WriteLn('You have the latest version');
Exit;
end;
function INIContains(Section, Keyname, Path: String): Boolean;
begin
if ReadINI(Section, Keyname, Path) <> '' then Result := True;
end;
procedure LoadPlayers;
var
i: Integer;
begin
if FileExists(AppPath + 'Quickmarch\Players\GSPlayers.txt') then
begin
try
New := StrToInt(ReadINI('Int', 'Num', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
New2 := StrToInt(ReadINI('Int', 'Num2', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
New3 := StrToInt(ReadINI('Int', 'Num3', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
New4 := StrToInt(ReadINI('Int', 'Num4', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
New5 := StrToInt(ReadINI('Int', 'Num5', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
HowManyPlayers := StrToInt(ReadINI('Int', 'Num6', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
AddPlayers := StrToInt(ReadINI('Int', 'Num7', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
StatIdEd.Text := ReadINI('Stats', 'ID', AppPath + 'Quickmarch\Players\GSPlayers.txt');
StatPassEd.Text := Decrypt(ReadINI('Stats', 'Pass', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
NumberOfPlayers(New);
for i := 0 to New4 - 1 do
begin
Players[i].Name := ReadINI('Player ' + IntToStr(i+1), 'User', AppPath + 'Quickmarch\Players\GSPlayers.txt');
Players[i].Pass := Decrypt(ReadINI('Player ' + IntToStr(i+1), 'Pass', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
Players[i].Nick := ReadINI('Player ' + IntToStr(i+1), 'Nick', AppPath + 'Quickmarch\Players\GSPlayers.txt');
Players[i].Booleans[1] := StrToBool(ReadINI('Player ' + IntToStr(i+1), 'Food', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
Players[i].Strings[0] := ReadINI('Player ' + IntToStr(i+1), 'Skill', AppPath + 'Quickmarch\Players\GSPlayers.txt')
Players[i].Active := StrToBool(ReadINI('Player ' + IntToStr(i+1), 'Active', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
Players[i].Integers[0] := StrToInt(ReadINI('Player ' + IntToStr(i+1), 'Level', AppPath + 'Quickmarch\Players\GSPlayers.txt'));
UserEd.Text := Players[i].Name;
PassEd.Text := Players[i].Pass;
NickEd.Text := Players[i].Nick;
SkillEd.Text := Players[i].Strings[0];
LevelEd.Text := IntToStr(Players[i].Integers[0]);
ActiveCom.Text := BoolToStr(Players[i].Active);
FoodCom.Text := BoolToStr(Players[i].Booleans[1]);
PlayerListScr.Items.Add(Players[i].Name);
end;
except
if (MyMessageDialog('Could not load players', mtWarning, [mbOk, mbRetry], ['OK', 'Retry'], 'Goblin Shredder ©')= mrRetry) then
begin
LoadPlayers;
end else
Exit;
end;
end;
end;
procedure ClearFile(Path: String);
var
Ob: TStringList;
begin
Ob := TStringList.Create;
Ob.Add(' ');
SaveToFile(Ob, Path);
end;
procedure SavePlayers;
var
i: Integer;
begin
ClearFile(AppPath + 'Quickmarch\Players\GSPlayers.txt');
Index := GetArrayIndex(UserEd.Text, Players);
Changes(Index, [UserEd.Text, PassEd.Text, NickEd.Text, SkillEd.Text, LevelEd.Text, ActiveCom.Text, FoodCom.Text]);
WriteINI('Version', 'Ver', CurVersion, AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Int', 'Num', IntToStr(New), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Int', 'Num2', IntToStr(New2), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Int', 'Num3', IntToStr(New3), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Int', 'Num4', IntToStr(New4), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Int', 'Num5', IntToStr(New5), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Int', 'Num6', IntToStr(HowManyPlayers), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Int', 'Num7', IntToStr(AddPlayers), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Stats', 'ID', StatIdEd.Text, AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Stats', 'Pass', Encrypt(StatPassEd.Text), AppPath + 'Quickmarch\Players\GSPlayers.txt');
for i := 0 to New4 - 1 do
begin
WriteINI('Player ' + IntToStr(i+1), 'User', Players[i].Name, AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Player ' + IntToStr(i+1), 'Pass', Encrypt(Players[i].Pass), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Player ' + IntToStr(i+1), 'Nick', Players[i].Nick, AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Player ' + IntToStr(i+1), 'Active', BoolToStr(Players[i].Active), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Player ' + IntToStr(i+1), 'Food', BoolToStr(Players[i].Booleans[1]), AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Player ' + IntToStr(i+1), 'Skill', Players[i].Strings[0], AppPath + 'Quickmarch\Players\GSPlayers.txt');
WriteINI('Player ' + IntToStr(i+1), 'Level', IntToStr(Players[i].Integers[0]), AppPath + 'Quickmarch\Players\GSPlayers.txt');
end;
end;
procedure DrawImages(Sender: TObject);
var
GoblinsText: Integer;
Canvas: TCanvas;
begin
GoblinsText := BitmapFromString(465, 49, 'beNrtnUFrHDkQhReW' +
'BNYsGIJhw4JhyULCgmHJJZdcfMklF///f7MPCh5FlaRpz0zPju1v+' +
'AiTtlotlVxPaqkkP/379AQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA' +
'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADwVvjx45/v3/8W+nKWfJ5' +
'748+fD3GjvhxMfJainqWaj4+fz2iEy7DdeldeEYCXiCTu/v7DL+lz' +
'd/f7Ft0b8uXLH5HJEToQN25x8EipZ12DuW5u3pcyH22Ey7DdeldeE' +
'YCXqLe3t79ZOkR810Ukd22u8snFRnIBYMjHj7fhU1+/3seVh4c/Tx' +
'G0y0iuxuHCZb4YemgUUlYq5lJvheQCwBaV05tyvh4vzllDrk1y/xc' +
'eHz8PxcpV9rwukgsAiyFuWUnR6HF4/Y1Lrge0xSwuuYe+SC4AzFxP' +
'wntG9XvFkuuqlbVFDW7LRAeSCwAzifPYLC8SyddEH+VKXj59uguF0' +
'ZeeoDipVEiSPku801xulFD/ljLc3384Rc8XFlsbQTfq0VFm3dujQV' +
'TC+Gm2f1wZBqGJb9/+ijxVtWGeudiR0tWfSa4yUVa5nAvJVWs6sUw' +
'9M2xpKSXz7wM+CG8Kzx5sVyG5SV+pL76Th4Jlcf/du19nAnLeiIVY' +
'5IpQNy94zQr8rHAFVeFgRYrkloiyuL30Pjm9co6nzKwxrNTNzfthk' +
'XqTzZZHdbvjVRy14sL3X55cyIVh87OyKdy/ALwR7OYbJ2ztLxqlaI' +
'gl7PjZ15ytHFZeqf9KNOTmFqvZeGwPyY0vKrlKK5VwF3D0Hgr3U6r' +
'IIl7CRgjFk8X0xBhDDtcr8wKcpUxfesSviFrYtqpaSGW3rfU2mkwF' +
'zqKarafiuYFUyBgYZzktA2zLpr4rsR/UW8TXc4aqApILb1Zy+1YjY' +
'xeevVPbjyxizrYMBWfL/ftJbgl+iwqeHtBr1V0MmG2Erq4WzGH6kE' +
'SVf9Yp+OnZth5+FxXtBVBKq25OHO1YmswdRJHcyKEsAUQVuuzneoW' +
'e43qA5HahKOoXsQ09bMzObvFxJl3Wwq9nmyz2kNzFoOvEaXCPRVWd' +
'/kZvI/Sx3HB2NFu+r2Z2xS4y7gFttq1VtGigRdtGWPRE1uc+xC2dg' +
'p4S15WgG7x3EwBI7kJyQ2G6p+e3+JJJV05768Ukt09inGvbWplQle' +
'LlZ9kIffJhLbmLiZeFrA2zDbXsTeZMbIRFTKBnDBbavrbtcB4DAMl' +
'dq9/Ca0o+W7IdvjWfXXK3y8Ipkbp5uGu1XPQ7a8ldv3fbRDEXmvFw' +
'1LZd1LTMQiyazHMLxbbKoRTAHVAReXcleBwguReWXOczFNU9ls/2l' +
'tx4K/eq3BYRW0vu+jQhm2jx2dJkYZ8tpfUTh/Pkw08x+4lRIgCvT3' +
'K7xO0kuX6lfaGSOzvz0BPanus+WnK3BwaXhc6+4rmr5KqXmRWgTNg' +
'yqwBQvKnPN+49sXCxILHzSu7i3hK/urfknmiiU8bkC9ueuNMN4HXj' +
'MWdfYfEMXlk+G74ezpbP+mjwwstnr09y3WS9l5S1y4bBmN3tTdbjE' +
'7x81qc1+laIWD4bHnmkfJRnKRuSC9CXQoqveb7ulCCxLgvhv7MgqO' +
'uX3KjpMNvQNy/Y7SS5iyCxPhscTdbXEHsUn0OmSyCEG3dLkNhs2hb' +
'JBeghmlkG7VNZ/Q5uhejnFuYV/OzXs01b1y+5rmypgq9vOUnsRMmd' +
'bYXwHorejtmeeXdbNkIoebFY3i92cCtEfzNCcgEWIazyo7Irs7iPT' +
'3qM/bPCV4YbfkN1Y0Oot+Qv/tjE9UtuHvWp7vEi73CFYZDY2SXX8h' +
'gNEWVwhFgxnd9iYmuw/o1NxN0INn7s4fVu7r4VIot5/M7kX5tucyQ' +
'XoMhI/8sy3oyfXVgprbH5MzsuIG+MHY57X2KQWDlzZla1XSV39seA' +
'+uvD7GShoRF6e4Wkz461OWgEJBdg5sI+KlCiGm+scf5h36Hpw/cic' +
'ZfHfA6hbvehhXrEOujUp85u2Rb6rMMbt9+40Vw+tDCM0HMrhzEe/N' +
'Ei/WIXhssgIy+M5sZVsmiCmRGUiRs35nUXBcuNG4c9HtFSAAAAAAA' +
'AAAAAAAAAAAAAAAAAAAAAAC+A/wCa0F7s');
Canvas := GetBitmapCanvas(GoblinsText);
CopyCanvas(Canvas, frmDesign.Canvas, 0, 0, 465, 49, 0, 0, 465, 49);
end;
procedure CloseMe(Sender: TObject; var Action: TCloseAction);
begin
if GetArrayLength(Players) = 0 then Exit;
if Show2 then
begin
case MyMessageDialog('Would you like to save your players?', mtConfirmation, [mbYes, mbNo, mbCancel], ['Yes', 'No', 'Cancel'], 'Goblin Shredder ©') of
mrYes:
begin
SavePlayers;
frmDesign.ModalResult := mrOk;
end;
mrCancel:
begin
frmDesign.ModalResult := mrNone;
Exit;
end;
end;
frmDesign.ModalResult := mrOk;
end;
end;
//Based on the one in CAutoRespond.scar
procedure RemoveArrayItem(Index : Integer; var Arr : array of TUser);
var
I, H : Integer;
begin
H := High(Arr);
SetArrayLength(Arr, Length(Arr) + 1);
for I := Index to H - 1 do
Arr[I] := Arr[I + 1];
SetArrayLength(Arr, H);
end;
var
D: Integer;
procedure DeletePlayer(Sender: TObject);
begin
try
New := New - 1;
New2 := New2 - 1;
New3 := New3 - 1;
New5 := New5 - 1;
AddPlayers := AddPlayers - 1;
New4 := New4 - 1;
HowManyPlayers := HowManyPlayers - 1;
RemoveArrayItem(PlayerListScr.ItemIndex, Players);
Clear;
PlayerListScr.Items.Delete(PlayerListScr.ItemIndex);
if (New5 = 0) then
begin
DelBTN.Enabled := False;
Exit;
end;
if Index = New5 then
begin
DelBTN.Enabled := False;
Index := Index - 1;
UserEd.Text := Players[Index].Name;
PassEd.Text := Players[Index].Pass;
NickEd.Text := Players[Index].Nick;
LevelEd.Text := IntToStr(Players[Index].Integers[0]);
SkillEd.Text := Players[Index].Strings[0];
ActiveCom.Text := BoolToStr(Players[Index].Active);
FoodCom.Text := BoolToStr(Players[Index].Booleans[1]);
Exit;
end;
UserEd.Text := Players[Index].Name;
PassEd.Text := Players[Index].Pass;
NickEd.Text := Players[Index].Nick;
LevelEd.Text := IntToStr(Players[Index].Integers[0]);
SkillEd.Text := Players[Index].Strings[0];
ActiveCom.Text := BoolToStr(Players[Index].Active);
FoodCom.Text := BoolToStr(Players[Index].Booleans[1]);
DelBTN.Enabled := False;
except
MyMessageDialog('Please select a player to delete', mtWarning, [mbOk], ['OK'], 'Goblin Shredder ©');
New2 := New2 + 1;
New := New + 1;
New3 := New3 + 1;
New5 := New5 + 1;
New4 := New4 + 1;
HowManyPlayers := HowManyPlayers + 1;
AddPlayers := AddPlayers + 1;
Exit;
end;
end;
procedure PopupStuff(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
RightClick: TMouseButton;
P: TPoint;
Pop: TPopupMenu;
Items: array [0..2] of TMenuItem;
begin
RightClick := Button;
if RightClick then
begin
P := PlayerListScr.ClientToScreen(IntToPoint(x, y));
Pop := TPopupMenu.Create(frmDesign);
Items[0] := TMenuItem.Create(Pop);
Items[0].Caption := 'Add Player';
Items[0].OnClick := @AddPlayer;
Pop.Items.Add(Items[0]);
if PlayerListScr.ItemIndex > - 1 then
begin
Items[1] := TMenuItem.Create(Pop);
Items[1].Caption := 'Delete Player';
Items[1].OnClick := @DeletePlayer;
Pop.Items.Add(Items[1]);
end;
Items[2] := TMenuItem.Create(Pop);
Items[2].Caption := 'Cancel';
Pop.Items.Add(Items[2]);
Pop.Popup(P.x, P.y);
end;
end;
procedure ClickPlayer;
begin
UserEd.Text := Players[PlayerListScr.ItemIndex].Name;
PassEd.Text := Players[PlayerListScr.ItemIndex].Pass;
NickEd.Text := Players[PlayerListScr.ItemIndex].Nick;
LevelEd.Text := IntToStr(Players[PlayerListScr.ItemIndex].Integers[0]);
SkillEd.Text := Players[PlayerListScr.ItemIndex].Strings[0];
ActiveCom.Text := BoolToStr(Players[PlayerListScr.ItemIndex].Active);
FoodCom.Text := BoolToStr(Players[PlayerListScr.ItemIndex].Booleans[1]);
end;
procedure ListPress(Sender: TObject);
var
i, ii: Integer;
begin
if (PlayerListScr.ItemIndex = - 1) then Exit;
i := PlayerListScr.ItemIndex;
DelBTN.Enabled := True;
if GetArrayIndex(UserEd.Text, Players) <> Index then
begin
for ii := 0 to High(Players) do
begin
if UserEd.Text = Players[ii].Name then
begin
Index := i;
ClickPlayer;
MyMessageDialog('You have already added that player', mtWarning, [mbOk], ['OK'], 'Goblin Shredder ©');
Exit;
end;
end;
end;
if ErrorType <> '' then Exit;
D := PlayerListScr.ItemIndex;
Changes(Index, [UserEd.Text, PassEd.Text, NickEd.Text, SkillEd.Text, LevelEd.Text, ActiveCom.Text, FoodCom.Text]);
try
ClickPlayer;
Index := GetArrayIndex(UserEd.Text, Players);
FixList;
PlayerListScr.ItemIndex := D;
except
MyMessageDialog(ErrorType, mtWarning, [mbOk], ['OK'], 'Goblin Shredder ©');
Exit;
end;
end;
procedure KeysPress(Sender: TObject; var Key: Char);
begin
if Key= Chr(27) then frmDesign.Close;
if Key= Chr(13) then RunPlayers(Send);
end;
function MyMessageDialog(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; Captions: array of string; CaptionDlg: string): Integer;
var
aMsgDlg: TForm;
i: Integer;
dlgButton: TButton;
CaptionIndex: Integer;
begin
aMsgDlg := CreateMessageDialog(Msg, DlgType, Buttons);
aMsgDlg.Caption := CaptionDlg;
captionIndex := 0;
for i := 0 to aMsgDlg.ComponentCount - 1 do
begin
if (aMsgDlg.Components[i] is TButton) then
begin
dlgButton := TButton(aMsgDlg.Components[i]);
if CaptionIndex > High(Captions) then Break;
dlgButton.Caption := Captions[CaptionIndex];
Inc(CaptionIndex);
end;
end;
Result := aMsgDlg.ShowModal;
end;
function Explode(Delimiter : string; Str : string) : array of string;
var
DelimPos, i : integer;
Arr1 : array of string;
begin
SetArrayLength(Arr1, 100000);
i := 0;
repeat
if (pos(Delimiter, Str) = 0) then Break;
DelimPos := pos(Delimiter, Str);
Arr1[i] := Replace((copy(Str,0,DelimPos)),Delimiter,'');
Delete(Str,1,DelimPos);
i := i + 1;
until(pos(Delimiter, Str) = 0);
Arr1[i] := Str;
SetArrayLength(Arr1, i+1);
Result := Arr1;
end;
procedure GetNews(Web: String);
var
i: Integer;
s: String;
News: TStringArray;
begin
ClearReport;
s := GetPage(Web);
News := Explode('$', s); //Idea from MK
for i := 0 to GetArrayLength(News) - 1 do
begin
WriteLn(News[i]);
end;
end;
procedure About(Sender: TObject);
var
s: String;
begin
s := 'Goblin Shredder © Copyright 2008 - 2009' + #13 + 'This script was created in SCAR Divi ' +
'3.15' + #13 + #13 + 'Developed By: Quickmarch';
case MyMessageDialog(s, mtInformation, [mbYes, mbYesToAll, mbNo], ['OK', 'News', 'Help'], 'Goblin Shredder ©') of
mrNo: GetNews('http://www.freewebs.com/quickmarch/NewsGS.txt');
mrYesToAll: OpenWebPage('http://www.srl-forums.com/forum/goblin-shredder-t41659.html');
end;
end;
var
System1, System2, System3: Integer;
procedure Show(Sender: TObject);
begin
System2 := GetSystemTime;
System3 := System2 - System1;
WriteLn('');
if CheckForUpdates then VersionChecker;
if FileExists(AppPath + 'Quickmarch\Players\GSPlayers.txt') then
begin
if (INIContains('Version', 'Ver', AppPath + 'Quickmarch\Players\GSPlayers.txt')) and (ReadINI('Version', 'Ver', AppPath + 'Quickmarch\Players\GSPlayers.txt') = CurVersion) then
LoadPlayers
else
MyMessageDialog('Couldn''t load your players because of the new version', mtWarning, [mbYes], ['OK'], 'Goblin Shredder ©');
end;
Index := GetArrayLength(Players) - 1;
if Index = - 1 then Index := 0;
WriteLn('Form compiled in: '+ IntToStr(System3) +' Milliseconds');
end;
procedure InitForm;
begin
//Cleaned up the form code
Show2 := True;
frmDesign := CreateForm;
with frmDesign do
begin
SetBounds(260, 138, 470, 430);
Caption := 'Player Setup - Quickmarch';
Color := clDarkOliveGreen;
Font.Color := clWindowText;
Font.Height := -12;
Font.Name := 'MS Sans Serif';
Font.Style := [];
Visible := False;
PixelsPerInch := 96;
BorderIcons := [biMinimize, biSystemMenu];
Position := poScreenCenter;
BorderStyle := bsSingle;
OnPaint := @DrawImages;
OnClose := @CloseMe;
OnShow := @Show;
KeyPreview := True;
OnKeyPress := @KeysPress;
end;
Author := TLabel.Create(frmDesign);
with Author do
begin
Parent := frmDesign;
Left := 350;
Top := 5;
Width := 36;
Height := 13;
Caption := 'Script by: Quickmarch';
end;
Ver := TLabel.Create(frmDesign);
with Ver do
begin
Parent := frmDesign;
Left := 5;
Top := 5;
Width := 36;
Height := 13;
Caption := 'Your version: '+CurVersion;
end;
StatIdLab := TLabel.Create(frmDesign);
with StatIdLab do
begin
Parent := frmDesign;
Left := 260;
Top := 80;
Width := 36;
Height := 13;
Caption := 'Stats ID';
end;
StatPassLab := TLabel.Create(frmDesign);
with StatPassLab do
begin
Parent := frmDesign;
Left := 260;
Top := 104;
Width := 73;
Height := 13;
Caption := 'Stats Password';
end;
CurPlayerSet := TGroupBox.Create(frmDesign);
with CurPlayerSet do
begin
Parent := frmDesign;
Left := 8;
Top := 56;
Width := 233;
Height := 200;
Caption := 'Current Player';
TabOrder := 0;
end;
UserTxt := TLabel.Create(CurPlayerSet);
with UserTxt do
begin
Parent := CurPlayerSet;
Left := 16;
Top := 32;
Width := 48;
Height := 13;
Caption := 'Username';
end;
PassTxt := TLabel.Create(CurPlayerSet);
with PassTxt do
begin
Parent := CurPlayerSet;
Left := 16;
Top := 64;
Width := 46;
Height := 13;
Caption := 'Password';
end;
NickTxt := TLabel.Create(CurPlayerSet);
with NickTxt do
begin
Parent := CurPlayerSet;
Left := 16;
Top := 96;
Width := 22;
Height := 13;
Caption := 'Nick';
end;
FoodTxt := TLabel.Create(CurPlayerSet);
with FoodTxt do
begin
Parent := CurPlayerSet;
Left := 16;
Top := 128;
Width := 30;
Height := 13;
Caption := 'Eat Food';
end;
ActiveTxt := TLabel.Create(CurPlayerSet);
with ActiveTxt do
begin
Parent := CurPlayerSet;
Left := 16;
Top := 160;
Width := 30;
Height := 13;
Caption := 'Active';
end;
UserEd := TEdit.Create(CurPlayerSet);
with UserEd do
begin
Parent := CurPlayerSet;
Left := 88;
Top := 32;
Width := 113;
Height := 21;
TabOrder := 0;
MaxLength := 12;
Hint := 'Username';
ShowHint := True;
end;
PassEd := TEdit.Create(CurPlayerSet);
with PassEd do
begin
Parent := CurPlayerSet;
Left := 88;
Top := 64;
Width := 113;
Height := 21;
TabOrder := 1;
PasswordChar := '*';
Hint := 'Password';
ShowHint := True;
end;
NickEd := TEdit.Create(CurPlayerSet);
with NickEd do
begin
Parent := CurPlayerSet;
Left := 88;
Top := 96;
Width := 113;
Height := 21;
TabOrder := 2;
MaxLength := 4;
Hint := '3/4 Letters of your Username';
ShowHint := True;
end;
FoodCom := TComboBox.Create(CurPlayerSet);
with FoodCom do
begin
Parent := CurPlayerSet;
Left := 88;
Top := 128;
Width := 113;
Height := 21;
ItemHeight := 13;
TabOrder := 3;
Text := 'Food';
with Items do
begin
Add('True');
Add('False');
end;
MaxLength := 5;
Hint := 'Eat Food';
ShowHint := True;
end;
ActiveCom := TComboBox.Create(CurPlayerSet);
with ActiveCom do
begin
Parent := CurPlayerSet;
Left := 88;
Top := 160;
Width := 113;
Height := 21;
ItemHeight := 13;
TabOrder := 4;
Text := 'Active';
with Items do
begin
Add('True');
Add('False');
end;
MaxLength := 5;
Hint := 'Use this player';
ShowHint := True;
end;
SkillToTrain := TGroupBox.Create(frmDesign);
with SkillToTrain do
begin
Parent := frmDesign;
Left := 8;
Top := 260;
Width := 233;
Height := 95;
Caption := 'Skill to Train';
end;
SkillLab := TLabel.Create(SkillToTrain);
with SkillLab do
begin
Parent := SkillToTrain;
Left := 16;
Top := 27;
Width := 31;
Height := 13;
Caption := 'Skill';
end;
LevelLab := TLabel.Create(SkillToTrain);
with LevelLab do
begin
Parent := SkillToTrain;
Left := 16;
Top := 53;
Width := 40;
Height := 13;
Caption := 'Level';
end;
SkillEd := TEdit.Create(SkillToTrain);
with SkillEd do
begin
Parent := SkillToTrain;
Left := 88;
Top := 25;
Width := 113;
Height := 21;
TabOrder := 6;
Text := 'Attack';
MaxLength := Length('Strength');
Hint := 'Skill to Train';
ShowHint := True;
end;
LevelEd := TEdit.Create(SkillToTrain);
with LevelEd do
begin
Parent := SkillToTrain;
Left := 151;
Top := 50;
Width := 50;
Height := 21;
TabOrder := 7;
MaxLength := 2;
Hint := 'Level to get to';
ShowHint := True;
end;
StatSet := TGroupBox.Create(frmDesign);
with StatSet do
begin
Parent := frmDesign;
Left := 248;
Top := 56;
Width := 209;
Height := 81;
TabOrder := 2;
Caption := 'SRL Stats';
end;
StatIdEd := TEdit.Create(StatSet);
with StatIdEd do
begin
Parent := StatSet;
Left := 98;
Top := 16;
Width := 97;
Height := 21;
TabOrder := 0;
MaxLength := 4;
Hint := 'SRL Stats ID';
ShowHint := True;
end;
StatPassEd := TEdit.Create(StatSet);
with StatPassEd do
begin
Parent := StatSet;
Left := 98;
Top := 48;
Width := 97;
Height := 21;
TabOrder := 1;
PasswordChar := '*';
Hint := 'SRL Stats Password';
ShowHint := True;
end;
PlayerListSet := TGroupBox.Create(frmDesign);
with PlayerListSet do
begin
Parent := frmDesign;
Left := 248;
Top := 140;
Width := 209;
Height := 215;
Caption := 'Player List';
TabOrder := 3;
end;
PlayerListScr := TListBox.Create(PlayerListSet);
with PlayerListScr do
begin
Parent := PlayerListSet;
Left := 8;
Top := 16;
Width := 193;
Height := 190;
ItemHeight := 13;
TabOrder := 0;
OnClick := @ListPress;
OnMouseDown := @PopupStuff;
end;
DelBTN := TButton.Create(frmDesign);
with DelBTN do
begin
Parent := frmDesign;
Left := 360;
Top := 365;
Width := 97;
Height := 25;
Caption := 'Delete';
TabOrder := 4;
OnClick := @DeletePlayer;
Enabled := False;
end;
AddBTN := TButton.Create(frmDesign);
with AddBTN do
begin
Parent := frmDesign;
Left := 248;
Top := 365;
Width := 97;
Height := 25;
Caption := 'Add';
TabOrder := 5;
OnClick := @AddPlayer;
end;
RunBTN := TButton.Create(frmDesign);
with RunBTN do
begin
Parent := frmDesign;
Left := 8;
Top := 365;
Width := 97;
Height := 25;
Caption := 'Start';
TabOrder := 8;
OnClick := @RunPlayers;
end;
ViewSiteBTN := TButton.Create(frmDesign);
with ViewSiteBTN do
begin
Parent := frmDesign;
Left := 144;
Top := 365;
Width := 97;
Height := 25;
Caption := 'About';
TabOrder := 9;
OnClick := @About;
end;
end;
procedure SafeInitForm;
var
v : TVariantArray;
begin
SetArrayLength(v, 0);
ThreadSafeCall('InitForm', v);
end;
procedure ShowInitFormModal;
begin
frmDesign.ShowModal;
end;
procedure SafeShowInitFormModal;
var
v : TVariantArray;
begin
SetArrayLength(v, 0);
ThreadSafeCall('ShowInitFormModal', v);
end;
procedure MainInitForm;
begin
try
SafeInitForm;
SafeShowInitFormModal;
finally
FreeForm(frmDesign);
except
WriteLn('There Was An Error');
end;
end;
procedure MainLoop;
var
T: Integer;
begin
if not(LoggedIn) then NextPlayer(False);
MarkTime(T);
FindNormalRandoms;
SetRun(True);
SetAngle(True);
MakeCompass('N');
AntiRandoms;
PlayerOptions;
repeat
AttackGoblins;
until(TimeFromMark(T) > 60000 * 10);
WriteLn('It has been 10 minutes; switching players');
NextPlayer(True);
SetLoc('Goblins');
Proggy;
SaveProggy;
end;
begin
CurVersion := '0.8.6'; //DO NOT TOUCH!!
ScriptID := '1080'; //DO NOT TOUCH!!
ClearDebug;
ClearReport;
Disguise('Goblin Shredder © - Quickmarch');
GetApplication.Title := 'Goblin Shredder ©';
SetupDTMS;
SetupSRL;
MouseSpeed := 23;
Logo;
System1 := GetSystemTime;
MainInitForm;
if (Start) then
begin
SetLocations;
SmartSetupEx(World_SMART, False, True, False);
Wait(1000);
SetTargetDC(SmartGetDC);
ActivateClient;
if LoggedIn then Logout;
LoginPlayer;
repeat
if not LoggedIn then Break;
MainLoop;
until(AllPlayersInactive);
end;
end.