unit hiTCP_Client;

interface

uses Kol,Share,Windows,TCP,Debug;

const
  dtInteger = 0;
  dtString = 1;
  dtReal = 2;
  dtStream = 3;

type
  THITCP_Client = class(TDebug)
   private
    Sock:TSocket;
    Mem:PStream;
    FSize:cardinal;
    FDeleteSocket:boolean;

    procedure _OnConnect(Sender: TSocket);
    procedure _OnDisConnect(Sender: TSocket);
    procedure _OnRes(Sender: TSocket; Buf: pointer; Count: cardinal);
    procedure _OnError(Sender: PObj; const Error:integer);
   public
    _prop_IP:string;
    _prop_Port:integer;
    _prop_DataType:byte;
    _data_IP:THI_Event;
    _data_Data:THI_Event;
    _data_Port:THI_Event;
    _event_onConnect:THI_Event;
    _event_onDisconnect:THI_Event;
    _event_onRead:THI_Event;
    _event_onError:THI_Event;
    _event_onProgress:THI_Event;

    constructor Create;
    destructor Destroy; override;
    procedure Attach(sck:TSocket);
    function Detach:TSocket;
    procedure _work_doOpen(var _Data:TData; Index:word);
    procedure _work_doClose(var _Data:TData; Index:word);
    procedure _work_doSend(var _Data:TData; Index:word);
    procedure _var_Active(var _Data:TData; Index:word);
    procedure _var_IP(var _Data:TData; Index:word);
  end;

implementation

constructor THITCP_Client.Create;
begin
  inherited;
  Sock := nil;
  FDeleteSocket := false;
end;

destructor THITCP_Client.Destroy;
begin
  if Assigned(Sock) then
    if FDeleteSocket then Detach.Destroy else Detach;
  inherited;
end;

procedure THITCP_Client.Attach;
begin
  if Assigned(Sock) then
    if FDeleteSocket then Detach.Destroy else Detach;
  Sock := sck;
  Sock.OnConnect := _OnConnect;
  Sock.OnDisconnect := _OnDisConnect;
  Sock.OnRead := _OnRes;
  Sock.OnError := _onError;
end;

function THITCP_Client.Detach;
begin
  Result := Sock;
  if Assigned(Sock) then begin
    Sock.OnConnect := nil;
    Sock.OnDisconnect := nil;
    Sock.OnRead := nil;
    Sock.OnError := nil;
    Sock := nil;
    FDeleteSocket := false;
  end;
end;

procedure THITCP_Client._OnConnect;
begin
   _hi_OnEvent( _event_onConnect );
end;

procedure THITCP_Client._OnDisConnect;
begin
   _hi_OnEvent( _event_onDisConnect );
end;

procedure THITCP_Client._OnError;
begin
  _hi_OnEvent( _event_onError,Error );
end;

procedure THITCP_Client._OnRes;
var s:string;
    c:integer;
begin
    case _prop_DataType of
     0: _hi_OnEvent(_event_onRead,integer(buf^));
     1:
      begin
       SetLength(s,Count);
       CopyMemory(@s[1], buf, Count);
       _hi_OnEvent(_event_onRead,s);
      end;
     2: _hi_OnEvent(_event_onRead,real(buf^));
     3:
      while count > 0 do
       begin
         if Mem = nil then
          begin
           Mem := NewMemoryStream;
           FSize := cardinal(buf^);
           inc(integer(buf), 4);
           dec(Count, 4);
          end;
          
         if Count > 0 then 
          begin
            c := Mem.Write(buf^,min(count,FSize - Mem.Size)); 
            dec(count, c);            
            inc(integer(buf), c);
          end;

         _hi_OnEvent(_event_onProgress, integer(Mem.Position));

         if FSize = Mem.Size then
          begin
             Mem.Position := 0;
             _hi_OnEvent(_event_onRead,mem);
             Free_and_nil(Mem);
          end;
       end;
    end;
end;

procedure THITCP_Client._work_doOpen;
var p:word;
   h:string;
begin
  if not Assigned(Sock) then begin
    Attach(TSocket.Create);
    FDeleteSocket := true;
  end;
  P := ReadInteger(_Data,_data_Port,_prop_Port);
  H := ReadString(_Data,_data_IP,_prop_IP);
  Sock.StartClient(p,h);
end;

procedure THITCP_Client._work_doClose;
begin
   if Assigned(Sock) then Sock.Close;
end;

procedure THITCP_Client._work_doSend;
var st:PStream;
    i:integer;
    r:real;
    s:string;
begin
  if not Assigned(Sock) then Exit;
  if Sock.Connected then
    case _prop_DataType of
     0:
       begin
        i := ReadInteger(_data,_data_Data,0);
        Sock.Send(@i,sizeof(i));
       end;
     1:
      begin
        s := ReadString(_data,_data_Data,');
        Sock.Send(@s[1],length(s));
      end;
     2:
       begin
        r := ReadReal(_data,_data_Data,0);
        Sock.Send(@r,sizeof(r));
       end;
     3:
      begin
        st := ReadStream(_data,_data_Data,nil);
        if st <> nil then
         begin
         _debug(int2str(st.size));
          st.Position := 0;
          i := st.Size;
          Sock.Send(@i,sizeof(i));
          Sock.Send(st.Memory,St.Size);
         end;
      end;
    end;
end;

procedure THITCP_Client._var_Active;
var a:integer;
begin
  if Assigned(Sock) then a := byte(Sock.Connected) else a := 0;
  Share.dtInteger(_Data, a);
end;

procedure THITCP_Client._var_IP;
begin
  if Assigned(Sock) then Share.dtString(_Data, Sock.IP);
end;

end.

Add(MainForm,2953706,84,154)
{
}
Add(If_else,5642440,238,210)
{
 Op2=Integer(0)
 link(onTrue,5943869:doCompare,[])
 link(Op1,13330092:Active,[])
}
Add(Timer,14362227,196,210)
{
 Interval=5000
 link(onTimer,5642440:doCompare,[])
}
Add(Message,15996577,357,210)
{
}
Add(Hub,12827021,322,210)
{
 link(onEvent1,15996577:doMessage,[])
 link(onEvent2,9892066:doEvent2,[(348,223)(348,254)(186,254)(186,167)])
}
Add(If_else,5943869,280,210)
{
 Type=1
 Op2=Integer(5)
 link(onTrue,12827021:doEvent1,[])
 link(Op1,13910297:Count,[(286,190)(314,190)])
}
Add(Thread,9862538,147,154)
{
 link(onExec,9892066:doEvent1,[])
}
Add(Hub,9892066,210,154)
{
 InCount=2
 link(onEvent1,13330092:doOpen,[])
 link(onEvent2,13330092:doSend,[(231,167)(231,174)])
}
Add(TCP_Client,13330092,238,154)
{
 Port=80
 Point(onError)
 link(onRead,13910297:doAdd,[(284,160)(284,132)])
}
Add(StrList,13910297,301,126)
{
}

Add(MainForm,2953706,84,238)
{
 Width=696
 Height=389
 link(onCreate,9862538:doStart,[])
}
Add(If_else,5642440,413,308)
{
 Op2=Integer(0)
 link(onTrue,5943869:doCompare,[])
 link(Op1,13330092:Active,[])
}
Add(Timer,14362227,343,308)
{
 Interval=5000
 link(onTimer,7634249:doEvent1,[])
}
Add(Message,15996577,532,308)
{
}
Add(Hub,12827021,497,308)
{
 OutCount=3
 link(onEvent1,15996577:doMessage,[])
 link(onEvent2,9892066:doEvent2,[(523,321)(523,356)(334,356)(334,265)])
 link(onEvent3,3474351:doIPByHost,[(517,328)(517,412)(280,412)(280,139)])
}
Add(If_else,5943869,455,308)
{
 Type=1
 Op2=Integer(5)
 link(onTrue,12827021:doEvent1,[])
 link(Op1,2331987:Count,[(461,288)(496,288)])
}
Add(Thread,9862538,147,252)
{
 link(onExec,9892066:doEvent1,[])
}
Add(Hub,9892066,371,252)
{
 InCount=2
 link(onEvent1,13330092:doOpen,[])
 link(onEvent2,13330092:doSend,[(399,265)(399,272)])
}
Add(TCP_Client,13330092,413,252)
{
 Port=80
 IP="74.125.87.147"
 Point(onError)
 link(onRead,2331987:doAdd,[(471,258)(471,230)])
 link(IP,12256894:Text,[(419,174)(356,174)])
 link(Data,7974905:Text,[(426,236)(440,236)])
}
Add(Memo,2331987,483,224)
{
 Left=35
 Top=15
 Width=610
 Height=290
}
Add(StrList,7974905,434,175)
{
 Strings=#23:GET index.html HTTP/1.1|16:Host: google.com|17:Connection: close|47:Content-Type: application/x-www-form-urlencoded|62:User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)|18:Content-Length: 32|0:|32:domain=google%2Ecom&imageField2=|
}
Add(Label,14730013,441,371)
{
 Left=40
 Top=320
}
Add(Hub,7634249,385,308)
{
 link(onEvent1,5642440:doCompare,[])
 link(onEvent2,3870393:doNext,[(403,321)(403,335)(383,335)(383,377)])
}
Add(Counter,3870393,392,371)
{
 link(onNext,14730013:doText,[])
}
Add(Host,3474351,294,126)
{
 link(onIPByHost,12256894:doText,[(338,139)(338,132)])
 link(HostName,4854686:Text,[])
}
Add(Edit,4854686,301,70)
{
 Left=570
 Top=320
 Width=90
 Text="google.com"
}
Add(Edit,12256894,350,126)
{
 Left=410
 Top=320
 Width=150
}