F
fire.bruin
Unregistered / Unconfirmed
GUEST, unregistred user!
=============程序入口===========
unit ServerMain;
.....略...
interface
var
IOCP : Cardinal;
.....略...
procedure TForm_Server.FormCreate(Sender: TObject);
begin
ReadIpAndPort(DBServerIP,DBServerPort);
server_ip.IPString:=DBServerIP;
server_port.Text:=inttostr(DBServerPort);
end;
procedure TForm_Server.okClick(Sender: TObject);
var
InternetAddr: TSockAddrIn;
ListenSocket: TSOCKET;
sc: pinteger;
ThreadHandle: THandle;
SystemInfo: SYSTEM_INFO;
i: integer;
Ret, ThreadID: DWORD;
wsaData: TWSADATA;
begin
WriteIpAndPort(server_ip.IPString,strtoint(server_port.Text));
WSAStartup(MakeWord(2,2), wsaData);
IOCP := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
GetSystemInfo(SystemInfo);
for i:=0 to SystemInfo.dwNumberOfProcessors * 2 - 1 do
begin
ThreadHandle := CreateThread(Nil, 0, @WorkThread, @IOCP, 0, ThreadID);
CloseHandle(ThreadHandle);
end;
ListenSocket := WSASocket(AF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
InternetAddr.sin_family := AF_INET;
InternetAddr.sin_addr.s_addr := htonl(INADDR_ANY);
InternetAddr.sin_port := htons(strtoint(server_port.Text));
bind(ListenSocket, @InternetAddr, sizeof(InternetAddr))
Listen(ListenSocket, 5)
new(sc);
sc^ := ListenSocket;
ThreadHandle := CreateThread(nil, 0, @AcceptThread, sc, 0, ThreadID);
end;
end.
=========线程处理========================
unit ServerThread;
interface
uses
Classes,Windows,SyncObjs,Dialogs,winsock2,StdCtrls,SysUtils,Controls,ServerPublic;
const
BUFFER_SIZE =4096;
PORT_ADD = 51937;
Type
TSocketStatus = (ssAccept, ssSend, ssRecv, ssClose, ssStop);
PPerHandleData = ^TPerHandleData;
TPerHandleData = record
Overlapped: OVERLAPPED;
wsaBuffer: TWSABUF;
Statu: TSocketStatus;
Socket: TSocket;
Buffer: array[0..BUFFER_SIZE - 1] of char;
end;
var
IOCP : cardinal;
Clients : Integer;
procedure WorkThread(CompletionPortID: pointer); stdcall;
procedure AcceptThread(p: pointer); stdcall; //接受连接
implementation
procedure WorkThread(CompletionPortID: pointer); stdcall;
var
CompletionPort : cardinal;
TransBytes : DWORD;
PerData : PPerHandleData;
begin
CompletionPort := cardinal(CompletionPortID^);
while true do
begin
if GetQueuedCompletionStatus(CompletionPort,TransBytes,DWORD(PerData),POverlapped(PerData),INFINITE) = false then
begin
Clients:=Clients-1;
exit;
end;
if TransBytes = 0 then //如果接收的字节是0,说明接收失败
begin
CloseSocket(PerData^.Socket);
Clients:=Clients-1;
end;
case perdata.Statu of
ssAccept:
begin
Clients-1;
end;
ssRecv:
begin
Clients-1;
// showmessage(PerData.Buffer);
end;
ssSend:
begin
end;
ssClose:
begin
Clients:=Clients-1;
end;
ssStop:
begin
Clients:=Clients-1;
end;
end;
end;
end;
procedure AcceptThread(p: pointer); stdcall; //接受连接
var
AcceptSocket, Listen : TSocket;
sc : pinteger;
Flags, SendvBytes : DWord;
PerHandleData : PPerHandleData;
begin
Clients:=0;
sc:=p;
Listen:=sc^;
while true do
begin
AcceptSocket := WSAAccept(Listen, nil, nil, nil, 0);
CreateIoCompletionPort(
AcceptSocket, //与完成端口关联的套接字句柄
IOCP, //已建立的完成端口对象的句柄
AcceptSocket, //发生收发操作的套接字(也可以传递一个记录指针),
0);
new(PerHandleData);
FillChar(PerHandleData.Overlapped, sizeof(Overlapped), 0);
FillChar(PerHandleData.Buffer, BUFFER_SIZE, 0);
PerHandleData.Socket := AcceptSocket;
PerHandleData.wsaBuffer.len :=BUFFER_SIZE;
PerHandleData.wsaBuffer.buf:=@PerHandleData.BUFFER;
PerHandleData^.Statu := ssRecv;
flags := 0;
WSARecv(AcceptSocket, @PerHandleData^.wsaBuffer, 1, @SendvBytes, @flags, @PerHandleData^.Overlapped, nil);
Clients:=Clients+1;
end;
end;
end.
unit ServerMain;
.....略...
interface
var
IOCP : Cardinal;
.....略...
procedure TForm_Server.FormCreate(Sender: TObject);
begin
ReadIpAndPort(DBServerIP,DBServerPort);
server_ip.IPString:=DBServerIP;
server_port.Text:=inttostr(DBServerPort);
end;
procedure TForm_Server.okClick(Sender: TObject);
var
InternetAddr: TSockAddrIn;
ListenSocket: TSOCKET;
sc: pinteger;
ThreadHandle: THandle;
SystemInfo: SYSTEM_INFO;
i: integer;
Ret, ThreadID: DWORD;
wsaData: TWSADATA;
begin
WriteIpAndPort(server_ip.IPString,strtoint(server_port.Text));
WSAStartup(MakeWord(2,2), wsaData);
IOCP := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
GetSystemInfo(SystemInfo);
for i:=0 to SystemInfo.dwNumberOfProcessors * 2 - 1 do
begin
ThreadHandle := CreateThread(Nil, 0, @WorkThread, @IOCP, 0, ThreadID);
CloseHandle(ThreadHandle);
end;
ListenSocket := WSASocket(AF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
InternetAddr.sin_family := AF_INET;
InternetAddr.sin_addr.s_addr := htonl(INADDR_ANY);
InternetAddr.sin_port := htons(strtoint(server_port.Text));
bind(ListenSocket, @InternetAddr, sizeof(InternetAddr))
Listen(ListenSocket, 5)
new(sc);
sc^ := ListenSocket;
ThreadHandle := CreateThread(nil, 0, @AcceptThread, sc, 0, ThreadID);
end;
end.
=========线程处理========================
unit ServerThread;
interface
uses
Classes,Windows,SyncObjs,Dialogs,winsock2,StdCtrls,SysUtils,Controls,ServerPublic;
const
BUFFER_SIZE =4096;
PORT_ADD = 51937;
Type
TSocketStatus = (ssAccept, ssSend, ssRecv, ssClose, ssStop);
PPerHandleData = ^TPerHandleData;
TPerHandleData = record
Overlapped: OVERLAPPED;
wsaBuffer: TWSABUF;
Statu: TSocketStatus;
Socket: TSocket;
Buffer: array[0..BUFFER_SIZE - 1] of char;
end;
var
IOCP : cardinal;
Clients : Integer;
procedure WorkThread(CompletionPortID: pointer); stdcall;
procedure AcceptThread(p: pointer); stdcall; //接受连接
implementation
procedure WorkThread(CompletionPortID: pointer); stdcall;
var
CompletionPort : cardinal;
TransBytes : DWORD;
PerData : PPerHandleData;
begin
CompletionPort := cardinal(CompletionPortID^);
while true do
begin
if GetQueuedCompletionStatus(CompletionPort,TransBytes,DWORD(PerData),POverlapped(PerData),INFINITE) = false then
begin
Clients:=Clients-1;
exit;
end;
if TransBytes = 0 then //如果接收的字节是0,说明接收失败
begin
CloseSocket(PerData^.Socket);
Clients:=Clients-1;
end;
case perdata.Statu of
ssAccept:
begin
Clients-1;
end;
ssRecv:
begin
Clients-1;
// showmessage(PerData.Buffer);
end;
ssSend:
begin
end;
ssClose:
begin
Clients:=Clients-1;
end;
ssStop:
begin
Clients:=Clients-1;
end;
end;
end;
end;
procedure AcceptThread(p: pointer); stdcall; //接受连接
var
AcceptSocket, Listen : TSocket;
sc : pinteger;
Flags, SendvBytes : DWord;
PerHandleData : PPerHandleData;
begin
Clients:=0;
sc:=p;
Listen:=sc^;
while true do
begin
AcceptSocket := WSAAccept(Listen, nil, nil, nil, 0);
CreateIoCompletionPort(
AcceptSocket, //与完成端口关联的套接字句柄
IOCP, //已建立的完成端口对象的句柄
AcceptSocket, //发生收发操作的套接字(也可以传递一个记录指针),
0);
new(PerHandleData);
FillChar(PerHandleData.Overlapped, sizeof(Overlapped), 0);
FillChar(PerHandleData.Buffer, BUFFER_SIZE, 0);
PerHandleData.Socket := AcceptSocket;
PerHandleData.wsaBuffer.len :=BUFFER_SIZE;
PerHandleData.wsaBuffer.buf:=@PerHandleData.BUFFER;
PerHandleData^.Statu := ssRecv;
flags := 0;
WSARecv(AcceptSocket, @PerHandleData^.wsaBuffer, 1, @SendvBytes, @flags, @PerHandleData^.Overlapped, nil);
Clients:=Clients+1;
end;
end;
end.