标签：begin end Create 阻塞 FDSet select winsocket FSocketHandle procedure
简单的封装了一下，有很多不完善的地方，很多细节未考虑进去。
client代码
unit ClientMainFormUnit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Win.ScktComp, Winapi.Winsock,
Vcl.StdCtrls;
type
TMyClientSocket = class
private
FActive: Boolean;
FConnected: Boolean;
FSocketHandle: TSocket;
FSocketAddr: TSockAddr;
FSocketRead: TNotifyEvent;
FSocketWrite: TNotifyEvent;
procedure SetSocketRead(const Value: TNotifyEvent);
procedure SetSocketWrite(const Value: TNotifyEvent);
public
constructor Create;
destructor Destroy; override;
procedure Open(IP: string; Port: Word);
procedure Close;
function SendBuf(var Buf; BufSize: Integer): Integer;
function ReceiveBuf(var Buf; BufSize: Integer): Integer;
property Active: Boolean read FActive write FActive;
property SockctRead: TNotifyEvent read FSocketRead write SetSocketRead;
property SocketWrite: TNotifyEvent read FSocketWrite write SetSocketWrite;
end;
TForm2 = class(TForm)
ClientSocket1: TClientSocket;
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FCSocket: TMyClientSocket;
procedure ReadHandle(Sender: TObject);
procedure WriteHandle(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
var
Form2: TForm2;
WSAData: TWsaData;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
FCSocket.Open('192.168.1.105', 6000);
end;
constructor TForm2.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if WSAStartup($0101, WSAData) <> 0 then
raise Exception.Create('WSAStartup Error');
FCSocket := TMyClientSocket.Create;
FCSocket.SockctRead := ReadHandle;
FCSocket.SocketWrite := WriteHandle;
end;
destructor TForm2.Destroy;
begin
FCSocket.Free;
WSACleanup;
inherited;
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FCSocket.Close;
end;
procedure TForm2.ReadHandle(Sender: TObject);
var
ret: Integer;
buf: array[0..9] of AnsiChar;
begin
ret := FCSocket.ReceiveBuf(buf[0], 10);
if ret > 0 then
Memo1.Lines.Add(String(AnsiString(buf)));
if ret = 0 then
FCSocket.FActive := False;
end;
procedure TForm2.WriteHandle(Sender: TObject);
var
buf: TBytes;
begin
buf := BytesOf(DateTimeToStr(Now));
FCSocket.SendBuf(buf, Length(buf));
end;
{ TClientSkt }
constructor TMyClientSocket.Create;
begin
inherited Create;
FActive := False;
FConnected := False;
FSocketHandle := INVALID_SOCKET;
end;
destructor TMyClientSocket.Destroy;
begin
if FConnected then
Close;
inherited;
end;
procedure TMyClientSocket.Open(IP: string; Port: Word);
var
c, ErrorCode: Integer;
FDSet: TFDSet;
TimeVal: TTimeVal;
begin
FSocketAddr.sin_family := PF_INET;
FSocketAddr.sin_port := htons(Port);
FSocketAddr.sin_addr.S_addr := inet_addr(PAnsiChar(AnsiString(IP)));
FSocketHandle := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
if FSocketHandle = INVALID_SOCKET then
raise Exception.Create('Cannot Create Socket');
if connect(FSocketHandle, FSocketAddr, SizeOf(FSocketAddr)) = SOCKET_ERROR then
raise Exception.Create(SysErrorMessage(WSAGetLastError));
FConnected := FSocketHandle <> INVALID_SOCKET;
TimeVal.tv_sec := 0;
TimeVal.tv_usec := 500;
FActive := True;
while FActive do
begin
FD_ZERO(FDSet);
FD_SET(FSocketHandle, FDSet);
c := select(0, @FDSet, nil, nil, @TimeVal);
case c of
SOCKET_ERROR:
raise Exception.Create('Select Error');
0:
Break; //超时，一般是服务端关闭了 。
else
if FD_ISSET(FSocketHandle, FDSet) and Assigned(FSocketRead) then
FSocketRead(Self);
end;
Application.ProcessMessages;
FD_ZERO(FDSet);
FD_SET(FSocketHandle, FDSet);
c := select(0, nil, @FDSet, nil, @TimeVal);
case c of
SOCKET_ERROR:
raise Exception.Create(SysErrorMessage(WSAGetLastError)+ ' code: '+WSAGetLastError.ToString);
0:
Break;
else
if FD_ISSET(FSocketHandle, FDSet) then
begin
if Assigned(FSocketWrite) then
FSocketWrite(Self);
end;
end;
{
在《windows网络编程》一书中说，可以用 getsockopt, SO_ERROR 获取错误信息
但 winsock 对 SO_ERROR 支持的可能并不一致。书中提到还可以用 recv , recvfrom
确定是否失败，然后用 WSAGetLastError 获取错误信息。 但这种方法 也不是万无一失的。
}
// FD_ZERO(FDSet);
// FD_SET(FSocketHandle, FDSet);
// c := select(0, nil, nil, @FDSet, @TimeVal);
// case c of
// SOCKET_ERROR:
// raise Exception.Create('Select Error');
// 0:
// Break;
// else
// if FD_ISSET(FSocketHandle, FDSet) then
// raise Exception.Create('Error Message');
// end;
Application.ProcessMessages;
end;
end;
function TMyClientSocket.ReceiveBuf(var Buf; BufSize: Integer): Integer;
begin
Result := recv(FSocketHandle, buf, BufSize, 0);
end;
function TMyClientSocket.SendBuf(var Buf; BufSize: Integer): Integer;
begin
Result := send(FSocketHandle, buf, BufSize, 0);
end;
procedure TMyClientSocket.SetSocketRead(const Value: TNotifyEvent);
begin
FSocketRead := Value;
end;
procedure TMyClientSocket.SetSocketWrite(const Value: TNotifyEvent);
begin
FSocketWrite := Value;
end;
procedure TMyClientSocket.Close;
begin
FActive := False;
if FConnected then
begin
// shutdown(FSocketHandle, 2);
if closesocket(FSocketHandle) = SOCKET_ERROR then
raise Exception.Create(SysErrorMessage(WSAGetLastError));
FConnected := False;
end;
end;
end.
View Code
Server代码
unit ServerMainFormUnit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Win.ScktComp, Winapi.WinSock;
type
TMyServerSocket = class
private
FPort: Word;
FActive: Boolean;
FSocketHandle: TSocket;
FSocketAddr: TSockAddr;
public
constructor Create;
destructor Destroy; override;
procedure Open;
procedure Close;
property Port: Word read FPort write FPort;
end;
TForm2 = class(TForm)
ServerSocket1: TServerSocket;
Memo1: TMemo;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FSSocket: TMyServerSocket;
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
FSSocket.Open;
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FSSocket.Close;
end;
procedure TForm2.FormCreate(Sender: TObject);
var
wsData: TWSAData;
begin
WSAStartup($0101, wsData);
FSSocket := TMyServerSocket.Create;
FSSocket.Port := 6000;
end;
{ TClientSkt }
constructor TMyServerSocket.Create;
begin
inherited Create;
FActive := False;
FSocketHandle := INVALID_SOCKET;
end;
destructor TMyServerSocket.Destroy;
begin
Close;
inherited;
end;
procedure TMyServerSocket.Open;
var
c: Integer;
FDSet: TFDSet;
ClientAddr: TSockAddr;
ClientAddrSize: Integer;
ClientSocket: TSocket;
TimeVal: TTimeVal;
buf: TBytes;
begin
FSocketAddr.sin_family := PF_INET;
FSocketAddr.sin_port := htons(Port);
FSocketAddr.sin_addr.S_addr := INADDR_ANY;
FSocketHandle := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
if FSocketHandle = INVALID_SOCKET then
raise Exception.Create('Cannot Create Socket');
bind(FSocketHandle, FSocketAddr, SizeOf(FSocketAddr));
{
listen(socket s, int backlog)
backlog 参数指定搁置连接的最大数， 如果为2， 那么当有三个连接请求时，
前两个连接请求会被 ”挂起 " ,第三个连接请求会失败，返回 WSAECONNREFUSED 错误。
}
FActive := listen(FSocketHandle, 2) = 0;
if not FActive then
raise Exception.Create(SysErrorMessage(WSAGetLastError));
TimeVal.tv_sec := 0;
TimeVal.tv_usec := 100;
FActive := True;
while FActive do
begin
FD_ZERO(FDSet);
FD_SET(FSocketHandle, FDSet);
c := select(0, @FDSet, nil, nil, @TimeVal);
case c of
SOCKET_ERROR:
;
0:
Application.ProcessMessages;
else
if FD_ISSET(FSocketHandle, FDSet) then
begin
ClientSocket := accept(FSocketHandle, @ClientAddr, @ClientAddrSize);
if (ClientSocket <> INVALID_SOCKET) then
begin
buf := BytesOf('hello');
send(ClientSocket, buf[0], Length(buf), 0);
Application.ProcessMessages;
shutdown(ClientSocket, 1);
closesocket(ClientSocket);
end;
end;
end;
Application.ProcessMessages;
end;
end;
procedure TMyServerSocket.Close;
begin
if FActive then
begin
shutdown(FSocketHandle, 1);
closesocket(FSocketHandle);
FActive := False;
end;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
FSSocket.Close;
FSSocket.Free;
WSACleanup;
end;
end.
View Code
如何优雅的关闭socket，还需要很多测试。
目前看，send和recv 后立即断开连接时，在closesocket前，需要立即 shutdown 或 setsockopt SO_LINGER 相对稳定。
此外，send 或 recv 后返回 0，基本上表示socket 被断开了。
标签：begin,end,Create,阻塞,FDSet,select,winsocket,FSocketHandle,procedure 来源： https://www.cnblogs.com/Jiaojiawang/p/14315353.html
本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享； 2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关； 3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关； 4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除； 5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。