unit
SimpleClientSocket;
interface
{$DEBUGINFO OFF}
uses
WinSock,
Windows,
SysUtils,
Classes;
type
TSimpleClientSocket =
class
(TComponent)
private
FAddress:
String
;
FHost:
String
;
FPort:
Integer
;
FTimeOutRead:
Cardinal
;
FTimeOutWrite:
Cardinal
;
FTimeOutConnect:
Cardinal
;
FSocket: TSocket;
FCriticalSection: TRTLCriticalSection;
FEvent: THandle;
function
GetConnected:
Boolean
;
procedure
Lock;
procedure
Unlock;
public
property
Connected:
Boolean
read GetConnected;
property
SocketHandle: TSocket read FSocket;
constructor
Create(AOwner: TComponent); override;
destructor
Destroy; override;
procedure
Open;
procedure
Close;
function
recv(
var
Buf; Count:
Integer
):
Integer
;
function
send(
var
Buf; Count:
Integer
):
Integer
;
procedure
Write
(s:
String
);
procedure
Writeln
(s:
String
);
function
Read:
Char
;
function
Readln:
String
;
published
property
Address:
String
read FAddress
write
FAddress;
property
Host:
String
read FHost
write
FHost;
property
Port:
Integer
read FPort
write
FPort;
property
TimeOutRead:
Cardinal
read FTimeOutRead
write
FTimeOutRead;
property
TimeOutWrite:
Cardinal
read FTimeOutWrite
write
FTimeOutWrite;
property
TimeOutConnect:
Cardinal
read FTimeOutConnect
write
FTimeOutConnect;
end
;
procedure
Register;
implementation
procedure
Register;
begin
RegisterComponents(
'Internet'
, [TSimpleClientSocket]);
end
;
constructor
TSimpleClientSocket
.
Create(AOwner: TComponent);
var
WSAData: TWSAData;
begin
inherited
Create(AOwner);
if
WSAStartup(
$0101
, WSAData)<>
0
then
raise
Exception
.
Create(
'WSAStartup(): '
+SysErrorMessage(WSAGetLastError));
FAddress:=
''
;
FHost:=
''
;
FPort:=
0
;
FTimeOutRead:=
60000
;
FTimeOutWrite:=
60000
;
FTimeOutConnect:=
60000
;
FSocket:=INVALID_SOCKET;
InitializeCriticalSection(FCriticalSection);
FEvent:=CreateEvent(
nil
,
True
,
False
,
nil
);
end
;
destructor
TSimpleClientSocket
.
Destroy;
begin
Close;
CloseHandle(FEvent);
DeleteCriticalSection(FCriticalSection);
if
WSACleanup<>
0
then
raise
Exception
.
Create(
'WSACleanup(): '
+SysErrorMessage(WSAGetLastError));
inherited
Destroy;
end
;
function
TSimpleClientSocket
.
GetConnected:
Boolean
;
begin
Result:=FSocket<>INVALID_SOCKET;
end
;
procedure
TSimpleClientSocket
.
Lock;
begin
EnterCriticalSection(FCriticalSection);
end
;
procedure
TSimpleClientSocket
.
Unlock;
begin
LeaveCriticalSection(FCriticalSection);
end
;
procedure
TSimpleClientSocket
.
Open;
var
FAddr: sockaddr_in;
HostEnt: PHostEnt;
InAddr: in_addr;
arg:
Integer
;
ErrorCode:
Integer
;
FDSetW: TFDSet;
FDSetE: TFDSet;
TimeVal: TTimeVal;
begin
if
FSocket<>INVALID_SOCKET
then
raise
Exception
.
Create(
'Socket already open'
);
FSocket:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if
FSocket=INVALID_SOCKET
then
raise
Exception
.
Create(
'socket(): '
+SysErrorMessage(WSAGetLastError));
try
FAddr
.
sin_family:=AF_INET;
FAddr
.
sin_port:=htons(FPort);
if
FHost<>
''
then
begin
FillChar(InAddr, SizeOf(InAddr),
0
);
HostEnt:=gethostbyname(
PChar
(FHost));
if
HostEnt<>
nil
then
begin
InAddr
.
S_un_b
.
s_b1:=HostEnt^.h_addr^[
0
];
InAddr
.
S_un_b
.
s_b2:=HostEnt^.h_addr^[
1
];
InAddr
.
S_un_b
.
s_b3:=HostEnt^.h_addr^[
2
];
InAddr
.
S_un_b
.
s_b4:=HostEnt^.h_addr^[
3
];
FAddr
.
sin_addr:=InAddr;
end
else
raise
Exception
.
Create(
'gethostbyname()'
);
end
else
if
FAddress<>
''
then
FAddr
.
sin_addr
.
S_addr:=inet_addr(
PChar
(FAddress))
else
raise
Exception
.
Create(
'No address specified'
);
arg:=
1
;
ioctlsocket(FSocket, FIONBIO, arg);
if
connect(FSocket, FAddr, SizeOf(FAddr))<>
0
then
begin
ErrorCode:=WSAGetLastError;
if
ErrorCode<>WSAEWOULDBLOCK
then
raise
Exception
.
Create(
'connect(): '
+SysErrorMessage(ErrorCode));
FD_ZERO(FDSetW);
FD_ZERO(FDSetE);
FD_SET(FSocket, FDSetW);
FD_SET(FSocket, FDSetE);
TimeVal
.
tv_sec:=FTimeOutConnect
div
1000
;
TimeVal
.
tv_usec:=(FTimeOutConnect
mod
1000
)*
1000
;
select(
0
,
nil
, @FDSetW, @FDSetE, @TimeVal);
if
not
FD_ISSET(FSocket, FDSetW)
then
raise
Exception
.
Create(
'connect(): timeout'
);
end
;
arg:=
0
;
ioctlsocket(FSocket, FIONBIO, arg);
except
Close;
raise
;
end
;
end
;
procedure
TSimpleClientSocket
.
Close;
begin
Lock;
try
if
FSocket<>INVALID_SOCKET
then
begin
if
closesocket(FSocket)<>
0
then
raise
Exception
.
Create(
'closesocket(): '
+SysErrorMessage(WSAGetLastError));
FSocket:=INVALID_SOCKET;
end
;
finally
Unlock;
end
;
end
;
procedure
TSimpleClientSocket
.
Write
(s:
String
);
begin
send(
Pointer
(s)^, Length(s));
end
;
procedure
TSimpleClientSocket
.
Writeln
(s:
String
);
begin
Write
(s+#
13
#
10
);
end
;
function
TSimpleClientSocket
.
Read:
Char
;
begin
Result:=#
0
;
recv(Result,
1
);
end
;
function
TSimpleClientSocket
.
Readln:
String
;
begin
Result:=
''
;
while
FSocket<>INVALID_SOCKET
do
begin
Result:=Result+Read;
if
Length(Result)>=
2
then
begin
if
(Result[Length(Result)-
1
]=#
13
)
and
(Result[Length(Result)]=#
10
)
then
begin
Result:=Copy(Result,
1
, Length(Result)-
2
);
Break;
end
;
end
;
if
Length(Result)>=
1
then
begin
if
Result[Length(Result)]=#
10
then
begin
Result:=Copy(Result,
1
, Length(Result)-
1
);
Break;
end
;
end
;
end
;
end
;
function
TSimpleClientSocket
.
recv(
var
Buf; Count:
Integer
):
Integer
;
var
ErrorCode:
Integer
;
FDSet: TFDSet;
TimeVal: TTimeVal;
begin
if
FSocket=INVALID_SOCKET
then
raise
Exception
.
Create(
'recv: invalid socket'
);
FD_ZERO(FDSet);
FD_SET(FSocket, FDSet);
TimeVal
.
tv_sec:=FTimeOutRead
div
1000
;
TimeVal
.
tv_usec:=(FTimeOutRead
mod
1000
)*
1000
;
if
select(
0
, @FDSet,
nil
,
nil
, @TimeVal)=SOCKET_ERROR
then
raise
Exception
.
Create(
'recv: invalid socket'
);
if
not
FD_ISSET(FSocket, FDSet)
then
raise
Exception
.
Create(
'recv(): timeout'
);
Result:=WinSock
.
recv(FSocket, Buf, Count,
0
);
if
Result=
0
then
begin
Close;
raise
Exception
.
Create(
'recv: closed'
);
end
;
if
(Result=SOCKET_ERROR)
then
begin
ErrorCode:=WSAGetLastError;
Close;
raise
Exception
.
Create(
'recv: '
+SysErrorMessage(ErrorCode));
end
;
end
;
function
TSimpleClientSocket
.
send(
var
Buf; Count:
Integer
):
Integer
;
var
ErrorCode:
Integer
;
FDSet: TFDSet;
TimeVal: TTimeVal;
begin
if
FSocket=INVALID_SOCKET
then
raise
Exception
.
Create(
'send: invalid socket'
);
FD_ZERO(FDSet);
FD_SET(FSocket, FDSet);
TimeVal
.
tv_sec:=FTimeOutWrite
div
1000
;
TimeVal
.
tv_usec:=(FTimeOutWrite
mod
1000
)*
1000
;
if
select(
0
,
nil
, @FDSet,
nil
, @TimeVal)=SOCKET_ERROR
then
raise
Exception
.
Create(
'send: invalid socket'
);
if
not
FD_ISSET(FSocket, FDSet)
then
raise
Exception
.
Create(
'send(): timeout'
);
Result:=WinSock
.
send(FSocket, Buf, Count,
0
);
if
Result=SOCKET_ERROR
then
begin
ErrorCode:=WSAGetLastError;
Close;
raise
Exception
.
Create(
'send: '
+SysErrorMessage(ErrorCode));
end
;
end
;
end
.