一个最简单的完成端口.在家来看看 ( 积分: 200 )

  • 主题发起人 主题发起人 Jiams
  • 开始时间 开始时间
J

Jiams

Unregistered / Unconfirmed
GUEST, unregistred user!
客户有发数据给服务程序,服务程序WSARcev会有IO_Pending.
可是到GetQueuedCompletionStatus时塞上.各位看看有什么问题.
(winsock2.pas我用过INDY的idwinsock2.pas和http://codecentral.borland.com/codecentral/ccweb.exe/files?id=16014的winsock2.pas两者)
Server代码(可直接拷贝后变可编译)
unit ICP;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,winsock2,
Dialogs, StdCtrls,SyncObjs;

CONST
DATA_BUFSIZE=4096;
SERVER_IP='192.168.1.101';
iPort=88;
MAXTHREAD_COUNT= 8;
type
//用来标识套接字IO动作类型;
PIO_OPERATION=^IO_OPERATION;
IO_OPERATION=(
IoAccept,
IoRead, //WSARecv/recv/ReadFile
IoWrite, //WSASend/send/WriteFile
IoEnd);


//自定义结构，即“完成键”(单句柄数据)
PPER_HANDLE_DATA=^PER_HANDLE_DATA;
PER_HANDLE_DATA=packed record
Socket: TSOCKET;
ClientAddr: TSockAddr;
// 在这里还可以加入其他和客户端关联的数据
end;


//单IO数据，扩展的WSAOVERLAPPED
PPER_IO_DATA=^PER_IO_DATA;
PER_IO_DATA=packed record
overlapped: TOverlapped;
DataBuf: WSABUF;
IoOperation: IO_OPERATION;
end;


type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
sListen:TSocket;
WSAData:TWSADATA;
ExitICOP,ExitListen:Boolean;
DebugIoEvent:TEvent;
ini:Text;
ConnectCount: Integer;

function InitCompletionPort:THandle;
function BindListen(const IP:String;Port:Integer):TSocket;
Procedure WSACheckError(code:DWORD);
procedure InitSock();
function ServerWorkerThread(IC:Pointer):Integer;
procedure ServerListenThread;
procedure Read(sAccept:TSocket;Cli:TSockAddr;CompletionPort:DWORD);

implementation

uses Unit2, DbugIntf;

{$R *.dfm}
function ServerWorkerThread(IC:Pointer):Integer;
var
BytesTransferred: DWORD;
SendBytes,Flags: DWORD;
rlt:LongBool;
pPerHandleData: PPER_HANDLE_DATA;
pPerIoData: PPER_IO_DATA;
CompletionPort: THandle;
buf: Array[0..DATA_BUFSIZE-1] of Ansichar;
begin
CompletionPort:=THandle(IC);

// GetMem(pPerIoData,sizeof(PER_IO_DATA));
// pPerIoData.overlapped:=overlapped;
// pPerIoData.DataBuf.buf:=buf;
// pPerIoData.DataBuf.len:=DATA_BUFSIZE;
// pPerIoData.IoOperation:=IoAccept;
// GetMem(pPerHandleData,sizeof(PER_HANDLE_DATA));
// pPerHandleData.Socket:=0;
// FillChar(pPerHandleData.ClientAddr,sizeof(TSockAddrIn),0);
pPerIoData:=nil;
pPerHandleData:=nil;
while not ExitICOP do begin
rlt:=GetQueuedCompletionStatus(CompletionPort,BytesTransferred,DWORD(pPerHandleData),POVerlapped(pPerIoData),Infinite);
if rlt=false then Begin
// ShowMessage(IntToStr(GetLastError()));
Continue;
end;
if (BytesTransferred=0) then Continue;
if pPerIoData.IoOperation=IORead then begin
DebugIoEvent.WaitFor(infinite);
DebugIoEvent.ResetEvent;
buf[0]:=pPerIoData.DataBuf.buf^;
writeln(ini,strpas(buf));
Inc(ConnectCount);
DebugIoEvent.SetEvent;
end;
Flags:=0;
ZeroMemory(@(pPerIoData.Overlapped),sizeof(OVERLAPPED));
pPerIoData.DataBuf.len := DATA_BUFSIZE;
pPerIoData.IoOperation:=IOWrite;
pPerIoData.DataBuf.buf:=buf;
WSASend(pPerHandleData.Socket,@(pPerIoData.DataBuf),1,SendBytes,Flags,@(pPerIoData.overlapped),nil);
end;


PostQueuedCompletionStatus(CompletionPort,0,0,nil);
result:=0;
end;

procedure ServerListenThread;
var
iLen: Integer;
Cli: TSockAddr;
sAccept: TSocket;
CompletionPort:DWORD;
begin
CompletionPort:=InitCompletionPort();
InitSock();
sListen:=BindListen(SERVER_IP,iPort);
iLen:=SizeOf(Cli);
while not ExitListen do begin
sAccept:=Accept(sListen,cli,iLen);
if(sAccept=INVALID_SOCKET) then begin
ShowMessage('INVAILID_SOKET');
end;
read(sAccept,Cli,CompletionPort);
end;
end;

procedure Read(sAccept:TSocket;Cli:TSockAddr;CompletionPort:DWORD);
var
pPerHandleData: PPER_HANDLE_DATA;
pPerIoData: PPER_IO_DATA;
buf:array[0..DATA_BUFSIZE-1] of Char;
RecvBytes, Flags: DWORD;
rlt,err:Integer;
begin
GetMem(pPerIOData,sizeof(PER_IO_DATA));
pPerIoData.DataBuf.len:=DATA_BUFSIZE;
FillChar(buf,DATA_BUFSIZE,0);
pPerIoData.DataBuf.buf:=buf;
FillChar(pPerIoData.overlapped,sizeof(TOverlapped),0);
pPerIoData.IoOperation:=IoRead;

GetMem(pPerHandleData,sizeof(PER_HANDLE_DATA));
pPerHandleData.Socket:=sAccept;
pPerHandleData.ClientAddr:=Cli;
if (CreateIoCompletionPort(pPerHandleData.Socket,CompletionPort,DWORD(pPerHandleData),0)=0) then exit;

Flags:=WSA_FLAG_OVERLAPPED; //▲这里Flags:=0可以通过,不然总是在GetQueuedCompletionStatus时塞住,请各位看下,给出原因

rlt:=WSARecv(pPerHandleData.Socket,@(pPerIoData.DataBuf),1,RecvBytes,Flags,@(pPerIoData.overlapped),nil);

if rlt=SOCKET_ERROR then begin
err:=WSAGetLastError();
if err<>ERROR_IO_PENDING then ShowMessage('Error Receive');
end;

ServerWorkerThread(CompletionPort);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ThreadHandle:THandle;
threadID:DWORD;
begin
ThreadHandle:=BeginThread(Nil,0,@ServerListenThread,nil,0,threadID);
CloseHandle(ThreadHandle);
Button1.Enabled:=False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ExitICOP:=True;
ExitListen:=True;
sleep(1000);
shutdown(sListen,SD_BOTH);
closesocket(sListen);
WSACleanup();
DebugIoEvent.Free;
CloseFile(ini);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
AssignFile(ini,'c:/aa.txt');
ReWrite(ini);
DebugIoEvent:=TEvent.Create(nil,True,True,'');
ExitListen:=False;
ExitICOP:=False;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DebugIoEvent.WaitFor(infinite);
DebugIoEvent.ResetEvent;
Label1.Caption:=IntToStr(ConnectCount);
DebugIoEvent.SetEvent;
end;

function BindListen(const IP:String;Port:Integer):TSocket;
Var
sListen:TSocket;
SerAddr:TSockAddr;
begin
SerAddr.sin_family := AF_INET;
SerAddr.sin_port := htons(Port);
SerAddr.sin_addr.S_addr := inet_addr(Pchar(Ip));
sListen:=WSASocket(af_inet,SOCK_STREAM,IPPROTO_IP,nil,0,WSA_FLAG_OVERLAPPED);
Bind(sListen,@SerAddr,sizeof(SerAddr));
Listen(sListen,5);
Result:=sListen;
end;

procedure InitSock();
var
WSAData:TWSAData;
begin
WSACheckError(WSAStartup(MakeWord(2,2),WSAData));
end;

Procedure WSACheckError(code:DWORD);
var
err:Integer;
begin
if code=INVALID_SOCKET then
Begin
err:=WSAGetLastError();
ShowMessage(IntToStr(err));
end;
end;

function InitCompletionPort:THandle;
var
i:integer;
ThreadHandle:THandle;
CompletionPort:THandle;
threadId:DWORD;
begin
CompletionPort:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,0);
// for i:=0 to 0 do begin
// ThreadHandle:=BeginThread(Nil,0,@ServerWorkerThread,Ptr(CompletionPort),0,threadID);
// CloseHandle(ThreadHandle);
// end;
result:=CompletionPort;
end;

end.


/////////////////////////////////
Fom1.dfm
//////////////////////////////////

object Form1: TForm1
Left = 384
Top = 270
Width = 281
Height = 154
Caption = 'ICP'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 152
Top = 88
Width = 32
Height = 13
Caption = 'Label1'
end
object Button1: TButton
Left = 16
Top = 16
Width = 75
Height = 25
Caption = 'StartSvr'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 48
Top = 80
Width = 81
Height = 25
Caption = 'ConnectCount'
TabOrder = 1
OnClick = Button2Click
end
end
 
客户有发数据给服务程序,服务程序WSARcev会有IO_Pending.
可是到GetQueuedCompletionStatus时塞上.各位看看有什么问题.
(winsock2.pas我用过INDY的idwinsock2.pas和http://codecentral.borland.com/codecentral/ccweb.exe/files?id=16014的winsock2.pas两者)
Server代码(可直接拷贝后变可编译)
unit ICP;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,winsock2,
Dialogs, StdCtrls,SyncObjs;

CONST
DATA_BUFSIZE=4096;
SERVER_IP='192.168.1.101';
iPort=88;
MAXTHREAD_COUNT= 8;
type
//用来标识套接字IO动作类型;
PIO_OPERATION=^IO_OPERATION;
IO_OPERATION=(
IoAccept,
IoRead, //WSARecv/recv/ReadFile
IoWrite, //WSASend/send/WriteFile
IoEnd);


//自定义结构，即“完成键”(单句柄数据)
PPER_HANDLE_DATA=^PER_HANDLE_DATA;
PER_HANDLE_DATA=packed record
Socket: TSOCKET;
ClientAddr: TSockAddr;
// 在这里还可以加入其他和客户端关联的数据
end;


//单IO数据，扩展的WSAOVERLAPPED
PPER_IO_DATA=^PER_IO_DATA;
PER_IO_DATA=packed record
overlapped: TOverlapped;
DataBuf: WSABUF;
IoOperation: IO_OPERATION;
end;


type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
sListen:TSocket;
WSAData:TWSADATA;
ExitICOP,ExitListen:Boolean;
DebugIoEvent:TEvent;
ini:Text;
ConnectCount: Integer;

function InitCompletionPort:THandle;
function BindListen(const IP:String;Port:Integer):TSocket;
Procedure WSACheckError(code:DWORD);
procedure InitSock();
function ServerWorkerThread(IC:Pointer):Integer;
procedure ServerListenThread;
procedure Read(sAccept:TSocket;Cli:TSockAddr;CompletionPort:DWORD);

implementation

uses Unit2, DbugIntf;

{$R *.dfm}
function ServerWorkerThread(IC:Pointer):Integer;
var
BytesTransferred: DWORD;
SendBytes,Flags: DWORD;
rlt:LongBool;
pPerHandleData: PPER_HANDLE_DATA;
pPerIoData: PPER_IO_DATA;
CompletionPort: THandle;
buf: Array[0..DATA_BUFSIZE-1] of Ansichar;
begin
CompletionPort:=THandle(IC);

// GetMem(pPerIoData,sizeof(PER_IO_DATA));
// pPerIoData.overlapped:=overlapped;
// pPerIoData.DataBuf.buf:=buf;
// pPerIoData.DataBuf.len:=DATA_BUFSIZE;
// pPerIoData.IoOperation:=IoAccept;
// GetMem(pPerHandleData,sizeof(PER_HANDLE_DATA));
// pPerHandleData.Socket:=0;
// FillChar(pPerHandleData.ClientAddr,sizeof(TSockAddrIn),0);
pPerIoData:=nil;
pPerHandleData:=nil;
while not ExitICOP do begin
rlt:=GetQueuedCompletionStatus(CompletionPort,BytesTransferred,DWORD(pPerHandleData),POVerlapped(pPerIoData),Infinite);
if rlt=false then Begin
// ShowMessage(IntToStr(GetLastError()));
Continue;
end;
if (BytesTransferred=0) then Continue;
if pPerIoData.IoOperation=IORead then begin
DebugIoEvent.WaitFor(infinite);
DebugIoEvent.ResetEvent;
buf[0]:=pPerIoData.DataBuf.buf^;
writeln(ini,strpas(buf));
Inc(ConnectCount);
DebugIoEvent.SetEvent;
end;
Flags:=0;
ZeroMemory(@(pPerIoData.Overlapped),sizeof(OVERLAPPED));
pPerIoData.DataBuf.len := DATA_BUFSIZE;
pPerIoData.IoOperation:=IOWrite;
pPerIoData.DataBuf.buf:=buf;
WSASend(pPerHandleData.Socket,@(pPerIoData.DataBuf),1,SendBytes,Flags,@(pPerIoData.overlapped),nil);
end;


PostQueuedCompletionStatus(CompletionPort,0,0,nil);
result:=0;
end;

procedure ServerListenThread;
var
iLen: Integer;
Cli: TSockAddr;
sAccept: TSocket;
CompletionPort:DWORD;
begin
CompletionPort:=InitCompletionPort();
InitSock();
sListen:=BindListen(SERVER_IP,iPort);
iLen:=SizeOf(Cli);
while not ExitListen do begin
sAccept:=Accept(sListen,cli,iLen);
if(sAccept=INVALID_SOCKET) then begin
ShowMessage('INVAILID_SOKET');
end;
read(sAccept,Cli,CompletionPort);
end;
end;

procedure Read(sAccept:TSocket;Cli:TSockAddr;CompletionPort:DWORD);
var
pPerHandleData: PPER_HANDLE_DATA;
pPerIoData: PPER_IO_DATA;
buf:array[0..DATA_BUFSIZE-1] of Char;
RecvBytes, Flags: DWORD;
rlt,err:Integer;
begin
GetMem(pPerIOData,sizeof(PER_IO_DATA));
pPerIoData.DataBuf.len:=DATA_BUFSIZE;
FillChar(buf,DATA_BUFSIZE,0);
pPerIoData.DataBuf.buf:=buf;
FillChar(pPerIoData.overlapped,sizeof(TOverlapped),0);
pPerIoData.IoOperation:=IoRead;

GetMem(pPerHandleData,sizeof(PER_HANDLE_DATA));
pPerHandleData.Socket:=sAccept;
pPerHandleData.ClientAddr:=Cli;
if (CreateIoCompletionPort(pPerHandleData.Socket,CompletionPort,DWORD(pPerHandleData),0)=0) then exit;

Flags:=WSA_FLAG_OVERLAPPED; //▲这里Flags:=0可以通过,不然总是在GetQueuedCompletionStatus时塞住,请各位看下,给出原因

rlt:=WSARecv(pPerHandleData.Socket,@(pPerIoData.DataBuf),1,RecvBytes,Flags,@(pPerIoData.overlapped),nil);

if rlt=SOCKET_ERROR then begin
err:=WSAGetLastError();
if err<>ERROR_IO_PENDING then ShowMessage('Error Receive');
end;

ServerWorkerThread(CompletionPort);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ThreadHandle:THandle;
threadID:DWORD;
begin
ThreadHandle:=BeginThread(Nil,0,@ServerListenThread,nil,0,threadID);
CloseHandle(ThreadHandle);
Button1.Enabled:=False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ExitICOP:=True;
ExitListen:=True;
sleep(1000);
shutdown(sListen,SD_BOTH);
closesocket(sListen);
WSACleanup();
DebugIoEvent.Free;
CloseFile(ini);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
AssignFile(ini,'c:/aa.txt');
ReWrite(ini);
DebugIoEvent:=TEvent.Create(nil,True,True,'');
ExitListen:=False;
ExitICOP:=False;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DebugIoEvent.WaitFor(infinite);
DebugIoEvent.ResetEvent;
Label1.Caption:=IntToStr(ConnectCount);
DebugIoEvent.SetEvent;
end;

function BindListen(const IP:String;Port:Integer):TSocket;
Var
sListen:TSocket;
SerAddr:TSockAddr;
begin
SerAddr.sin_family := AF_INET;
SerAddr.sin_port := htons(Port);
SerAddr.sin_addr.S_addr := inet_addr(Pchar(Ip));
sListen:=WSASocket(af_inet,SOCK_STREAM,IPPROTO_IP,nil,0,WSA_FLAG_OVERLAPPED);
Bind(sListen,@SerAddr,sizeof(SerAddr));
Listen(sListen,5);
Result:=sListen;
end;

procedure InitSock();
var
WSAData:TWSAData;
begin
WSACheckError(WSAStartup(MakeWord(2,2),WSAData));
end;

Procedure WSACheckError(code:DWORD);
var
err:Integer;
begin
if code=INVALID_SOCKET then
Begin
err:=WSAGetLastError();
ShowMessage(IntToStr(err));
end;
end;

function InitCompletionPort:THandle;
var
i:integer;
ThreadHandle:THandle;
CompletionPort:THandle;
threadId:DWORD;
begin
CompletionPort:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,0);
// for i:=0 to 0 do begin
// ThreadHandle:=BeginThread(Nil,0,@ServerWorkerThread,Ptr(CompletionPort),0,threadID);
// CloseHandle(ThreadHandle);
// end;
result:=CompletionPort;
end;

end.


/////////////////////////////////
Fom1.dfm
//////////////////////////////////

object Form1: TForm1
Left = 384
Top = 270
Width = 281
Height = 154
Caption = 'ICP'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 152
Top = 88
Width = 32
Height = 13
Caption = 'Label1'
end
object Button1: TButton
Left = 16
Top = 16
Width = 75
Height = 25
Caption = 'StartSvr'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 48
Top = 80
Width = 81
Height = 25
Caption = 'ConnectCount'
TabOrder = 1
OnClick = Button2Click
end
end
 
GetQueuedCompletionStatus 当然塞住了.你怎么建那么多完成端口啊??
 
学习
 

我看你是要这个吧,有全部源码.

http://m150.mail.126.com/coremail/fcg/ldmsapp/windows.rar?lettsid=VATZcpFGftSAyzQJ&mid=1tbiGQhJoEH3UvE7swAAsl%250A25%250A8388762%250A1&funcid=readpart&part=3&filename=windows.rar&download=1


如果下载了打不开就加 .rar 里面应该有你要的,花了我不少的TIME


 
To:李连杰
我没法下呀,怎么回事?
可以发到我邮箱吗?
jiams_wang@163.com
谢谢!
 
是在我的邮箱里的,用网际快车新建下载任务的地址栏输入:

http://m150.mail.126.com/coremail/fcg/ldmsapp/windows.rar?lettsid=VATZcpFGftSAyzQJ&mid=1tbiGQhJoEH3UvE7swAAsl%250A25%250A8388762%250A1&funcid=readpart&part=3&filename=windows.rar&download=1
 
参考：http://blog.csdn.net/51357/archive/2005/02/05/282106.aspx
 
To:zhongs
看了下http://blog.csdn.net/51357/archive/2005/02/05/282106.aspx和我的测试的区别
1。应先在Recv前将Accept后的句柄和完成端口关联；
2。检查完成端口关联是否成功
3。BeginThread(Nil,0,@ServerWorkerThread,@CompletionPort,0,threadID)改为
BeginThread(nil,0,@ServerWorkerThread,Ptr(CompletionPort,0,threadID)是个
好主意。这样 CompletionPort:=THandle(IC^)要改为CompletionPort=Thandle(IC)
(在线程间它们是否共享一个地址空间？)
4。▲处你的代码是Flags:=0,这样可以是为何？ (我将此处改为Flags:=0后正常通过)
 
完成端口不用线程。。。。。

汗！
 
while not ExitICOP do begin
rlt:=GetQueuedCompletionStatus(CompletionPort,BytesTransferred,DWORD(pPerHandleData),POVerlapped(pPerIoData),Infinite);
if rlt=false then Begin
// ShowMessage(IntToStr(GetLastError()));
Continue;
end;
if (BytesTransferred=0) then Continue;

这里面就有问题，可能你还没理解GetQueuedCompletionStatus()函数的用法，
它是一定要在执行接收或发送数据(WSARecv/WSASend)后才能执行，
如果没有数据到达或发送完成，它就处于阻塞状态，所以才要摆到线程来执行

而你上面的代码当rlt=false时，就continue，
此时你没有错误处理，也没有调用WSARecv/WSASend，接着再执行GetQueuedCompletionStatus()，就会一直嵌入死阻塞或死循环(具体要调试才知是出现那种情况)

 
服务程序WSARcev会有IO_Pending,当然有WSARecev
 
贴子太长了，真是没心情看。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2863644
给你个贴子看看，主要看看他们（第一个）用的是什么模式和顺序，我想对你会有帮助的。
 
您必须登录或注册才可回复。

Similar threads

I
一个有助于用纯API建立窗口的单元 [ small.pas ]
回复
0
查看
594
import
I
I
对串口的简单读取
回复
0
查看
775
import
I
I
一个IE工具单元
回复
0
查看
830
import
I
I
一个IE　COM接口的例子
回复
0
查看
728
import
I
M
请问这个判断端口的函数为何返回FALSE(看看吧, 不超过20行)? 在线等候,(200)
回复
2
查看
470
mrniu
M
后退
顶部