unit _TCPStream;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient;

{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}

type
  PDWordArray = ^TDWordArray;
  TDWordArray = array[0..8192] of dword;

type
  TTCPStream=class
  private
    opdw:dword;
    opb:byte;
  public
    TCPConnection:TIdTCPConnection;
    constructor Create(_TCPConnection:TIdTCPConnection);
    destructor Destroy; override;
    function rbyte:byte;
    function rstr:string;
    function rstrw:string;
    function rbuf8192(p:pointer;var fcrc:dword):boolean;
    procedure wbyte(b:byte);
    procedure wstr(s:string);
    procedure wstrw(s:string);
    procedure wbuf8192(p:pointer;var fcrc:dword);
    function rbool:boolean;
    function rword:word;
    function rdword:dword;
    procedure wbool(b:boolean);
    procedure wword(w:word);
    procedure wdword(dw:dword);
    procedure SetOnetimePassword(_opdw:dword;_opb:byte);
    procedure EncordOnetimePassword;
    procedure DecordOnetimePassword;
    function Getopdw:dword;
    function Getopb:byte;
  end;

implementation

uses _m_Tools;

constructor TTCPStream.Create(_TCPConnection:TIdTCPConnection);
begin
  inherited Create;

  opdw:=0;
  opb:=$00;
  TCPConnection:=_TCPConnection;
end;

destructor TTCPStream.Destroy;
begin
  opdw:=0;
  opb:=$00;
  TCPConnection:=nil;

  inherited Destroy;
end;

function TTCPStream.rbyte:byte;
begin
  TCPConnection.ReadBuffer(Result,1);
  Result:=Result xor opb;
end;

function TTCPStream.rstr:string;
var
  len,cnt:integer;
begin
  len:=rbyte;
  Result:=stringofchar(' ',len);
  TCPConnection.ReadBuffer(Result[1],len);
  for cnt:=1 to len do begin
    Result[cnt]:=char(byte(Result[cnt]) xor opb);
  end;
end;

function TTCPStream.rstrw:string;
var
  len,cnt:integer;
begin
  len:=rword;
  Result:=stringofchar(' ',len);
  TCPConnection.ReadBuffer(Result[1],len);
  for cnt:=1 to len do begin
    Result[cnt]:=char(byte(Result[cnt]) xor opb);
  end;
end;

function TTCPStream.rbuf8192(p:pointer;var fcrc:dword):boolean;
var
  pdwf:PDWordArray;
  cnt:integer;
begin
  pdwf:=p;
  Result:=True;
  try
    TCPConnection.ReadBuffer(pdwf[0],8192);
    except else begin
      Result:=False;
      exit;
    end;
  end;

  fcrc:=0;
  for cnt:=0 to (8192 div 4)-1 do begin
    pdwf[cnt]:=pdwf[cnt] xor opdw;
    fcrc:=fcrc xor pdwf[cnt];
  end;
end;

procedure TTCPStream.wbuf8192(p:pointer;var fcrc:dword);
var
  pdwf:PDWordArray;
  cnt:integer;
begin
  pdwf:=p;
  fcrc:=0;
  for cnt:=0 to (8192 div 4)-1 do begin
    fcrc:=fcrc xor pdwf[cnt];
    pdwf[cnt]:=pdwf[cnt] xor opdw;
  end;
  TCPConnection.WriteBuffer(pdwf[0],8192);
end;

procedure TTCPStream.wbyte(b:byte);
begin
  b:=b xor opb;
  TCPConnection.WriteBuffer(b,1);
end;

procedure TTCPStream.wstr(s:string);
var
  c:integer;
begin
  wbyte(length(s));
  for c:=1 to length(s) do begin
    s[c]:=char(byte(s[c]) xor opb);
  end;
  TCPConnection.WriteBuffer(s[1],length(s));
end;

procedure TTCPStream.wstrw(s:string);
var
  c:integer;
begin
  wword(length(s));
  for c:=1 to length(s) do begin
    s[c]:=char(byte(s[c]) xor opb);
  end;
  TCPConnection.WriteBuffer(s[1],length(s));
end;

function TTCPStream.rbool:boolean;
begin
  if rbyte=$00 then begin
    Result:=True;
    end else begin
    Result:=False;
  end;
end;

function TTCPStream.rword:word;
begin
  Result:=word(rbyte) shl 8;
  Result:=Result+rbyte;
end;

function TTCPStream.rdword:dword;
begin
  Result:=dword(rbyte) shl 24;
  Result:=Result+dword(rbyte) shl 16;
  Result:=Result+dword(rbyte) shl 8;
  Result:=Result+rbyte;
end;

procedure TTCPStream.wbool(b:boolean);
begin
  if b=True then begin
    wbyte($00);
    end else begin
    wbyte($ff);
  end;
end;

procedure TTCPStream.wword(w:word);
begin
  wbyte(byte(w shr 8 and $ff));
  wbyte(byte(w and $ff));
end;

procedure TTCPStream.wdword(dw:dword);
begin
  wbyte(byte(dw shr 24 and $ff));
  wbyte(byte(dw shr 16 and $ff));
  wbyte(byte(dw shr 8 and $ff));
  wbyte(byte(dw and $ff));
end;

procedure TTCPStream.EncordOnetimePassword;
var
  pw:array[0..31] of byte;
  cnt:integer;
begin
{$IFDEF UserMode}
  opdw:=0;
{$ENDIF}

{$IFNDEF UserMode}
  opdw:=random($7fffffff);
{$ENDIF}

  opb:=byte(opdw and $ff);

  for cnt:=0 to 31 do begin
    pw[cnt]:=random($ff);
    if (opdw and (1 shl cnt))=0 then begin
      pw[cnt]:=pw[cnt] and (not (1 shl (cnt mod 8)));
      end else begin
      pw[cnt]:=pw[cnt] or (1 shl (cnt mod 8));
    end;
  end;

  TCPConnection.WriteBuffer(pw[0],32);
end;

procedure TTCPStream.DecordOnetimePassword;
var
  pw:array[0..31] of byte;
  cnt:integer;
begin
  TCPConnection.ReadBuffer(pw[0],32);

  opdw:=0;

  for cnt:=0 to 31 do begin
    if (pw[cnt] and (1 shl (cnt mod 8)))<>0 then begin
      opdw:=opdw+(1 shl cnt);
    end;
  end;
  opb:=byte(opdw and $ff);
end;

procedure TTCPStream.SetOnetimePassword(_opdw:dword;_opb:byte);
begin
  opdw:=_opdw;
  opb:=_opb;
end;

function TTCPStream.Getopdw:dword;
begin
  Result:=opdw;
end;

function TTCPStream.Getopb:byte;
begin
  Result:=opb;
end;

end.
