Примерно такой клиент, до идела нужно везде добавить обработку ошибок.
| Код |
procedure SockEvents;
var
WSAEWENTS: TWSANETWORKEVENTS;
len: integer;
begin
while TRUE do begin
WSAWaitForMultipleEvents(1, @SockEvent, FALSE, INFINITE, FALSE);
asm
lea eax, WSAEWENTS
push eax
push SockEvent
push Sock
call WSAEnumNetworkEvents
end;
case WSAEWENTS.lNetworkEvents of
FD_READ: begin
len := recv(Sock, Buf, MAX_PKT_SIZE, 0);
if len > 0 then MessageBox(0, @Buf, Pchar('Recv Message'), 0);
end;
FD_CLOSE: begin
CloseSocket(Sock);
MessageBox(0, Pchar('Socket Closed'), Pchar('Socket Message'), 0);
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
WSA: TWSADATA;
Addr: TSockAddr;
szAddr: integer;
err, thrId: dword;
begin
WSAStartUp($202, WSA);
szAddr := SizeOf(Addr);
WSAStringToAddress(Pchar(Edit1.Text), AF_INET, nil, Addr, szAddr);
Sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
SockEvent := WSACreateEvent;
if Connect(sock, @Addr, SizeOf(Addr)) <> SOCKET_ERROR then begin
WSAEventSelect(Sock, SockEvent, FD_READ or FD_CLOSE);
CreateThread(nil, 0, @SockEvents, nil, 0, thrId);
end else
MessageBox(0, 'облом', Pchar('Error# '+IntToStr(WSAGetLastError)), 0);
end;
|
Сервер маленько посложнее, нужно оперировать масивом сокетов.
| Код |
procedure SocketEvents;
var
WSAEVENTS: TWSANETWORKEVENTS;
len, szCliAddr: integer;
Index: cardinal;
begin
CurrentClientCount := 1;
while TRUE do begin
Index := WSAWaitForMultipleEvents(CurrentClientCount, @EventArray, false, INFINITE, false);
if Index = WSA_WAIT_FAILED then ToLog('Falied on WSAWaitForMultipleEvents',1)
else Index := Index - WSA_WAIT_EVENT_0;
WSAEnumNetworkEvents(SockArray[Index], EventArray[Index], @WSAEVENTS);
{ asm
lea eax, WSAEVENTS
push eax
push EventArray[Index]
push offset SockArray[Index]
call WSAEnumNetworkEvents
end; }
case WSAEVENTS.lNetworkEvents of
FD_READ: begin
len := recv(SockArray[Index], buf, MAX_PKT_SIZE, 0);
if len > 0 then ToLog('Recv -> '+buf);
end;
FD_CLOSE: ToLog('Socket Close');
FD_ACCEPT: begin
szCliAddr := SizeOf(CliAddr);
SockArray[CurrentClientCount] := accept(SockArray[0], CliAddr, szCliAddr);
ToLog('Client accepting address : '+inet_ntoa(CliAddr.sin_addr)+':'+IntToStr(ntohs(CliAddr.sin_port)));
if SockArray[CurrentClientCount] <> SOCKET_ERROR then
EventArray[CurrentClientCount] := WSACreateEvent;
if EventArray[CurrentClientCount]<> WSA_INVALID_EVENT then
if WSAEventSelect(SockArray[CurrentClientCount],
EventArray[CurrentClientCount],
FD_READ or FD_CLOSE) <> SOCKET_ERROR then begin
inc(CurrentClientCount);
ToLog('Client accepted');
end;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
WSA: TWSADATA;
szAddr: integer;
thrId: dword;
begin
if WSAStartUp($202, WSA) = 0 then ToLog('Winsock Init');
szAddr := SizeOf(Addr);
if WSAStringToAddress(Pchar(Edit1.Text), AF_INET, nil, Addr, szAddr) = 0 then
ToLog('Address OK')
else ToLog('Failed on WSAStringToAddress', 1);
SockArray[0] := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if SockArray[0] = SOCKET_ERROR then ToLog('Failed on Socket',1);
if bind(SockArray[0], @Addr, SizeOf(Addr)) = 0 then
ToLog('Bind OK')
else ToLog('Failed on Bind',1);
EventArray[0] := WSACreateEvent;
if WSAEventSelect(SockArray[0], EventArray[0], FD_ACCEPT or FD_CLOSE) = 0 then
CreateThread(nil, 0, @SocketEvents, nil, 0, thrId)
else ToLog('Failed on WSAEventSelect', 1);
Listen(SockArray[0], 2);
end;
|
Когда приходят данные, прилетает сообщение FD_READ. FD_WRITE - срабатывает если приконектился. FD_ACCEPT - для сервера, срабатывает у ListenSocket. Весь перечень в мсдн. |
