经验分享2：WSAASYNCSelect 开发之无窗体句柄解决方案 ( 积分: 0 )

  • 主题发起人 主题发起人 leaber
  • 开始时间 开始时间
L

leaber

Unregistered / Unconfirmed
GUEST, unregistred user!
WSAASYNCSelect 开发之无窗体句柄解决方案
leaber

WSAASYNCSelect 简单易用，但是开发的时候需要相应的句柄来进行消息传递，
当然用FORM的句柄是最简便的，如果没有FORM如何解决:

1、增加一个HANDLE属性和相应的方法
2、为一个没有HANDLE的类加入消息处理功能,
3、增加一个消息分发的过程。

剩下就可以直接在类里面要处理消息的方法。
TSERVERSOCKET里面的实现就用到这种方式，记不太清了。
}

unit WsaServer;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Winsock;
const WM_Server = WM_USER + 5;
type
TSockets = array[1..64] of TSocket;
TConnectEvent = procedure (Sender: TObject) of object;
TReadEvent = procedure (Sender: TObject; Buffer: string;Skt:TSocket) of
object;
TWsaServer = class(TObject)
private
FCurrSocket: TSocket;
FHandle: THandle;
FNum: Integer;
FOnConnectEvent: TConnectEvent;
FOnReadEvent: TReadEvent;
FServerSocket: TSocket;
FSockAddr: TSockAddrIn;
FSockets: TSockets;
FWorkFlag: Boolean;
FWsaData: TWsaData;
function GetHandle: THandle;
function GetHost: string;
function GetPort: Integer;
function GetSockets(index:integer): TSocket;
procedure SetHost(const Value: string);
procedure SetPort(Value: Integer);
protected
procedure ProcessMsg(var Msg: TMessage); message WM_Server;
procedure WndProc(var Message: TMessage);
public
constructor Create;
destructor Destroy; override;
procedure SendMsg(MyMsg: string); virtual;
procedure Start; virtual;
procedure Stop; virtual;
procedure WorkIt; virtual;
property CurrSocket: TSocket read FCurrSocket;
property Handle: THandle read GetHandle;
property Host: string read GetHost write SetHost;
property Port: Integer read GetPort write SetPort;
property Sockets[index:integer]: TSocket read GetSockets;
published
property OnConnectEvent: TConnectEvent read FOnConnectEvent write
FOnConnectEvent;
property OnReadEvent: TReadEvent read FOnReadEvent write FOnReadEvent;
end;


implementation


{
********************************** TWsaServer **********************************
}
constructor TWsaServer.Create;
begin
if WSAStartUp($0202,FWsaData)<>0 then
Exception.Create('Init WINSOCK.DLL failed with'+ inttostr(WSAGetLastError()));
FNum:=0;
ZeroMemory(@FSockAddr,SizeOf(FSockAddr));
end;

destructor TWsaServer.Destroy;
begin

if FHandle <> 0 then
DeallocateHWnd(FHandle);


end;

function TWsaServer.GetHandle: THandle;
begin
if FHandle = 0 then
FHandle := AllocateHwnd(WndProc);
//这里实现了虚拟窗口，为以后的消息响应做准备
Result := FHandle;
end;

function TWsaServer.GetHost: string;
begin
Result:=inttostr(ntohs(FSockAddr.sin_addr.S_addr ));
end;

function TWsaServer.GetPort: Integer;
begin
Result:=ntohs(FSockAddr.sin_port);
end;

function TWsaServer.GetSockets(index:integer): TSocket;
begin
end;

procedure TWsaServer.ProcessMsg(var Msg: TMessage);
var
Event: Word;
Sa: TSockAddrin;
i: Integer;
Client: TSocket;
RecvBuffer: string;
begin
Event := Word(Msg.LParam);
case Event of
FD_ACCEPT:
begin
i:=SizeOf(Sa);
Client:=Accept(FServerSocket,@Sa,@i);
if Client=INVALID_SOCKET then
Exception.Create('Client Accept failed error with '+ inttostr(WSAGetLastError()));
WSAAsyncSelect(Client,Handle,WM_Server,FD_READ or FD_CLOSE);
FNum:=FNum+1;
FSockets[FNum]:=Client;
FCurrSocket:=Client;
end;
FD_READ:
begin
FCurrSocket:=TSocket(Msg.WParam );
SetLength(RecvBuffer,1024);
i:=Recv(FCurrSocket,RecvBuffer[1],1024,0);
if Assigned(OnReadEvent) then
OnReadEvent(nil,RecvBuffer,CurrSocket);
end;
FD_CLOSE:
begin
CloseSocket(TSocket(Msg.WParam ));
//删掉数组里的内容
end;

end;

end;

procedure TWsaServer.SendMsg(MyMsg: string);
var
I: Integer;
begin
i:=Send(CurrSocket,MyMsg,Length(MyMsg),0);
if i<> Length(MyMsg) then
raise Exception.Create('Send Msg Failed ');
end;

procedure TWsaServer.SetHost(const Value: string);
begin

FSockAddr.sin_addr.S_addr:=INET_ADDR(pchar(Value));
end;

procedure TWsaServer.SetPort(Value: Integer);
begin
FSockAddr.sin_port:=htons(Value);
end;

procedure TWsaServer.Start;
begin
FWorkFlag:=True;
end;

procedure TWsaServer.Stop;
begin
FWorkFlag:=False;
end;

procedure TWsaServer.WndProc(var Message: TMessage);
begin
try
Dispatch(Message);
except
if Assigned(ApplicationHandleException) then
ApplicationHandleException(Self);
end;
end;

procedure TWsaServer.WorkIt;
begin
FServerSocket:=Socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
if FServerSocket=INVALID_SOCKET then
raise Exception.Create('Socket Build Failed with error '+ inttostr(GetLastError()));
FSockAddr.sin_family :=PF_INET;
if bind(FServerSocket,FSockAddr,SizeOf(FSockAddr))<>0 then
raise Exception.Create('bind Failed with error'+ inttostr(GetLastError()));
Listen(FServerSocket,6);
WSAAsyncSelect(FServerSocket,Handle,WM_Server,FD_ACCEPT );
end;
end.
 
WSAASYNCSelect 开发之无窗体句柄解决方案
leaber

WSAASYNCSelect 简单易用，但是开发的时候需要相应的句柄来进行消息传递，
当然用FORM的句柄是最简便的，如果没有FORM如何解决:

1、增加一个HANDLE属性和相应的方法
2、为一个没有HANDLE的类加入消息处理功能,
3、增加一个消息分发的过程。

剩下就可以直接在类里面要处理消息的方法。
TSERVERSOCKET里面的实现就用到这种方式，记不太清了。
}

unit WsaServer;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Winsock;
const WM_Server = WM_USER + 5;
type
TSockets = array[1..64] of TSocket;
TConnectEvent = procedure (Sender: TObject) of object;
TReadEvent = procedure (Sender: TObject; Buffer: string;Skt:TSocket) of
object;
TWsaServer = class(TObject)
private
FCurrSocket: TSocket;
FHandle: THandle;
FNum: Integer;
FOnConnectEvent: TConnectEvent;
FOnReadEvent: TReadEvent;
FServerSocket: TSocket;
FSockAddr: TSockAddrIn;
FSockets: TSockets;
FWorkFlag: Boolean;
FWsaData: TWsaData;
function GetHandle: THandle;
function GetHost: string;
function GetPort: Integer;
function GetSockets(index:integer): TSocket;
procedure SetHost(const Value: string);
procedure SetPort(Value: Integer);
protected
procedure ProcessMsg(var Msg: TMessage); message WM_Server;
procedure WndProc(var Message: TMessage);
public
constructor Create;
destructor Destroy; override;
procedure SendMsg(MyMsg: string); virtual;
procedure Start; virtual;
procedure Stop; virtual;
procedure WorkIt; virtual;
property CurrSocket: TSocket read FCurrSocket;
property Handle: THandle read GetHandle;
property Host: string read GetHost write SetHost;
property Port: Integer read GetPort write SetPort;
property Sockets[index:integer]: TSocket read GetSockets;
published
property OnConnectEvent: TConnectEvent read FOnConnectEvent write
FOnConnectEvent;
property OnReadEvent: TReadEvent read FOnReadEvent write FOnReadEvent;
end;


implementation


{
********************************** TWsaServer **********************************
}
constructor TWsaServer.Create;
begin
if WSAStartUp($0202,FWsaData)<>0 then
Exception.Create('Init WINSOCK.DLL failed with'+ inttostr(WSAGetLastError()));
FNum:=0;
ZeroMemory(@FSockAddr,SizeOf(FSockAddr));
end;

destructor TWsaServer.Destroy;
begin

if FHandle <> 0 then
DeallocateHWnd(FHandle);


end;

function TWsaServer.GetHandle: THandle;
begin
if FHandle = 0 then
FHandle := AllocateHwnd(WndProc);
//这里实现了虚拟窗口，为以后的消息响应做准备
Result := FHandle;
end;

function TWsaServer.GetHost: string;
begin
Result:=inttostr(ntohs(FSockAddr.sin_addr.S_addr ));
end;

function TWsaServer.GetPort: Integer;
begin
Result:=ntohs(FSockAddr.sin_port);
end;

function TWsaServer.GetSockets(index:integer): TSocket;
begin
end;

procedure TWsaServer.ProcessMsg(var Msg: TMessage);
var
Event: Word;
Sa: TSockAddrin;
i: Integer;
Client: TSocket;
RecvBuffer: string;
begin
Event := Word(Msg.LParam);
case Event of
FD_ACCEPT:
begin
i:=SizeOf(Sa);
Client:=Accept(FServerSocket,@Sa,@i);
if Client=INVALID_SOCKET then
Exception.Create('Client Accept failed error with '+ inttostr(WSAGetLastError()));
WSAAsyncSelect(Client,Handle,WM_Server,FD_READ or FD_CLOSE);
FNum:=FNum+1;
FSockets[FNum]:=Client;
FCurrSocket:=Client;
end;
FD_READ:
begin
FCurrSocket:=TSocket(Msg.WParam );
SetLength(RecvBuffer,1024);
i:=Recv(FCurrSocket,RecvBuffer[1],1024,0);
if Assigned(OnReadEvent) then
OnReadEvent(nil,RecvBuffer,CurrSocket);
end;
FD_CLOSE:
begin
CloseSocket(TSocket(Msg.WParam ));
//删掉数组里的内容
end;

end;

end;

procedure TWsaServer.SendMsg(MyMsg: string);
var
I: Integer;
begin
i:=Send(CurrSocket,MyMsg,Length(MyMsg),0);
if i<> Length(MyMsg) then
raise Exception.Create('Send Msg Failed ');
end;

procedure TWsaServer.SetHost(const Value: string);
begin

FSockAddr.sin_addr.S_addr:=INET_ADDR(pchar(Value));
end;

procedure TWsaServer.SetPort(Value: Integer);
begin
FSockAddr.sin_port:=htons(Value);
end;

procedure TWsaServer.Start;
begin
FWorkFlag:=True;
end;

procedure TWsaServer.Stop;
begin
FWorkFlag:=False;
end;

procedure TWsaServer.WndProc(var Message: TMessage);
begin
try
Dispatch(Message);
except
if Assigned(ApplicationHandleException) then
ApplicationHandleException(Self);
end;
end;

procedure TWsaServer.WorkIt;
begin
FServerSocket:=Socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
if FServerSocket=INVALID_SOCKET then
raise Exception.Create('Socket Build Failed with error '+ inttostr(GetLastError()));
FSockAddr.sin_family :=PF_INET;
if bind(FServerSocket,FSockAddr,SizeOf(FSockAddr))<>0 then
raise Exception.Create('bind Failed with error'+ inttostr(GetLastError()));
Listen(FServerSocket,6);
WSAAsyncSelect(FServerSocket,Handle,WM_Server,FD_ACCEPT );
end;
end.
 
leaber大哥~ 你好，你这个代码如何用到控制台中呢？应该怎么引用？
我最近在写一个控制台下的服务端，但是控制台没有窗口，WSAAsyncSelect的第2个参数需要输入窗口的句柄，那我应该怎么办呢？
能否留下你的QQ号，我想和你详细讨论一下！
 
人家文章题目就是——WSAASYNCSelect 开发之无窗体句柄解决方案
 
代码的功能不完整，但是解决方案的代码已经很清楚了.
 
您必须登录或注册才可回复。

Similar threads

L
IOCP Delphi代码(0分)
回复
2
查看
394
密码忘了
密
B
分享 解决flashengin1.08对flash8之后的callfunction和onflashcall问题 ( 积分: 0 )
回复
3
查看
431
QSmile
Q
R
关于完成端口的问题，运行出错之后就无法再接收到包 ( 积分: 20 )
回复
8
查看
332
rong007
R
L
经验分享1： connect 、recv、send 超时解决方案 ( 积分: 0 )
2
回复
20
查看
295
行到水穷处
行
Z
DLL学习问题及解决方案(欢迎各位大富翁来此讨论)(0分)
回复
4
查看
166
hong2002
H
后退
顶部