unit sockettest;
interface
uses
SysUtils,
Classes,
Windows,
Winsock;
type
TSockThread =
class(TThread)
iSock: Cardinal;
recvProc:
procedure(szString:
String);
procedure Execute;
end;
TSmallSock =
class
constructor Create(Address: PChar; Port: Cardinal);
procedure Free;
private
lpAddress: PChar;
dwPort: Cardinal;
iSock: Cardinal;
WSAData: TWSAData;
addrIn: TSockAddrIn;
dwThreadID: Cardinal;
gThread: TSockThread;
public
procRecv:
procedure(szString:
String);
function DoConnect:Boolean;
function SendString(szString:
String):Boolean;
end;
var gSmallSock: TSmallSock;
implementation
procedure TSockThread.Execute;
var
mBuf:
array[0..1000-1]
of Char;
begin
if recv(gSmallSock.iSock, mBuf, sizeof(mBuf), 0) <> SOCKET_ERROR
then
begin
if mBuf <> '
'
then
begin
recvProc(mBuf);
mBuf := '
';
end;
end;
end;
constructor TSmallSock.Create(Address: PChar; Port: Cardinal);
begin
lpAddress := Address;
dwPort := Port;
end;
function TSmallSock.DoConnect:Boolean;
begin
result := false;
try
if WSAStartup(MAKEWORD(2, 2), WSAData) <> SOCKET_ERROR
then
begin
iSock := socket(AF_INET, SOCK_STREAM, 0);
if iSock = SOCKET_ERROR
then exit;
addrIn.sin_family := AF_INET;
addrIn.sin_port := htons(dwPort);
addrIn.sin_addr.S_addr := inet_addr(lpAddress);
if connect(iSock, addrIn, sizeof(addrIn)) <> SOCKET_ERROR
then
begin
gThread := TSockThread.Create(true);
gThread.iSock := iSock;
gThread.recvProc := procRecv;
gThread.Resume;
result := true;
end;
end;
except
WSACleanup;
end;
end;
function TSmallSock.SendString(szString:
String):Boolean;
begin
result := false;
if send(iSock, szString, length(szString), 0) <> SOCKET_ERROR
then
result := true;
end;
procedure TSmallSock.Free;
begin
inherited Free;
gThread.DoTerminate;
WSACleanup;
end;
end.