ratcrypt/sform.pas

unit sform;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CallExec, MMSystem, plugin, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdMultipartFormData,
  Menus, Spin, ExtCtrls, Buttons, TFlatButtonUnit;

type
{$IFNDEF RX_D4}
  TSysCharSet = set of Char;
{$ENDIF}
  TCharSet = TSysCharSet;

type
  TSetForm = class(TForm)
    YouAreAdded: TCheckBox;
    Label1: TLabel;
    TurnedOn: TCheckBox;
    IdHTTP: TIdHTTP;
    ListBox1: TListBox;
    pop: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    UseProxy: TCheckBox;
    Label2: TLabel;
    AvoidBan: TCheckBox;
    Label4: TLabel;
    ReadTMT: TSpinEdit;
    opend: TOpenDialog;
    FlatButton1: TFlatButton;
    FlatButton2: TFlatButton;
    FlatButton3: TFlatButton;
    procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure UseProxyClick(Sender: TObject);
    procedure AvoidBanClick(Sender: TObject);
    procedure ReadTMTChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FlatButton1Click(Sender: TObject);
    procedure FlatButton2Click(Sender: TObject);
    procedure FlatButton3Click(Sender: TObject);
  private
    procedure SetProxyParams;
    procedure SaveProxy;
    { Private declarations }
  public
    procedure ExecAntiBan;
    procedure StartTimer;
    function ExtractWord(N: Integer; const S: string; const WordDelims: TCharSet): string;
    { Public declarations }
  end;

var
  SetForm: TSetForm;
  glst: TStringList;
  MegaTimer: Cardinal;

  ba:integer;
  hico1, hico2, hico3, hico4, hico5: TIcon;

  num: string;
  delims: TCharSet = ['|'];
  delimq: TCharSet = [':'];
  gotcha, status, gdt: string;
  mpf: TIdMultiPartFormDataStream;

  GlobalProxy: integer;
  StartProxy: integer;
  ReadTMTnotice, ifPOST: boolean;
  wintext: string;

const
  stname = '\InvisCheck.ini';
  proxname = '\InvisCheckProxies.ini';
  namepl = 'InvisCheck @ KanIcq.ru';

implementation

{$R *.dfm}

procedure TSetForm.SaveProxy;
var outs: TStringList;
begin
 outs := TStringList.Create;
 outs.Add(BoolToStr(UseProxy.Checked));
 outs.Add(BoolToStr(AvoidBan.Checked));
 outs.Add(IntToStr(ReadTMT.value));
 outs.AddStrings(ListBox1.items);
 outs.SaveToFile(RQ_GetUserPath + proxname);
 outs.Free;
end;

function ByteToStatus(statusbyte: byte): string;
begin
case statusByte of
  PS_ONLINE: result:='<27> <20><>';
  PS_OCCUPIED: result:='<27><>';
  PS_DND: result:='<27><> <20><>';
  PS_NA: result:='<27><>';
  PS_AWAY: result:='<27><>';
  PS_F4C: result:='<27><>';
  PS_OFFLINE: result:='<27><>';
  PS_UNKNOWN: result:='<27><>';
  PS_EVIL: result:='<27><>';
  PS_DEPRESSION: result:='<27><>';
end;
end;

function WordPosition(const N: Integer; const S: string;
  const WordDelims: TCharSet): Integer;
var
  Count, I: Integer;
begin
  Count := 0;
  I := 1;
  Result := 0;
  while (I <= Length(S)) and (Count <> N) do begin
    { skip over delimiters }
    while (I <= Length(S)) and (S[I] in WordDelims) do Inc(I);
    { if we're not beyond end of S, we're at the start of a word }
    if I <= Length(S) then Inc(Count);
    { if not finished, find the end of the current word }
    if Count <> N then
      while (I <= Length(S)) and not (S[I] in WordDelims) do Inc(I)
    else Result := I;
  end;
end;

function TSetForm.ExtractWord(N: Integer; const S: string;
  const WordDelims: TCharSet): string;
var
  I: Integer;
  Len: Integer;
begin
  Len := 0;
  I := WordPosition(N, S, WordDelims);
  if I <> 0 then
    { find the end of the current word }
    while (I <= Length(S)) and not(S[I] in WordDelims) do begin
      { add the I'th character to result }
      Inc(Len);
      SetLength(Result, Len);
      Result[Len] := S[I];
      Inc(I);
    end;
  SetLength(Result, Len);
end;

procedure TSetForm.SetProxyParams;
begin
 if ListBox1.Items.Count > 0 then
 begin
  idHTTP.ProxyParams.ProxyServer := ExtractWord(1, ListBox1.items[0], delimq);
  idHTTP.ProxyParams.ProxyPort := StrToInt(ExtractWord(2, ListBox1.items[0], delimq));
 end;

 if (ListBox1.Items.Count = 0) or (UseProxy.Checked = false) then
 begin
  idHTTP.ProxyParams.ProxyServer := '';
  idHTTP.ProxyParams.ProxyPort := 0;
 end;
end;

procedure TSetForm.ExecAntiBan;
begin
 if SetForm.ListBox1.Items.Count >= 2 then
 begin
  if GlobalProxy < SetForm.ListBox1.Items.Count - 1 then
  inc(GlobalProxy) else GlobalProxy := 0;

  RQ_ChangeChatButton(ba, hico3, wintext);

  idHTTP.ProxyParams.ProxyServer := ExtractWord(1, ListBox1.items[GlobalProxy], delimq);
  idHTTP.ProxyParams.ProxyPort := StrToInt(ExtractWord(2, ListBox1.items[GlobalProxy], delimq));
 end;
end;

procedure FNTimeCallBack(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
var i, x: integer;
    fnd: string;
    uin: integer;
begin

 if SetForm.TurnedOn.checked = false then exit;

 uin := RQ_GetChatUIN; fnd := '';
 if ifPOST = true then
 begin
  if ReadTMTnotice = true then
  begin
   if SetForm.UseProxy.Checked = false then
   wintext := '<27><> <20><> <20><> ' + IntToStr(uin) +
              '. <20><> <20><>: ' + IntToStr(SetForm.ReadTMT.value)
    else
   wintext := '<27><> <20><> <20><> ' +
              IntToStr(uin)+'. <20><>: '+ IntToStr(GlobalProxy+1) + ' / ' +
              IntToStr(SetForm.ListBox1.items.count) +
              ', <20><> <20><>: ' + IntToStr(SetForm.ReadTMT.value)
  end
   else
  begin
   if SetForm.UseProxy.Checked = false then
   wintext := '<27><> <20><> <20><> ' + IntToStr(uin)
    else
   wintext := '<27><> <20><> <20><> ' +
              IntToStr(uin)+'. <20><>: '+ IntToStr(GlobalProxy+1) + ' / ' +
              IntToStr(SetForm.ListBox1.items.count);
  end;
  RQ_ChangeChatButton(ba, hico4, wintext);
  exit;
 end;

 for i := 2 to glst.Count-1 do
 if pos(IntToStr(uin), glst[i]) > 0 then fnd := glst[i];

 num := SetForm.ExtractWord(1, fnd, Delims);
 status := SetForm.ExtractWord(2, fnd, Delims);
 gdt := SetForm.ExtractWord(3, fnd, Delims);

 if not (num = '') then
 begin

  if (pos('<27><>', status) > 0) and
  (RQ_GetContactInfo(StrToInt(num)).Status = PS_OFFLINE) then
  RQ_ChangeChatButton(ba, hico5, num+': '+status+'  ['+gdt+']')
   else
  if (pos('<27><>', status) > 0) and
  (RQ_GetContactInfo(StrToInt(num)).Status = PS_OFFLINE) or
  (RQ_GetContactInfo(StrToInt(num)).Invisible = true) then
  RQ_ChangeChatButton(ba, hico1, num+': '+status+'  ['+gdt+']')
   else
  if (pos('<27><>', status) > 0) and
  (RQ_GetContactInfo(uin).Status <> PS_OFFLINE) and
  (RQ_GetContactInfo(uin).Invisible = false) and
  (RQ_GetContactInfo(uin).Status <> PS_UNKNOWN) then
  begin
   for x := 2 to glst.Count-1 do
   if pos(IntToStr(uin), glst[x]) > 0 then
   begin
    glst[x] := IntToStr(uin)+'|'+ByteToStatus(RQ_GetContactInfo(uin).Status)+'|'+gdt;
    glst.SaveToFile(RQ_GetUserPath + stname);
   end;

   RQ_ChangeChatButton(ba, hico2, num+': '+status+'  ['+gdt+']');
  end else
  RQ_ChangeChatButton(ba, hico2, num+': '+status+'  ['+gdt+']')

 end
  else
 RQ_ChangeChatButton(ba, hico2, namepl);
end;

procedure TSetForm.StartTimer;
begin
 MegaTimer:=TimeSetEvent(500,10000,@FNTimeCallBack,100,TIME_PERIODIC);
end;

procedure TSetForm.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button = mbRight then pop.Popup(mouse.CursorPos.x, mouse.CursorPos.y);
end;

procedure TSetForm.N1Click(Sender: TObject);
var NewProx: string;
begin
 NewProx := InputBox('<27><> <20><> <20> <20><> <20><>', '<27><> 255.255.255.255:PORT', '0.0.0.0:0');
 if (NewProx <> '') and (NewProx <> '0.0.0.0:0') then
 begin
  listbox1.Items.Add(NewProx);
  SetProxyParams;
  SaveProxy;
  GlobalProxy := 0;
 end;
end;

procedure TSetForm.FormCreate(Sender: TObject);
var outs: TStringList;
begin
 if fileexists(RQ_GetUserPath + proxname) then
 begin
  outs := TStringList.Create;
  outs.LoadFromFile(RQ_GetUserPath + proxname);
  UseProxy.Checked := StrToBool(outs[0]);
  outs.Delete(0);
  AvoidBan.Checked := StrToBool(outs[0]);
  outs.Delete(0);
  ReadTMT.Value := StrToInt(outs[0]);
  outs.Delete(0);

  ListBox1.items := outs;
  outs.free;
  SetProxyParams;
 end;

 ifPOST := false;
 GlobalProxy := 0;
end;

procedure TSetForm.N2Click(Sender: TObject);
begin
 if ListBox1.ItemIndex >= 0  then
 begin
  ListBox1.Tag := ListBox1.ItemIndex;
  ListBox1.DeleteSelected;
  if ListBox1.Items.Count > 0 then
  if ListBox1.Tag < ListBox1.Items.Count - 1 then
  ListBox1.ItemIndex := ListBox1.Tag
   else
  ListBox1.ItemIndex := ListBox1.Items.Count - 1;

  SetProxyParams;
  SaveProxy;
  GlobalProxy := 1;
 end;
end;

procedure TSetForm.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if key = VK_DELETE then n2.Click
end;

procedure TSetForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if glst.count > 0 then glst[0] := BoolToStr(YouAreAdded.Checked)
 else glst.Add(BoolToStr(YouAreAdded.Checked));
 if glst.count > 1 then glst[1] := BoolToStr(TurnedOn.Checked)
 else glst.Add(BoolToStr(TurnedOn.Checked));

 if TurnedOn.Checked = false then
 begin
  if MegaTimer <> 0 then TimeKillEvent(MegaTimer);
  RQ_ChangeChatButton(ba, hico3, namepl)
 end
  else
 begin
  if MegaTimer <> 0 then TimeKillEvent(MegaTimer);
  StartTimer;
 end;

 glst.SaveToFile(RQ_GetUserPath + stname);
 SetProxyParams;
 SaveProxy;
end;

procedure TSetForm.UseProxyClick(Sender: TObject);
begin
 SetProxyParams;
 SaveProxy;
 if UseProxy.Checked = true then
 AvoidBan.Enabled := true
  else
 AvoidBan.Enabled := false;
end;

procedure TSetForm.AvoidBanClick(Sender: TObject);
begin
 SaveProxy;
 if AvoidBan.Checked = false then GlobalProxy := 0;
end;

procedure TSetForm.ReadTMTChange(Sender: TObject);
begin
 idHTTP.ReadTimeout := ReadTMT.Value;
 if SetForm <> nil then
 if SetForm.Visible = true then SaveProxy;
end;

procedure TSetForm.FormShow(Sender: TObject);
begin
 if glst.count > 0 then YouAreAdded.Checked := StrToBool(glst[0]);
 if glst.count > 1 then TurnedOn.Checked := StrToBool(glst[1]);
end;

procedure TSetForm.FlatButton1Click(Sender: TObject);
begin
 SetForm.close
end;

procedure TSetForm.FlatButton2Click(Sender: TObject);
var ls: TStringList;
    i: integer;
    tmp, tmpA: string;
    auth: boolean;
begin
 tmp := '';
 auth := false;
 ls := TStringList.Create;
 ls.LoadFromFile(RQ_GetUserPath + '\rnq.ini');
 for i := 0 to ls.count-1 do
 begin
  if pos('proxy-host=', ls[i]) > 0 then tmp := copy(ls[i], pos('proxy-host=', ls[i])+11, length(ls[i]));
  if pos('proxy-port=', ls[i]) > 0 then tmp := tmp + ':' + copy(ls[i], pos('proxy-port=', ls[i])+11, length(ls[i]));
{
  if pos('proxy-user=', ls[i]) > 0 then tmpA := ':' + copy(ls[i], pos('proxy-user=', ls[i])+11, length(ls[i]));
  if pos('proxy-pass=', ls[i]) > 0 then tmpA := tmpA + ':' + copy(ls[i], pos('proxy-pass=', ls[i])+11, length(ls[i]));
  if pos('proxy-auth=Yes', ls[i]) > 0 then auth := true;
}
 end;
 if tmp <> '' then
{ if auth = true then
 ListBox1.items.Add(tmp + tmpA)
  else}
 ListBox1.items.Add(tmp);
 SetProxyParams;
 SaveProxy;

 ls.free
end;

procedure TSetForm.FlatButton3Click(Sender: TObject);
var i: integer; l: TStringList;
begin
if opend.Execute then
begin
 l := TStringList.Create;
 l.LoadFromFile(opend.FileName);
 for i:= 0 to l.Count-1 do
 if l[i] <> '' then listbox1.items.add(l[i]);
 l.free;
end;
end;

end.