Gaia Online Multi-Threaded ID Scanner

source.pas

// Old stuff I'm preserving on git

//Made by Lan @ www.protozoid.lrn2prgm.com - v1.1

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, ShellAPI, XPMan, ExtCtrls, IdThreadComponent, INIfiles;

type
  ThForm = class(TForm)
    hMemo: TMemo;
    hStart: TButton;
    hPause: TButton;
    hInput: TEdit;
    hLbl: TLabel;
    hSepLbl: TLabel;
    hInput2: TEdit;
    hSave: TButton;
    hXPManifest: TXPManifest;
    hLinkLabel: TLabel;
    hIdHTTP: TIdHTTP;
    hThread: TIdThreadComponent;
    procedure hLinkLabelClick(Sender: TObject);
    procedure hPauseClick(Sender: TObject);
    procedure hSaveClick(Sender: TObject);
    procedure hStartClick(Sender: TObject);
    procedure Thread(Sender: TIdCustomThreadComponent);
    procedure Close(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Save;
    function IDToUser(iID: integer): String;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TDynamicArray = array of string;

const
  CRLF = #13#10;

var
  hForm: ThForm;
  iCurrent: integer;
  fStartBool: bool = False;
  fPauseBool: bool = False;
  sFormat: string;
  SettingsINI: TIniFile;

implementation

{$R *.dfm}

function Execute(sShell: string): Boolean;
begin
 Result := True;
 if sShell = '' then
 begin
  Result := False;
  Exit;
 end;
 ShellExecute(0, 'open', PChar(sShell), nil, nil, SW_SHOWNORMAL);
end;

function InStr(sIni: string; sSubStr: string): Boolean;
var
  iPos: integer;
begin
  iPos := Pos(sSubStr, sIni);
  if iPos <> 0 then
    Result := True
  else
    Result := False;
end;

function SplitString(const aSeparator, aString: string; aMax: integer = 0):
  TDynamicArray;
var
  i, strt, cnt: Integer;
  sepLen: Integer;
  procedure AddString(aEnd: Integer = -1);
  var
    endPos: Integer;
  begin
    if (aEnd = -1) then
      endPos := i
    else
      endPos := aEnd + 1;
    if (strt < endPos) then
      result[cnt] := Copy(aString, strt, endPos - strt)
    else
      result[cnt] := '';
    Inc(cnt);
  end;
begin
  if (aString = '') or (aMax < 0) then
  begin
    SetLength(result, 0);
    Exit;
  end;
  if (aSeparator = '') then
  begin
    SetLength(result, 1);
    result[0] := aString;
    Exit;
  end;
  sepLen := Length(aSeparator);
  SetLength(result, (Length(aString) div sepLen) + 1);
  i := 1;
  strt := i;
  cnt := 0;
  while (i <= (Length(aString) - sepLen + 1)) do
  begin
    if (aString[i] = aSeparator[1]) then
      if (Copy(aString, i, sepLen) = aSeparator) then
      begin
        AddString;
        if (cnt = aMax) then
        begin
          SetLength(result, cnt);
          Exit;
        end;
        Inc(i, sepLen - 1);
        strt := i + 1;
      end;
    Inc(i);
  end;
  AddString(Length(aString));
  SetLength(result, cnt);
end;

function StringToCaseSelect(Selector: string; CaseList: array of string):
  Integer;
var
  cnt: integer;
begin
  Result := -1;
  for cnt := 0 to Length(CaseList) - 1 do
  begin
    if CompareText(Selector, CaseList[cnt]) = 0 then
    begin
      Result := cnt;
      Break;
    end;
  end;
end;

function ThForm.IDToUser(iID: integer): String;
var
  sResponse: string;
  aGSIArray: TDynamicArray;
begin
  sResponse := hIdHTTP.Get('http://gaiaonline.com/chat/gsi/index.php?m=102' +
    Chr(01) + IntToStr(iID));
  if not InStr(sResponse, 'ava/') then
  begin
    aGSIArray := SplitString(Chr(01), sResponse);
    Result := aGSIArray[3];
  end
  else
  begin
    aGSIArray := SplitString('ava/', sResponse);
    Result := StringReplace(StringReplace(aGSIArray[0], IntToStr(102) + Char(01)
      +
      Char(05) + Char(01) + IntToStr(iID) + Char(01), '',
      [rfReplaceAll, rfIgnoreCase]), Chr(01), '', [rfReplaceAll, rfIgnoreCase]);
  end;
end;

procedure ThForm.Save();
var
  hFileHandle: TextFile;
begin
  AssignFile(hFileHandle, 'Users.txt');
  ReWrite(hFileHandle);
  Write(hFileHandle, hMemo.Text);
  CloseFile(hFileHandle);
end;

procedure ThForm.hLinkLabelClick(Sender: TObject);
begin
  Execute('http://www.protozoid.lrn2prgm.com');
end;

procedure ThForm.hPauseClick(Sender: TObject);
begin
  if fPausebool = False then
  begin
    hThread.Active := False;
    hPause.Caption := 'Resume';
    hSave.Enabled := True;
    fPausebool := True;
  end
  else
  begin
    hThread.Active := True;
    hPause.Caption := 'Pause';
    hSave.Enabled := False;
    fPausebool := False;
  end;
end;

procedure ThForm.hSaveClick(Sender: TObject);
begin
  Save;
  ShowMessage('File successfully saved!' + CRLF + CRLF +
    'Please check the directory in which this ' +
    'program is being ran from as there should be an accompanied file under the handle ' +
    'of "Users.txt" that contains the data gathered from this app. ' +
    'Otherwise, please consult the author or refer to the readme ' +
    'included in the distribution of this program for further instructions.');
end;

procedure ThForm.hStartClick(Sender: TObject);
begin
  if hInput.Text = '' then
  begin
    hInput2.Text := '';
    ShowMessage('Error! No integer(s) specified in input #1 and/or #2.');
    Exit;
  end
  else if hInput2.Text = '' then
  begin
    hInput.Text := '';
    ShowMessage('Error! No integer(s) specified in input #1 and/or #2.');
    Exit;
  end;
  if StrToInt(hInput.Text) < 2 then
  begin
    ShowMessage('Error! Initial integer must be greater than or equal to 2.');
    Exit;
  end
  else if StrToInt(hInput2.Text) < StrToInt(hInput.Text) then
  begin
    ShowMessage('Error! Secondary integer must be greater than the first.');
    Exit;
  end
  else if StrToInt(hInput2.Text) = StrToInt(hInput.Text) then
  begin
    ShowMessage('Error! Initial and secondary inputs can not be equivalent.');
    Exit;
  end;
  if fStartbool = False then
  begin
    hMemo.Text := '';
    hPause.Enabled := True;
    hSave.Enabled := False;
    hStart.Caption := 'Stop';
    iCurrent := 0;
    if not FileExists('settings.ini') then
      sFormat := 'default'
    else
    begin
      try
        SettingsINI := TIniFile.Create(ExtractFilePath(Application.ExeName) +
          'settings.ini');
        sFormat := SettingsINI.ReadString('Format', 'Format', 'Format');
      finally
      end;
    end;
    hThread.Active := True;
    fStartbool := True;
  end
  else
  begin
    hPause.Enabled := False;
    hSave.Enabled := True;
    hStart.Caption := 'Start';
    hThread.Active := False;
    fStartbool := False;
  end;
end;

procedure ThForm.Thread(Sender: TIdCustomThreadComponent);
var
  i, iInit, iSecondary: integer;
  sUser, sData: string;
begin
  if not hThread.Active then
  begin
    Exit;
    hThread.Terminate;
  end;
  iInit := StrToInt(hInput.Text);
  iSecondary := StrToInt(hInput2.Text);
  for i := iInit + iCurrent to iSecondary do
  begin
    if not hThread.Active then
    begin
      Exit;
      hThread.Terminate;
    end;
    try
      sUser := IDToUser(i);
    except
      on e: Exception do
    end;
    if sUser = 'No data available' then
    else
    begin
      case StringToCaseSelect(sFormat, ['default', 'backwards', 'parenthesis',
        'colon', 'none', 'n/a', 'askerisk']) of
        0: sData := sUser + ' — ' + IntToStr(i);
        1: sData := IntToStr(i) + ' — ' + sUser;
        2: sData := sUser + ' — ' + '(' + IntToStr(i) + ')';
        3: sData := sUser + ': ' + IntToStr(i);
        4, 5: sData := sUser;
        6: sData := sUser + ' * ' + IntToStr(i);
      else
        sData := sUser + sFormat + IntToStr(i);
      end;
      if InStr(hMemo.Text, sData) then
      else
      begin
        hMemo.Lines.Append(sData);
        if i >= iSecondary then
        begin
          hStart.Caption := 'Start';
          hPause.Enabled := False;
          hSave.Enabled := True;
          fStartbool := False;
          hThread.Terminate;
          Exit;
        end;
        iCurrent := iCurrent + 1;
      end;
    end;
  end;
end;

procedure ThForm.Close(Sender: TObject; var Action: TCloseAction);
begin
  if fStartbool then
  begin
    with hThread do
    begin
      Terminate;
      Free;
    end;
  end;
end;

procedure ThForm.FormCreate(Sender: TObject);
begin
  if not FileExists('settings.ini') then
  begin
    try
      SettingsINI := TIniFile.Create(ExtractFilePath(Application.ExeName) +
        'settings.ini');
      SettingsINI.WriteString('Format', 'Format', 'default');
    finally
      SettingsINI.Free;
    end;
  end;
end;

end.