SRL Archive - Non-RuneScape Scripts

This script was all written by Frement, i take no credit for it (i just added some small checks to it).

Idea came around when i was looking for creating a script that would track world population decrease and increase on oldschool rs, using Simba.

After i got stuck with the project for a few days, i asked Frement to help me out and show me some small examples that would help me progress and learn.. He went ahead and wrote the entire script in 10 minutes, which i can't thank him enough for it (but on the other hand, i would of loved to accomplish this on my own :().

Anyway, am posting it here - not expecting anyone to find use for it directly on Runescape (Unless you clan pk and wanna hunt clans that avoid fighting you, this is awesome for tracking their worlds), but, this could help anyone learn slightly advanced ways to grab, handle, trim, pars, loop and debug text data. (No include was used, just Simba).

i've added some small explanations to the script, based on what i understood (which isn't everything), i also want to take this opportunity and ask, if anyone got some cool functions for text/webpage handling (or different ways to implement the same concept) then please do share i find this subject quite intriguing.

Just to note, i only added the MsgBox and 'refresh' button (which isn't really a button) to the script, frement wrote the entire base code for it.


Pastebin V1: http://pastebin.com/GbKiu8QU
Pastebin V2: http://pastebin.com/rbMWiqtT

//V2
program worldtracker;

const
  ManualRefresh = false;
  Sleep_Intervals = 500;
  MinCount = 3;
  MsgBoxe = true;
  WarnCount = 6;
  XDistance = 70;
  Ydistance = 19;

type
  TWorld = record
    World, Players: Integer;
  end;

  TDisplay = record
    Surface: Integer;
    Width, Height: Integer;
  end;
  TWorldArray = array of TWorld;

function World(__World, __Players: Integer): TWorld;
begin
  Result.World := __World;
  Result.Players := __Players;
end;

var
  MSGBoXES: boolean;

function SortWorlds(Worlds: TWorldArray): TWorldArray;
var
  I, J, K: Integer;
begin
  K := 301;
  repeat
    for I := 0 to High(Worlds) do
    begin
      if (Worlds[I].World = K) then
      begin
        Inc(J);
        SetLength(Result, J);
        Result[J - 1] := Worlds[I];
      end;
    end;
    Inc(K);
  until (Length(Result) = Length(Worlds));
end;

function CalculateDifference(LC, CC: TWorldArray): TWorldArray;
var
  I: Integer;
begin
  SetLength(Result, Length(LC));
  for I := 0 to High(LC) do
  begin
    Result[I] := World(LC[I].World, CC[I].Players - LC[I].Players);
  end;
end;

function GetData: string;
var
  HTTPClient: Integer;
begin
  HTTPClient := InitializeHTTPClient(False);
  Result := GetHTTPPage(HTTPClient, 'http://oldschool.runescape.com/c=sn10L0LBNoo/slu');
  FreeHTTPClient(HTTPClient);
end;

function GetWorldData: TWorldArray;
var
  Pieces, WorldPieces: TStringArray;
  I, J: Integer;
begin
  Pieces := MultiBetween(GetData, 'e(', '");');
  for I := 0 to High(Pieces) do
  begin
    if (Pos('oldschool', Pieces[I]) > 0) then
    begin
      WorldPieces := Explode(',', Pieces[I]);
      Inc(J);
      SetLength(Result, J);
      Result[J - 1] := World(StrToInt(WorldPieces[0]), StrToInt(WorldPieces[4]));
    end;
  end;
end;

function Display(Width, Height: Integer): TDisplay;
begin
  Result.Surface := CreateBitmap(Width, Height);
  Result.Width := Width;
  Result.Height := Height;
  DisplayDebugImgWindow(Result.Width, Result.Height);
end;

procedure ClearDisplay(__Display: TDisplay);
begin
  FastDrawClear(__Display.Surface, clBlack);
end;

procedure FlushDisplay(__Display: TDisplay);
begin
  DrawBitmapDebugImg(__Display.Surface);
end;

procedure FreeDisplay(__Display: TDisplay);
begin
  FreeBitmap(__Display.Surface);
end;

procedure DisplayDrawText(__Display: TDisplay; Text, Font: string; X, Y, Color: Integer);
var
  TPA: TPointArray;
  W, H: Integer;
begin
  TPA := TPAFromText(Text, Font, W, H);
  OffsetTPA(TPA, Point(X, Y));
  DrawTPABitmap(__Display.Surface, TPA, Color);
end;

procedure AnsweredNo;
begin
  Writeln('Disabling MsgBox for world Tracking...');
  MSGBoXES := false;
end;

procedure DisplayDrawWorldInfo(__Display: TDisplay; World, Players, X, Y: Integer);
var
  TPA: TPointArray;
  WorldInfos, C, W, W2, H, H2: Integer;
begin
  if (Players < 0) then
    C := 255;
  if (Players = 0) or ((Players < MinCount) and (Players > 0)) then
    c := 16777215;
  if (Players >= MinCount) then
    C := 65280;
  TPA := TPAFromText(ToStr(World) + ':', 'SmallChars', W, H);
  OffsetTPA(TPA, Point(X, Y));
  DrawTPABitmap(__Display.Surface, TPA, clYellow);
  TPA := TPAFromText(ToStr(Players), 'SmallChars', W2, H2);
  OffsetTPA(TPA, Point(X + W + 2, Y));
  DrawTPABitmap(__Display.Surface, TPA, C);
  DisplayDrawText(__Display, 'Refresh', 'SmallChars', 120, 365, 16744192);
  if (Players >= WarnCount) and (MSGBoXES = true) and (World <> 301) and (world < 381) then
  begin
    WorldInfos := MessageBox('World:  ' + IntToSTr(World) + '  Just went up by:  ' + IntToStr(Players) + ' + Players', 'World Notice', 1);
    writeln(ToStr(WorldInfos));
    case (WorldInfos) of
      1: Exit;
      2: AnsweredNo;
    end;
  end;
  if (Players <= - WarnCount) and (MSGBoXES = true) and (World <> 301) and (world < 381) then
  begin
    WorldInfos := MessageBox('World:  ' + IntToSTr(World) + '  Just went DOWN by:  ' + IntToStr(Players) + ' - Players', 'World Notice', 1);
    writeln(ToStr(WorldInfos));
    case (WorldInfos) of
      1: Exit;
      2: AnsweredNo;
    end;
  end;
end;

procedure DrawWorldData(__Display: TDisplay; Worlds: TWorldArray);
var
  I, XOffset, YOffset, X, Y: Integer;
begin
  ClearDisplay(__Display);
  XOffset := XDistance;
  YOffset := YDistance;
  DisplayDrawText(__Display, ' OSRS World Tracker -    By Frement', 'SmallChars', 30, 10, 16744192);
  for I := 0 to High(Worlds) do
  begin
    DisplayDrawWorldInfo(__Display, Worlds[I].World, Worlds[I].Players, 20 + (XOffset * X), 40 + (YOffset * Y));
    Inc(Y);
    if (Y > 16) then
    begin
      Y := 0;
      Inc(X);
    end;
  end;
  FlushDisplay(__Display);
end;

var
  LastCount, CurrentCount, Diff: TWorldArray;
  __Display: TDisplay;
  Box1: Tbox;

function FindAndSetTarget(TitlePrefix: string; SetAsTarget: Boolean): Boolean;
var
  T: TSysProcArr;
  I: Integer;
begin
  T := GetProcesses;
  for I := High(T) downto 0 do
    if Pos(TitlePrefix, T[I].Title) <> 0 then
    begin
      Result := True;
      if SetAsTarget then
        SetTarget(T[I]);
      Exit;
    end;
end;

procedure GetRealMousePos(var X, Y: Integer);
var
  KMTarget, ITarget: Integer;
begin
  {$IFDEF LAPE}
  writeln('GetRealMousePos not implemented yet in SRL-5 Lape!');
  TerminateScript;
  {$ELSE}
  KMTarget := GetKeyMouseTarget;
  ITarget := GetImageTarget;
  FindAndSetTarget('DebugImgForm', True);
  GetTClient.IOManager.GetMousePos(X, Y);
  FreeTarget(GetImageTarget);
  SetKeyMouseTarget(KMTarget);
  SetImageTarget(ITarget);
  {$ENDIF}
end;

function IsRealMouseInBox(B: TBox): Boolean;
var
  P: TPoint;
begin
  GetRealMousePos(P.X, P.Y);
  if PointInBox(P, B) then
  begin
    if ismouseButtonDown(Mouse_left) then
      result := true;
  end;
end;

procedure OnTerminate;
begin
  FreeDisplay(__Display);
end;

procedure refresh;
begin
  cleardebug;
  LastCount := SortWorlds(GetWorldData);
  Sleep(Sleep_Intervals);
  CurrentCount := SortWorlds(GetWorldData);
  Diff := CalculateDifference(LastCount, CurrentCount);
  DrawWorldData(__Display, Diff);
  SetTargetBitmap(__Display.Surface);
end;

begin
  __Display := Display(300, 395);
  AddOnTerminate('OnTerminate');
  FindAndSetTarget('DebugImgForm', true);
  box1 := IntToBox(120, 380, 403, 350);
  MSGBoXES := MsgBoxe;
  repeat
    if (ManualRefresh = true) then
    begin
      if IsRealMouseInBox(box1) then
        refresh
    end
    else
      refresh;
    if IsRealMouseInBox(box1) then
      MSGBoXES := true;
  until (False);
end.

:)

Neat

getting a clblack is undeclared?
Edit: line 99 if that helps
"Exception in Script: Unknown declaration "clBlack" at line 99, column 36"