unit ClientThread;
interface
uses
Types,
{$ifdef unix}cthreads, {$endif}
{$IFDEF WINDOWS}
winsock2,windows,
{$ENDIF}
SysUtils,Classes,dateutils,syncobjs;
const
BUFSIZE=4096;
{$IFDEF unix}
{$DEFINE TSOCKET := Integer}
{$DEFINE closesocket:=close}
INVALID_SOCKET = -1;
SOCKET_ERROR = -1;
{$ENDIF}
type
TCPClientThread = class(TThread)
public
mEvent:TEventObject;
isWaiting:boolean;
perhapsbeclosed:boolean;
serverhost:string;
serverport:integer;
isclosed:boolean;
procedure ThreadConnectTo(servIP:string;PORT,itimeout:integer);
function ConnectTo(servIP:string;PORT,itimeout:integer):integer;
procedure sendOut(data:pbyte;size:integer);
procedure close();
procedure Event(SocketEvent : Integer; iRead:Integer;rcvbuf: pbyte );virtual;abstract;
procedure disconnect();virtual;abstract;
constructor Create(b:boolean);
procedure dodestroy();virtual;abstract;
procedure doWork();
procedure doTerminate;override;
procedure Logtofile(sfilename:string);
procedure hexdump(pin:pbyte;isize:integer);
private
timeouts:integer;
protected
skt:Integer;
doLogs:boolean;
logfile:TextFile;
locker:TCriticalSection;
logfilename:string;
procedure Execute; override;
procedure LogMsg(s:String;const p:pbyte=nil;const psize:integer=0);
end;
implementation
function GetIPByName(const Name:String):String;
var
r:PHostEnt;
a:TInAddr;
begin
Result:='';
r:= gethostbyname(PChar(Name));
if Assigned(r) then
begin
a:=PInAddr(r^.h_Addr_List^)^;
Result:=inet_ntoa(a);
end;
end;
procedure TCPClientThread.logMsg(s:String;const p:pbyte=nil;const psize:integer=0);
begin
if doLogs then
begin
locker.Acquire;
writeln(logfile,s);
if p<>nil then
begin
hexdump(@p[0],psize);
end;
flush(logfile);
locker.Release;
end;
end;
procedure TCPClientThread.hexdump(pin:pbyte;isize:integer);
var
Buff: array [0..16] of byte;
CountRead,i,j: Integer;
HexText: array [0..32] of byte;
HexText2: array [0..16] of byte;
begin
i:=0;
while i < isize do
begin
CountRead := 0;
HexText[32]:=0;
Buff[16]:=0;
fillbyte(HexText[0],32,32);
fillbyte(Buff[0],16,32);
while ((CountRead+i)<isize) and (CountRead<16) do
begin
Buff[CountRead]:=pin[i+CountRead];
inc(CountRead);
end;
i:=i+CountRead;
BinToHex(@Buff, @HexText, CountRead);
Write(logfile,strpas(@HexText));
//for y:=CountRead*2+1 to 32 do
// Write(logfile,' ');
HexText2[16]:=0;
fillbyte(HexText2[0],16,32);
for j := 0 to CountRead-1 do
begin
if (Buff[j]>126) or (Buff[j]<32) then
begin
Buff[j]:=Byte('.');
end;
HexText2[j+1]:=Buff[j];
end;
logmsg(strpas(@HexText2));
end;
end;
procedure TCPClientThread.Logtofile(sfilename:string);
begin
logfilename:=sfilename;
if not doLogs then
begin
{$I+}
AssignFile(logFile, logfilename);
//FileMode := fmOpenWrite;
Rewrite(logFile);
logmsg('log start...');
end;
doLogs:=true;
end;
constructor TCPClientThread.Create(b:boolean);
begin
inherited Create(b);
Freeonterminate:=false;
mEvent := TEventObject.Create(nil,true,false,'');
isWaiting:=false;
perhapsbeclosed:=true;
skt:=-1;
locker:=TCriticalSection.Create;
end;
procedure TCPClientThread.ThreadConnectTo(servIP:string;PORT,itimeout:integer);
begin
serverhost:=servIP;
serverport:=port;
mEvent.SetEvent;
end;
function TCPClientThread.ConnectTo(servIP:string;PORT,itimeout:integer):integer;
var
wsd:WSADATA;
ret:integer;
server:sockaddr_in;
cTimeOut:integer;
ul,ul1:uint32;
timeout:Ttimeval;
r:Tfdset;
begin
if (WSAStartup(MAKEWORD(2,0),wsd)<0) then
exit(-11);
skt:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
ul := 1;
ret := ioctlsocket(skt, long(FIONBIO), @ul);
if(ret<>NO_ERROR) then
exit(-3);
server.sin_family := AF_INET;
server.sin_port := htons(port);
server.sin_addr .s_addr := inet_addr(PAnsiChar(GetIPByName(servIP)));
if (server.sin_addr.s_addr = INADDR_NONE) then
exit(-1);
ret:=connect(skt,@server,sizeof(sockaddr_in));
FD_ZERO(r);
FD_SET(skt, r);
timeout.tv_sec := itimeout;
timeout.tv_usec :=0;
ret := select(0, nil, @r, nil, @timeout);
if ( ret <= 0 ) then
begin
closesocket(skt);
skt:=-1;
exit(-4);
end;
ul1 := 0 ;
ret := ioctlsocket(skt, long(FIONBIO), @ul1);
if (ret<>NO_ERROR) then
begin
closesocket(skt);
skt:=-1;
exit(-5);
end;
//writeln(stdout,'connect done skt=',skt);
perhapsbeclosed:=false;
result:=0;
serverhost:=servIP;
serverport:=port;
end;
procedure TCPClientThread.sendOut(data:pbyte;size:integer);
begin
send(skt,data,size,0);
end;
procedure TCPClientThread.close();
begin
if skt>0 then
closesocket(skt);
skt:=-1;
perhapsbeclosed:=true;
//if doLogs then
//begin
// if isclosed=false then
// closefile(logFile);
//end;
isclosed:=true;
end;
procedure TCPClientThread.Execute;
var
ustart,uend:Uint32;
res:integer;
timeval:TTimeVal;
BufRev:pbyte;//buffer
begin
//ustart:=MilliSecondOfTheday(now);
BufRev:=allocmem(BUFSIZE);
timeval.tv_sec:=timeouts*1000;
timeval.tv_usec:=50;
//res:=setsockopt(skt,SOL_SOCKET,SO_RCVTIMEO,@timeval,sizeof(timeval));
while Terminated=false do
begin
if skt=-1 then
begin
isWaiting:=true;
if Terminated then
continue;
logmsg('start Waiting..');
mEvent.WaitFor(INFINITE);
mEvent.ResetEvent;
logmsg('start check Terminated..');
if Terminated then
continue;
logmsg('start working..');
if skt=-1 then
begin
res:=ConnectTo(serverhost,serverport,5);
if res<0 then
begin
logmsg('connect fail..');
Event(4,0,nil);
continue;
end;
end;
logmsg('connect fail to live..');
isWaiting:=false;
Event(1,0,nil);
end;
while (skt>0) do
begin
res:=recv(skt,BufRev[0],BUFSIZE,0);
if (res>0) then
begin
Event(3,res,@BufRev[0]);
end
else
if (res<=0) then
begin
Event(2,res,@BufRev[0]);
disconnect();
break;
end;
end;
end;//end while true
logmsg('Terminated..');
FreeMem(BufRev);
mEvent.free;
locker.free;
dodestroy();
end;
procedure TCPClientThread.doWork();
begin
mEvent.SetEvent;
logmsg('lets working..');
isWaiting:=false;
end;
procedure TCPClientThread.doTerminate;
begin
// Signal event to wake up the thread
CLOSE();
freeOnTerminate:=true;
// Base Terminate method (to set Terminated=true)
Terminate;
logmsg('lets terminate..');
mEvent.SetEvent;
end;
end.