program IOCPServer;
uses
System.SysUtils,
Winapi.Windows,
Winapi.WinSock2;
const
DATA_BUFSIZE = 8192;
type
LPPER_IO_OperaTION_DATA = ^ PER_IO_OPERATION_DATA ;
PER_IO_OPERATION_DATA = packed record
Overlapped: OVERLAPPED;
DataBuf: TWSABUF;
Buffer: array [0..DATA_BUFSIZE] of AnsiCHAR;
BytesSEND: DWord;
BytesRECV: DWORD;
dwFlags: DWORD;
end;
LPPER_HANDLE_DATA = ^ PER_HANDLE_DATA;
PER_HANDLE_DATA = packed record
Socket: TSocket;
ClientAddr: SOCKADDR_STORAGE;
end;
function ServerWorkerThread(IpParam: LPVOID): DWORD; stdcall;
var
CompletionPort: THANDLE;
BytesTransferred: DWORD ;
PerHandleData: LPPER_HANDLE_DATA ;
PerIoData: LPPER_IO_OPERATION_DATA ;
ClientAddr:SOCKADDR_IN;
SendByte:DWORD;
begin
CompletionPort := THANDLE(IpParam);
Result:= 0;
while(TRUE) do
begin
if (GetQueuedCompletionStatus(CompletionPort,BytesTransferred,
ULONG_PTR(PerHandleData),POverlapped(PerIoData),INFINITE) = False) then
begin
WriteLn( Format('GetQueuedCompletionStatus failed with error %d', [GetLastError]) );
end;
// First check to see if an error has occured on the socket and if so
// then close the socket and cleanup the SOCKET_INFORMATION structure
// associated with the socket.
if (BytesTransferred = 0) then
begin
WriteLn( Format('Closing socket %d\', [PerHandleData.Socket]) );
if (closesocket(PerHandleData.Socket) = SOCKET_ERROR) then
begin
WriteLn( Format('closesocket failed with error %d', [WSAGetLastError]) );
exit;
end;
GlobalFree(DWORD(PerHandleData));
GlobalFree(DWORD(PerIoData));
continue;
end;
// Check to see if the BytesRECV field equals zero. If this is so, then
// this means a WSARecv call just completed so update the BytesRECV field
// with the BytesTransferred value from the completed WSARecv() call.
if (PerIoData.BytesRECV = 0) then
begin
PerIoData.BytesRECV := BytesTransferred;
PerIoData.BytesSEND := 0;
end
else
begin
PerIoData.BytesSEND := PerIoData.BytesSEND + BytesTransferred;
end;
if (PerIoData.BytesRECV > PerIoData.BytesSEND) then
begin
// Display Client IP and Send Msg
CopyMemory(@ClientAddr, @PerHandleData^.ClientAddr, Sizeof(ClientAddr));
WriteLn( Format('Client %s Say :%s',[inet_ntoa(ClientAddr.sin_addr),PerIoData.DataBuf.buf]));
// Post another WSASend() request.
// Since WSASend() is not gauranteed to send all of the bytes requested,
// continue posting WSASend() calls until all received bytes are sent.
ZeroMemory(@(PerIoData.Overlapped), sizeof(OVERLAPPED));
PerIoData.DataBuf.buf := PerIoData.Buffer + PerIoData.BytesSEND;
PerIoData.DataBuf.len := PerIoData.BytesRECV - PerIoData.BytesSEND;
if (WSASend(PerHandleData.Socket, @(PerIoData.DataBuf), 1, PerIoData.BytesSEND, 0,
@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then
begin
if (WSAGetLastError() <> ERROR_IO_PENDING) then
begin
Exit;
end;
end;
end
else
begin
PerIoData.BytesRECV := 0;
// Now that there are no more bytes to send post another WSARecv() request.
ZeroMemory(@(PerIoData.Overlapped), sizeof(OVERLAPPED));
PerIoData.DataBuf.len := DATA_BUFSIZE;
PerIoData.DataBuf.buf := @PerIoData.Buffer;
if (WSARecv(PerHandleData.Socket, @(PerIoData.DataBuf), 1, PerIoData.BytesRECV, PerIoData.dwFlags,
@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then
begin
if (WSAGetLastError() <> ERROR_IO_PENDING) then
begin
exit;
end;
end;
end;
end;
end;
unction ServerStar(nPort:Integer):Integer;
var
InternetAddr: SOCKADDR_IN;
saRemote:SOCKADDR_IN;
RemoteLen: Integer;
Listen: TSOCKET;
Accept: TSOCKET;
CompletionPort:THandle;
SystemInfo: SYSTEM_INFO ;
PerHandleData: LPPER_HANDLE_DATA ;
PerIoData: LPPER_IO_OPERATION_DATA ;
i: Integer;
ThreadID: DWORD ;
wsaData: TWSADATA ;
ThreadHandle: THANDLE;
begin
// init socket
Result := WSAStartup($0202, wsaData);
if (Result <> 0) then
begin
WriteLn( Format('WSAStartup failed with error %d', [Result]) );
Exit;
end;
// Setup an I/O completion port.
CompletionPort := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
if (CompletionPort = 0) then
begin
WriteLn( Format('CreateIoCompletionPort failed with error: %d', [GetLastError]) );
Exit;
end;
// Determine how many processors are on the system.
GetSystemInfo(SystemInfo);
// Create worker threads based on the number of processors available on the
// system. Create two worker threads for each processor.
for i:= 0 to SystemInfo.dwNumberOfProcessors * 2 - 1 do
begin
// Thread Count Cpu * 2
// Create a server worker thread and pass the completion port to the thread.
ThreadHandle := CreateThread(nil, 0, @ServerWorkerThread, Pointer(CompletionPort),
0, ThreadID);
if (ThreadHandle = 0) then
begin
WriteLn( Format('CreateThread() failed with error %d', [GetLastError]) );
Exit;
end;
// Close the thread handle
CloseHandle(ThreadHandle);
end;
// Create a listening socket
Listen := WSASocket(AF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
if (Listen = INVALID_SOCKET) then
begin
WriteLn( Format('WSASocket() failed with error %d', [WSAGetLastError]) );
exit;
end;
InternetAddr.sin_family := AF_INET;
InternetAddr.sin_addr.s_addr := htonl(INADDR_ANY);
InternetAddr.sin_port := htons(nPORT);
if (bind(Listen, sockaddr(InternetAddr), sizeof(InternetAddr)) = SOCKET_ERROR) then
begin
WriteLn( Format('bind() failed with error %d', [WSAGetLastError]) );
exit;
end;
// Prepare socket for listening
// 5:max number of connect request | SOMAXCONN
if (Winapi.WinSock2.listen(Listen, 5) = SOCKET_ERROR) then
begin
WriteLn( Format('listen() failed with error %d', [WSAGetLastError]) );
exit;
end
else
begin
WriteLn( Format('Server listen on port = %d ...', [nPORT]) );
end;
// Accept connections and assign to the completion port.
while(TRUE) do
begin
RemoteLen:=Sizeof(saRemote);
Accept:= WSAAccept(Listen, @saRemote, @RemoteLen, nil, 0);
//Accept := WSAAccept(Listen, nil, nil, nil, 0);
if (Accept = SOCKET_ERROR) then
begin
WriteLn( Format('WSAAccept() failed with error %d', [WSAGetLastError]) );
exit;
end;
// Create a socket information structure to associate with the socket
PerHandleData := LPPER_HANDLE_DATA (GlobalAlloc(GPTR, sizeof(PER_HANDLE_DATA)));
if (PerHandleData = nil) then
begin
WriteLn( Format('GlobalAlloc() failed with error %d', [WSAGetLastError]) );
exit;
end;
// Associate the accepted socket with the original completion port.
WriteLn( Format('Socket number %d connected', [Accept]) );
PerHandleData.Socket := Accept;
// Copy the accepted socket to ClientAddr
CopyMemory(@PerHandleData^.ClientAddr, @saRemote, RemoteLen);
// Associate the accepted socket with the IP.
WriteLn( Format('Socket number %s connected', [inet_ntoa(saRemote.sin_addr)]) );
if (CreateIoCompletionPort(Accept, CompletionPort, DWORD(PerHandleData), 0) = 0) then
begin
WriteLn( Format('CreateIoCompletionPort() failed with error %d', [WSAGetLastError]) );
exit;
end;
// Create per I/O socket information structure to associate with the
// WSARecv call below.
PerIoData := LPPER_IO_OPERATION_DATA(GlobalAlloc(GPTR, sizeof(PER_IO_OPERATION_DATA)));
if (PerIoData = nil) then
begin
WriteLn( Format('GlobalAlloc() failed with error %d', [WSAGetLastError]) );
exit;
end;
CreateIoCompletionPort(PerHandleData.Socket, completionPort, DWORD(PerHandleData), 0);
ZeroMemory( @PerIoData.Overlapped, sizeof(OVERLAPPED));
PerIoData.dwFlags := 0;
PerIoData.BytesSEND := 0;
PerIoData.BytesRECV := 0;
PerIoData.DataBuf.len := DATA_BUFSIZE;
PerIoData.DataBuf.buf := @PerIoData.Buffer;
if (WSARecv(Accept, @(PerIoData.DataBuf), 1, PerIoData.BytesRECV, PerIoData.dwFlags,
@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then
begin
if (WSAGetLastError() <> ERROR_IO_PENDING) then
begin
WriteLn( Format('WSARecv() failed with error %d', [WSAGetLastError]) );
exit;
end
end;
end;
end;
begin
ServerStar(6000);
end.
IOCP For Delphi XE3
最新推荐文章于 2020-09-12 09:34:52 发布