自己写的组件，求高手解答，使用的是TCPunit WinSocketClass;interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
WinSockAll, SyncObjs,StrUtils,StdCtrls;const
WM_SOCKET = WM_USER + 455;
WM_SERVER_SOCKET = WM_SOCKET;
WM_CLIENT_SOCKET =WM_SOCKET+1;
type TOnReadStr = function (const sSocket: TSocket; const sRet:string):Boolean of object;
TOnSvrAccept = function (const sClient: TSocket; const addrClient: TSockAddrIn):Boolean of object;
TWinSocketServer = Class(TObject)
private
FHwnd :HWND;
FSocket: TSocket;
FbSvrReady: Boolean;
FClientSocketList:TList;
FClientAddrList:TList;
FOnReadStr: TOnReadStr;
FOnSvrAccept: TOnSvrAccept;
procedure WndProc(var Msg: TMessage);
procedure WMSocket(var Msg: TMessage); message WM_SERVER_SOCKET;
procedure SetOnReadStr(const Value: TOnReadStr);
procedure SetOnSvrAccept(const Value: TOnSvrAccept);
protected
function DoOnRead(const sSocket: TSocket; const sRet:string):Boolean;
function DoOnAccept(const sClient: TSocket; const addrClient: TSockAddrIn):Boolean;
public
function Bind(iPort:WORD; bUDP:Boolean):Boolean;
function Listen(iMaxCount:Integer=5):Boolean;
function Send(Socket:TSocket; sStr:string):Boolean;
function SendByIndex(SocketIndex:Integer; sStr:string):Integer;
constructor create();virtual;
destructor Destroy; override;
property ClientSocketList: TList read FClientSocketList;
property ClientAddrList: TList read FClientAddrList;
property OnReadStr: TOnReadStr read FOnReadStr write SetOnReadStr;
property OnSvrAccept: TOnSvrAccept read FOnSvrAccept write SetOnSvrAccept;
published
end; TWinSocketClient = class(TObject)
private
FSocket:TSocket;
FbSvrConneted:Boolean;
FHwnd : HWND;
FOnReadStr: TOnReadStr;
procedure WndProc(var Msg: TMessage);
procedure WMSocket(var Msg: TMessage); message WM_CLIENT_SOCKET;
procedure SetOnReadStr(const Value: TOnReadStr);
protected
function DoOnRead(const sSocket: TSocket; const sRet:string):Boolean;
public
function Connect(sHost:string; iPort:WORD; bUDP:Boolean):Boolean;
function Send(sStr:string):Integer;
constructor create();virtual;
destructor Destroy; override;
property OnReadStr: TOnReadStr read FOnReadStr write SetOnReadStr;
published
end;implementationuses IdGlobal;{ TWinSocketServer }function TWinSocketServer.Bind(iPort:WORD; bUDP:Boolean): Boolean;
var
Addr: TSockAddrIn;
protocol, ret: Integer;
begin
Addr.sin_addr.s_addr:=WinSockAll.htonl(INADDR_ANY);
Addr.sin_port := WinSockAll.htons(iPort);
Addr.sin_family := PF_INET;
if bUDP then protocol := IPPROTO_UDP else protocol := IPPROTO_TCP;
FSocket := WinSockAll.socket(PF_INET, SOCK_STREAM, protocol);//IPPROTO_IP时为自动选择默认模式，一般为IPPROTO_TCP;
if FSocket = INVALID_SOCKET then Exit;
ret:=WinSockAll.Bind(FSocket, @Addr, SizeOf(TSockAddrIn));
if ret <> 0 then Exit;
WinSockAll.WSAAsyncSelect(FSocket, FHwnd, WM_SERVER_SOCKET, FD_ACCEPT or FD_CLOSE or FD_READ or FD_WRITE);
FbSvrReady:=True;
end;constructor TWinSocketServer.create;
begin
inherited;
FSocket := INVALID_SOCKET;
FbSvrReady := False;
FHwnd:=Classes.AllocateHwnd(WndProc);
FClientSocketList:=TList.Create;
FClientAddrList:=TList.Create;
end;destructor TWinSocketServer.Destroy;
begin
WinSockAll.CloseSocket(FSocket);
FbSvrReady := False;
FSocket := INVALID_SOCKET;
Classes.DeallocateHWnd(FHwnd);
FClientSocketList.Destroy;
while FClientAddrList.Count>0 do
begin
DisPose(FClientAddrList.Items[FClientAddrList.Count-1]);
FClientAddrList.Delete(FClientAddrList.Count-1);
end;
FClientAddrList.Destroy;
inherited;
end;function TWinSocketServer.DoOnAccept(const sClient: TSocket; const addrClient: TSockAddrIn): Boolean;
begin
if Assigned(FOnSvrAccept) then FOnSvrAccept(sClient, addrClient);
end;function TWinSocketServer.DoOnRead(const sSocket: TSocket; const sRet: string): Boolean;
begin
if Assigned(FOnReadStr) then FOnReadStr(sSocket, sRet);
end;function TWinSocketServer.Listen(iMaxCount:Integer=5): Boolean;
var
ret: Integer;
begin
if not FbSvrReady then Exit;
ret := WinSockAll.listen(FSocket, iMaxCount);
if ret <> 0 then Exit;
end;function TWinSocketServer.Send(Socket: TSocket; sStr: string): Boolean;
var
ret:Integer;
begin
if not FbSvrReady then Exit;
if FClientSocketList.IndexOf(Pointer(Socket))=-1 then Exit;
ret := WinSockAll.Send(Socket, PChar(sStr)^, Length(sStr), 0);
if ret=SOCKET_ERROR Then Exit;
end;function TWinSocketServer.SendByIndex(SocketIndex: Integer;
sStr: string): Integer;
var
ret:Integer;
ClientSocket: TSocket;
//pAddrClient: PSockAddr;
begin
Result := 0;
if not FbSvrReady then Exit;
if (SocketIndex <0) or (SocketIndex>=FClientSocketList.Count) then Exit;
ClientSocket := TSocket(FClientSocketList.Items[SocketIndex]);
//pAddrClient := FClientAddrList.Items[SocketIndex];
ret := WinSockAll.Send(ClientSocket, PChar(sStr)^, Length(sStr), 0);
//ret := WinSockAll.SendTo(ClientSocket, PChar(sStr)^, Length(sStr), 0, pAddrClient, SizeOf(TSockAddr));
if ret=SOCKET_ERROR Then Exit;
Result := ret;
end;procedure TWinSocketServer.SetOnReadStr(const Value: TOnReadStr);
begin
FOnReadStr := Value;
end;procedure TWinSocketServer.SetOnSvrAccept(const Value: TOnSvrAccept);
begin
FOnSvrAccept := Value;
end;procedure TWinSocketServer.WMSocket(var Msg: TMessage);
var
sEvent, sClient: TSocket;
pAddrClient: PSockAddr;
addrRemote: TSockAddrIn;
nAddrLen, nRecv, iBuffLen: Integer;
sRecv: string;
begin
//取得有事件发生的套接字
sEvent := Msg.WParam;
if (WinSockAll.WSAGetSelectError(Msg.lParam) <> 0)and
(FSocket<>sEvent) then
begin
WinSockAll.closesocket(sEvent);
exit;
end; //处理发生的事件
case WinSockAll.WSAGetSelectEvent(Msg.lParam) of
//监听的套接字检测到有连接进入
FD_ACCEPT:
begin
nAddrLen := SizeOf(addrRemote);
sClient := WinSockAll.accept(sEvent, @addrRemote, nAddrLen);
if sClient<>INVALID_SOCKET then
begin
WinSockAll.WSAAsyncSelect(sClient, FHwnd, WM_SERVER_SOCKET,
FD_READ or FD_WRITE or FD_CLOSE); if FClientSocketList.IndexOf(Pointer(sClient))=-1 then
begin
FClientSocketList.Add(Pointer(sClient));
New(pAddrClient);
pAddrClient^ := addrRemote;
FClientAddrList.Add(pAddrClient);
end;
DoOnAccept(sClient, addrRemote);
end;
// ShowMessage(inet_ntoa(addrRemote.sin_addr) + ' connected');
end;
FD_WRITE:
begin end;
FD_READ:
begin
WinSockAll.ioctlsocket(sEvent, FIONREAD, Longint(iBuffLen));
SetLength(sRecv, iBuffLen+1);
nRecv := WinSockAll.recv(sEvent, sRecv[1], iBuffLen+1, 0);
if nRecv = SOCKET_ERROR then
closesocket(sEvent)
else
begin
SetLength(sRecv, nRecv);
DoOnRead(sEvent, sRecv);
end;
end;
FD_CLOSE:
begin
WinSockAll.closesocket(sEvent);
if FClientSocketList.IndexOf(Pointer(sEvent))>-1 then
begin
DisPose(FClientAddrList.Items[FClientSocketList.IndexOf(Pointer(sEvent))]);
FClientAddrList.Delete(FClientSocketList.IndexOf(Pointer(sEvent)));
FClientSocketList.Delete(FClientSocketList.IndexOf(Pointer(sEvent)));
end;
//ShowMessage('Clent Quit');
end;
end;
SetLength(sRecv, 0);
end;procedure TWinSocketServer.WndProc(var Msg: TMessage);
begin
try
Dispatch(Msg);
except
if Assigned(ApplicationHandleException) then
ApplicationHandleException(Self);
end;
end;{ TWinSocketClient }procedure TWinSocketClient.WMSocket(var Msg: TMessage);
var
iBuffLen, nRecv: Integer;
sRecv: string;
begin
//客户端Socket
if Msg.WParam <> Integer(FSocket) then Exit; if WSAGetSelectError(Msg.lParam) = 0 then
begin
exit;
end;
case WSAGetSelectEvent( Msg.LParam ) of
FD_CONNECT: ;
FD_READ:
begin
WinSockAll.ioctlsocket(FSocket, FIONREAD, Longint(iBuffLen));
SetLength(sRecv, iBuffLen+1);
nRecv := WinSockAll.Recv(FSocket, sRecv[1], iBuffLen+1, 0);
if nRecv = SOCKET_ERROR then
else
begin
SetLength(sRecv, nRecv);
DoOnRead(FSocket, sRecv);
end;
end;
FD_WRITE: ;
FD_CLOSE: {closesocket(FSocket)};
end;
end;procedure TWinSocketClient.WndProc(var Msg: TMessage);
begin
try
Dispatch(Msg);
except
if Assigned(ApplicationHandleException) then
ApplicationHandleException(Self);
end;
end; function TWinSocketClient.Connect(sHost: string; iPort: WORD; bUDP:Boolean): Boolean;
var
Addr: TSockAddrIn;
protocol, ret: Integer;
sIP:string;
begin
WinSockAll.HostToIP(sHost, sIP);
Addr.sin_addr.s_addr:=WinSockAll.inet_addr(PChar(sIP));
Addr.sin_port := WinSockAll.htons(iPort);
Addr.sin_family := PF_INET;
if bUDP then protocol := IPPROTO_UDP else protocol := IPPROTO_TCP;
FSocket := WinSockAll.socket(PF_INET, SOCK_STREAM, protocol);//IPPROTO_IP时为自动选择默认模式，一般为IPPROTO_TCP;
if FSocket = INVALID_SOCKET then Exit;
Ret:=WinSockAll.connect(FSocket, @Addr, SizeOf(TSockAddrIn));
if ret <> 0 then
begin
WinSockAll.closesocket(FSocket);
FSocket := INVALID_SOCKET;
Exit;
end;
WinSockAll.WSAAsyncSelect(FSocket, FHwnd, WM_CLIENT_SOCKET, FD_CONNECT or FD_CLOSE or FD_READ or FD_WRITE);
FbSvrConneted:=True;
PostMessage(FHwnd, WM_CLIENT_SOCKET, FSocket, WSAMakeSelectReply(FD_CONNECT, 0));
end;constructor TWinSocketClient.create;
begin
inherited;
FSocket := INVALID_SOCKET;
FbSvrConneted := False;
FHwnd:=Classes.AllocateHwnd(WndProc);
end;
begin
WinSockAll.CloseSocket(FSocket);
FbSvrConneted := False;
FSocket := INVALID_SOCKET;
Classes.DeallocateHWnd(FHwnd);
inherited;
end;function TWinSocketClient.DoOnRead(const sSocket: TSocket; const sRet: string): Boolean;
begin
if Assigned(FOnReadStr) then FOnReadStr(sSocket, sRet);
end;function TWinSocketClient.Send(sStr: string): Integer;
var
ret:Integer;
begin
Result := 0;
if not FbSvrConneted then Exit;
ret := WinSockAll.send(FSocket, PChar(sStr)^, Length(sStr), 0);
if ret=SOCKET_ERROR Then Exit;
Result := ret;
end;procedure TWinSocketClient.SetOnReadStr(const Value: TOnReadStr);
begin
FOnReadStr := Value;
end;initialization
WinSockAll.WSAStartup();
finalization
WinSockAll.WSACleanup;
end.
DEMO源码 DemoSvr
Unit1.dfmobject Form1: TForm1
Left = 321
Top = 179
Width = 450
Height = 364
Caption = 'Form1'
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 ListBox1: TListBox
Left = 16
Top = 48
Width = 121
Height = 281
ItemHeight = 13
TabOrder = 0
end
object Edit1: TEdit
Left = 144
Top = 48
Width = 289
Height = 21
TabOrder = 1
Text = 'Edit1'
end
object Memo1: TMemo
Left = 144
Top = 80
Width = 289
Height = 209
Lines.Strings = (
'Memo1')
TabOrder = 2
end
object Button1: TButton
Left = 144
Top = 296
Width = 75
Height = 25
Caption = 'Send'
TabOrder = 3
OnClick = Button1Click
end
object Edit2: TEdit
Left = 226
Top = 298
Width = 201
Height = 21
TabOrder = 4
Text = 'Edit2'
end
object Edit3: TEdit
Left = 80
Top = 8
Width = 57
Height = 21
TabOrder = 5
Text = '7654'
end
object Button2: TButton
Left = 138
Top = 5
Width = 75
Height = 25
Caption = 'Bind'
TabOrder = 6
OnClick = Button2Click
end
object Edit4: TEdit
Left = 272
Top = 8
Width = 73
Height = 21
TabOrder = 7
Text = '6'
end
object Button3: TButton
Left = 350
Top = 6
Width = 75
Height = 25
Caption = 'Listen'
TabOrder = 8
OnClick = Button3Click
end
object CheckBox1: TCheckBox
Left = 16
Top = 8
Width = 57
Height = 17
Caption = 'UDP'
TabOrder = 9
end
object IdUDPClient1: TIdUDPClient
Port = 0
Left = 72
Top = 80
end
object IdUDPServer1: TIdUDPServer
Bindings = <>
DefaultPort = 0
Left = 160
Top = 72
end
end
============================
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
WinSocketClass, WinSockAll,
Dialogs, StdCtrls, IdUDPServer, IdBaseComponent, IdComponent, IdUDPBase,
IdUDPClient;type
TForm1 = class(TForm)
ListBox1: TListBox;
Edit1: TEdit;
Memo1: TMemo;
Button1: TButton;
Edit2: TEdit;
Edit3: TEdit;
Button2: TButton;
Edit4: TEdit;
Button3: TButton;
CheckBox1: TCheckBox;
IdUDPClient1: TIdUDPClient;
IdUDPServer1: TIdUDPServer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function OnReadStr(const sSocket: TSocket; const sRet:string):Boolean;
function OnSvrAccept(const sClient: TSocket; const addrClient: TSockAddrIn):Boolean;
end;var
Form1: TForm1;
WinSocketServer: TWinSocketServer;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
WinSocketServer:=TWinSocketServer.Create;
WinSocketServer.OnReadStr := OnReadStr;
WinSocketServer.OnSvrAccept := OnSvrAccept;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
WinSocketServer.Destroy;
end;function TForm1.OnReadStr(const sSocket: TSocket; const sRet: string): Boolean;
begin
Memo1.Lines.Add(IntToStr(sSocket)+':'+sRet);
end;function TForm1.OnSvrAccept(const sClient: TSocket;
const AddrClient: TSockAddrIn): Boolean;
begin
ListBox1.Items.Add(IntToStr(sClient));
end;procedure TForm1.Button1Click(Sender: TObject);
begin
if ListBox1.ItemIndex>-1 then
Memo1.Lines.Add('Send:'+IntToStr(WinSocketServer.SendByIndex(ListBox1.ItemIndex, Edit2.Text)))
end;procedure TForm1.Button2Click(Sender: TObject);
begin
WinSocketServer.Bind(StrToInt(Edit3.Text), CheckBox1.Checked);
end;procedure TForm1.Button3Click(Sender: TObject);
begin
WinSocketServer.Listen(StrToInt(Edit4.Text));
end;end.DemoClntUnit1.dfmobject Form1: TForm1
Left = 369
Top = 186
Width = 388
Height = 369
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Edit1: TEdit
Left = 80
Top = 16
Width = 121
Height = 21
TabOrder = 0
Text = '192.168.1.100'
end
object Edit2: TEdit
Left = 208
Top = 16
Width = 65
Height = 21
TabOrder = 1
Text = '7654'
end
object Button1: TButton
Left = 280
Top = 14
Width = 75
Height = 25
Caption = 'Connect'
TabOrder = 2
OnClick = Button1Click
end
object CheckBox1: TCheckBox
Left = 16
Top = 16
Width = 57
Height = 17
Caption = 'UDP'
TabOrder = 3
end
object Button2: TButton
Left = 16
Top = 48
Width = 75
Height = 25
Caption = 'Send'
TabOrder = 4
OnClick = Button2Click
end
object Edit3: TEdit
Left = 104
Top = 48
Width = 249
Height = 21
TabOrder = 5
Text = 'Edit3'
end
object Memo1: TMemo
Left = 16
Top = 80
Width = 337
Height = 225
Lines.Strings = (
'Memo1')
TabOrder = 6
end
end
======================unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
WinSocketClass, WinSockAll,
Dialogs, StdCtrls;type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
CheckBox1: TCheckBox;
Button2: TButton;
Edit3: TEdit;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function OnReadStr(const sSocket: TSocket; const sRet:string):Boolean;
end;var
Form1: TForm1;
WinSocketClient: TWinSocketClient;implementation{$R *.dfm}{ TForm1 }function TForm1.OnReadStr(const sSocket: TSocket;const sRet: string): Boolean;
begin
Memo1.Lines.Add(IntToStr(sSocket)+':'+sRet);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
WinSocketClient := TWinSocketClient.create;
WinSocketClient.OnReadStr := OnReadStr;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
WinSocketClient.Connect(Edit1.Text, StrToInt(Edit2.Text), CheckBox1.Checked);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
WinSocketClient.Send(Edit3.Text);
end;end.
initialization
WinSockAll.WSAStartup();
finalization
WinSockAll.WSACleanup;就可以编译成功