delphi Winsock的传输的API封装|笨鱼技术网

{***************************************************************}
{ Vcl blocking mode                                             }
{ stNonBlocking    = 非阻塞模式                                 }
{ stThreadBlocking = 利用线程阻塞模式                           }
{ TServerType = (stNonBlocking, stThreadBlocking);              }
{***************************************************************}

unit XWinSock2;

interface

uses
Windows, Messages, WinSock2;

const
//Messagebox 错误ICON
MB_Error       = MB_OK + MB_ICONERROR;
//Messagebox 通知消息ICON
MB_Information = MB_OK + MB_ICONINFORMATION;
//Messagebox 警告消息ICON
MB_Warning     = MB_OK + MB_ICONWARNING;

const
SocketErrorFormat = 'Windows socket error: %s, on API ''%s''';

const
CHAR0 = #0;
BACKSPACE = #8;
LF = #10;
CR = #13;
EOL = CR + LF;
TAB = #9;
CHAR32 = #32;
sLineBreak = EOL;
LWS = [TAB, CHAR32];
FetchDelimDefault = ' ';
wdays: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
monthnames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May',
   'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
IdHexDigits: array [0..15] of Char = '0123456789ABCDEF';

type
//Socket 执行结果, 在1.1中是利用ShowMessage弹出错误信息，这样有点不好，
//就是在不想它弹对话框时也弹出，所以这里函数统一返回TSockRet类型,让用户定义是否要给出提示信息
//TSockRet类型，记录错误码，错误信息，Result为函数执行结果.
PSockRet = ^TSockRet;
TSockRet = record
    Socket: TSocket;                    //Socket 标识
    Result: BOOL;                       //结果
    ErrorCode: Integer;                 //错误码
    ErrorMsg: array[0..255] of Char;   //错误信息
end;

//初始化Dll
function W2Startup(const SocketVersion: WORD = $2020): TSockRet;
//清除Dll
function W2Cleanup: TSockRet;
//读取数据
function ReceiveBuf(const FSocket: TSocket; var Buf; const Count: Integer = -1): Integer;
//发送数据
function SendBuf(const FSocket: TSocket; var Buf; Count: Integer): Integer;
//检查Socket是否有异常
function SocketInExcept(const S: TSocket): BOOL;
//检查Socket是否可写
function SocketInSend(const S: TSocket): BOOL;
//检查Socket是否可读
function SocketInRecv(const S: TSocket): BOOL;
//检查Socket是否可写并发送数据
function CheckInSendBuf(const S: TSocket; var Buf; count: Integer): Integer;
//检测Socket是否有效
function W2ValidSock(const S: TSocket): BOOL;
//关闭Socket
function W2CloseSock(var S: TSocket): TSockRet;
//网络事件选择
function W2EventSelect(const S: TSocket; const hEvent: WSAEvent;
const lNetworkEvents: u_long): TSockRet;
//枚举网络事件
function W2EnumNetwrokEvents(const S: TSocket; const hEvent: WSAEvent;
lpNetworkEvents: PWSANETWORKEVENTS): TSockRet;
//初始化Socket
function W2InitSock(var S: TSocket; const SockType: u_int = SOCK_STREAM;
const protocol: u_int = IPPROTO_IP; const lpProtocolInfo: PWSAPROTOCOL_INFOA = nil;
const g: TGroup = 0; const dwFlags: Dword = 0): TSockRet;
//挷定Socket
function W2Bind(var S: TSocket; const IP, Name, Server: PChar; const Port: WORD): TSockRet;
//监听Socket
function W2Listen(var S: TSocket; const IP, Name, Server: PChar; Port: Integer;
const Block: BOOL = True; const QueueSize: Integer = 5): TSockRet; overload;
//监听Socket
function W2Listen(var S: TSocket; QueueSize: Integer = 5): TSockRet; overload;
//接受客户端连接
function W2Accept(const ServerSocket: TSocket; var ClientSocket: TSocket; var lpAddr: TSockAddr;
const lpfnCondition: PCONDITIONPROC = nil; const dwCallbackData: DWORD = 0): TSockRet;
//连接服务Socket
function W2Connect(var ClinetSocket: TSocket; const Name: PChar; const Address: PChar;
Port: WORD; lpCalleeData: PWSABUF; const lpCallerData: PWSABUF = nil; const lpSQOS: PQOS = nil;
const lpGQOS: PQOS = nil): TSockRet;

//发送数据缓冲,发送长度由TSockRet.Socket返回
function W2SendBuf(const S: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    const lpNumberOfBytesSent: PDWORD = nil; const dwFlags: DWORD = 0;
    const lpOverlapped: LPWSAOVERLAPPED = nil;
    const lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE = nil): TSockRet;

//发送数据缓冲SendTo,送长度由TSockRet.Socket返回
function W2SendToBuf(const S: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    lpTo: psockaddr; iTolen: u_int;
    const lpNumberOfBytesSent: PDWORD = nil; const dwFlags: DWORD = 0;
    const lpOverlapped: LPWSAOVERLAPPED = nil;
    const lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE = nil): TSockRet;

//接收数据缓冲,接收度由TSockRet.Socket返回
function W2RecvBuf(const S: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    const lpNumberOfBytesRecvd: PDWORD = nil; const lpFlags: PDWORD = nil;
    const lpOverlapped: LPWSAOVERLAPPED = nil;
    const lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE = nil): TSockRet;

//接收数据缓冲RecvFrom,接收度由TSockRet.Socket返回
function W2RecvFromBuf(const S: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    lpFrom: psockaddr; lpFromlen: PInt;
    const lpNumberOfBytesRecvd: PDWORD = nil; const lpFlags: PDWORD = nil;
    const lpOverlapped: LPWSAOVERLAPPED = nil;
    const lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE = nil): TSockRet;

//关联完成端口
function W2ConIOCP(S: DWORD; hIOCP: THandle; PKey: DWORD): TSockRet;

//查找指定主机IP组
function LookupName(const Name: PChar): TInAddr;
//查找指定服务的端口
function LookupService(const Service: PChar): Integer;

function GetIpByHostName(Host: PChar): PChar;
function GetLocalIP: PChar;
function GetRemoteAddr(const FSocket: TSocket): TSockAddrIn;
function GetRemotePort(const FSocket: TSocket): Integer;
function GetRemoteHost(const FSocket: TSocket): PChar;
function GetRemoteAddress(const FSocket: TSocket): PChar;

//===============================================================================
//MessageBox default 是Error ICON
function MsgBox(const OwnerHwnd: HWND; const lpText: PChar;
const BtnType: DWORD = MB_Error): BOOL;
//Windows格式化字符串
function FormatChar(OutPut: PChar; const Format: PChar; arglist: array of Integer): Integer;
//格化Socket error number
function SocketError(const ErrorCode : Longint; const Format: PChar = nil): PChar;
// System error messages, from Sysutils unit
function SysErrorMessage(ErrorCode: Integer): PChar;

implementation

var
WSData: TWSAData;

//初始化Dll
function W2Startup(const SocketVersion: WORD): TSockRet;
begin //MakeWord(2, 0)
//填充结构
FillChar(Result, SizeOf(Result), 0);
Result.ErrorCode := WinSock2.WSAStartup(SocketVersion, WSData);
Result.Result := Result.ErrorCode = 0;
if not Result.Result then begin
FormatChar(Result.ErrorMsg, 'Windows socket error: %s (%d), on API ''WSAStartup''',
[Integer(SysErrorMessage(Result.ErrorCode )), Result.ErrorCode ]);
end else Result.ErrorMsg := 'WSAStartup Ok.';
end;

//清除Dll
function W2Cleanup: TSockRet;
begin
//填充结构
FillChar(Result, SizeOf(Result), 0);
Result.ErrorCode := WinSock2.WSACleanup;
Result.Result := Result.ErrorCode = 0;
if not Result.Result then begin
FormatChar(Result.ErrorMsg, 'Windows socket error: %s (%d), on API ''WSACleanup''',
[Integer(SysErrorMessage(Result.ErrorCode )), Result.ErrorCode ]);
end else Result.ErrorMsg := 'WSACleanup Ok.';
end;

//发送数据
function SendBuf(const FSocket: TSocket; var Buf; Count: Integer): Integer;
begin
if W2ValidSock(FSocket) then
Result := send(FSocket, Buf, Count, 0)
else begin
Result := -1;
end;
end;

function ReceiveBuf(const FSocket: TSocket; var Buf; const Count: Integer = -1): Integer;
begin
Result := -1;
if Count = -1 then
ioctlsocket(FSocket, FIONREAD, Longint(Result))
else
Result := recv(FSocket, Buf, Count, 0);
end;

//检查Socket是否可写并发送数据
function CheckInSendBuf(const S: TSocket; var Buf; count: Integer): Integer;
var
ErrorCode: Integer;
begin
Result := SOCKET_ERROR;
while True do begin
    if not SocketInSend(S) then begin
      ErrorCode := WinSock2.WSAGetLastError;
      case ErrorCode of
        WSAENETDOWN, WSAENOTSOCK, WSAECONNABORTED,
        WSAECONNRESET,WSAENOTCONN, WSAESHUTDOWN, WSAEHOSTDOWN:
        begin
          CloseSocket(S);
          Break;
        end;
      end;
      System.Continue;
    end; //if not then
    Result := Send(S, Buf, Count, 0);
    if Result <> SOCKET_ERROR then Break;
end;
end;

//检查Socket是否可写, 可写返回True,否则相反
function SocketInSend(const S: TSocket): BOOL;
var
FDSet: TFDSet;
TimeVal: TTimeVal;
begin
FD_ZERO(FDSet);
FD_SET(S, FDSet);
TimeVal.tv_sec := 0;
TimeVal.tv_usec := 500;
Result := (select(0, nil, @FDSet, nil, @TimeVal) > 0);
end;

//检查Socket是否可读, 可读返回True,否则相反
function SocketInRecv(const S: TSocket): BOOL;
var
FDSet: TFDSet;
TimeVal: TTimeVal;
ErrorCode: Integer;
begin
FD_ZERO(FDSet);
FD_SET(S, FDSet);
TimeVal.tv_sec := 0;
TimeVal.tv_usec := 500;
Result := (select(0, @FDSet, nil, nil, @TimeVal) > 0);
ErrorCode := WSAGetLastError;
if Result then Result := ReceiveBuf(S, FDSet) > 0;
if ErrorCode <> 0 then WinSock2.WSASetLastError(ErrorCode);
end;

//检查Socket是否有异常
function SocketInExcept(const S: TSocket): BOOL;
var
FDSet: TFDSet;
TimeVal: TTimeVal;
begin
FD_ZERO(FDSet);
FD_SET(S, FDSet);
TimeVal.tv_sec := 0;
TimeVal.tv_usec := 500;
Result := (select(0, nil, nil, @FDSet, @TimeVal) > 0);
end;

//检测Socket是否有效
function W2ValidSock(const S: TSocket): BOOL;
begin
Result := S <> WinSock2.INVALID_SOCKET;
end;

function W2CloseSock(var S: TSocket): TSockRet;
begin
//填充结构
FillChar(Result, SizeOf(Result), #0);
Result.Result := W2ValidSock(S);
if Result.Result then
begin
    Result.Result := WinSock2.closesocket(S) = 0;
    if not Result.Result then
    begin
      //无效则检查错误码
      Result.ErrorCode := WinSock2.WSAGetLastError;
      //格式化错误信息
      FormatChar(Result.ErrorMsg, SocketErrorFormat,
      [Integer(SocketError(Result.ErrorCode)),
      Integer(PChar('closesocket'))])
    end
    else begin
      //将Socket置为INVALID_SOCKET
      //S := WinSock2.INVALID_SOCKET;
      Result.ErrorMsg := 'Close socket Ok.';
    end;
    //不管是否有错误都将Socket置为INVALID_SOCKET
    S := INVALID_SOCKET;
end
else Result.ErrorMsg := 'Not a valid Socket';
end;

//网络事件选择
function W2EventSelect(const S: TSocket; const hEvent: WSAEvent;
const lNetworkEvents: u_long): TSockRet;
begin
//填充结构
FillChar(Result, SizeOf(Result), #0);
//事件选择
Result.Socket := WinSock2.WSAEventSelect(S, hEvent, lNetworkEvents);
Result.Result := Result.Socket = 0;
if not Result.Result then
begin
    //无效则检查错误码
    Result.ErrorCode := WinSock2.WSAGetLastError;
    //格式化错误信息
    FormatChar(Result.ErrorMsg, SocketErrorFormat,
    [Integer(SocketError(Result.ErrorCode)),
    Integer(PChar('WSAEventSelect'))]);
    case Result.ErrorCode of
      WSAENETDOWN:;// 网络子系统失效。
    end;
end
else //否则Socket事件选择成功
    Result.ErrorMsg := 'WSAEventSelect Ok.';
end;

//枚举网络事件
function W2EnumNetwrokEvents(const S: TSocket; const hEvent: WSAEvent;
lpNetworkEvents: PWSANETWORKEVENTS): TSockRet;
begin
//填充结构
FillChar(Result, SizeOf(Result), #0);
//事件选择
Result.Socket := WinSock2.WSAEnumNetworkEvents(S, hEvent, lpNetworkEvents);
Result.Result := Result.Socket = 0;
if not Result.Result then
begin
    //无效则检查错误码
    Result.ErrorCode := WinSock2.WSAGetLastError;
    //格式化错误信息
    FormatChar(Result.ErrorMsg, SocketErrorFormat,
    [Integer(SocketError(Result.ErrorCode)),
    Integer(PChar('WSAEnumNetworkEvents'))]);
    case Result.ErrorCode of
      WSAENETDOWN:;// 网络子系统失效。
    end;
end
else //否则Socket事件选择成功
    Result.ErrorMsg := 'WSAEnumNetworkEvents Ok.';
end;

//初始化Socket
function W2InitSock(var S: TSocket; const SockType: u_int = SOCK_STREAM;
const protocol: u_int = IPPROTO_IP; const lpProtocolInfo: PWSAPROTOCOL_INFOA = nil;
const g: TGroup = 0; const dwFlags: Dword = 0): TSockRet;
begin
////填充结构
FillChar(Result, SizeOf(Result), #0);
//申请Socket
S := WinSock2.WSASocket(PF_INET, SockType, protocol, lpProtocolInfo, g, dwFlags);
Result.Socket := S;
//检查Socket是否有效
Result.Result := W2ValidSock(S);
if not Result.Result then begin
    //无效则检查错误码
    Result.ErrorCode := WinSock2.WSAGetLastError;
    //格式化错误信息
    FormatChar(Result.ErrorMsg, SocketErrorFormat,
    [Integer(SocketError(Result.ErrorCode)),
    Integer(PChar('WSASocket'))])
end //否则申请Socket成功
else Result.ErrorMsg := 'InitSocket Ok.';
end;

function W2Bind(var S: TSocket; const IP, Name, Server: PChar; const Port: WORD): TSockRet;
var
Addr: TSockAddr;
begin
//填充结构
FillChar(Addr, SizeOf(Addr), 0);
FillChar(Result, SizeOf(Result), 0);
Result.Socket := S;
//指定协议族
Addr.sin_family := PF_INET;
//Lookup a Server   这里指定一个知名的协议服务的端口
if Server <> nil then
    WinSock2.WSAHtons(S, LookupService(Server), @Addr.sin_port)
    //Addr.sin_port := WinSock2.Htons(LookupService(Server))
else //指定端口
    WinSock2.WSAHtons(S, Port, @Addr.sin_port);
    //Addr.sin_port := WinSock2.WSAHtons(Port);

// Lookup Name
if Name <> nil then
    Addr.sin_addr := LookupName(Name)
else if IP <> nil then   //指定IP
    Addr.sin_addr.S_addr := WinSock2.inet_addr(IP)
else Addr.sin_addr.S_addr := WinSock2.INADDR_ANY; //挷定所有IP
//挷定Socket
Result.Result := WinSock2.bind(S, @Addr, SizeOf(Addr)) = 0;
if not Result.Result then begin try
      //取得挷定错误码
      Result.ErrorCode := WinSock2.WSAGetLastError;
      //格式化错误信息
      FormatChar(Result.ErrorMsg, SocketErrorFormat,
      [Integer(SocketError(Result.ErrorCode)),
      Integer(PChar('Bind'))])
    finally
      //挷定错误关闭Socket
      W2CloseSock(S);
    end;
end //挷定成功
else Result.ErrorMsg := 'Bind Ok';
end;

//监听Socket
function W2Listen(var S: TSocket; QueueSize: Integer = 5): TSockRet;
begin
//监听Socket
Result.Result := WinSock2.listen(S, QueueSize) = 0;
if not Result.Result then begin try
      //取得监听错误码
      Result.ErrorCode := WinSock2.WSAGetLastError;
      //格式化错误信息
      FormatChar(Result.ErrorMsg, SocketErrorFormat,
      [Integer(SocketError(Result.ErrorCode)),
      Integer(PChar('listen'))]);
    finally
      //监听关闭Socket
      W2CloseSock(S);
    end;
end
else Result.ErrorMsg := 'Listen OK.';
end;
//监听Socket
function W2Listen(var S: TSocket; const IP, Name, Server: PChar; Port: Integer;
const Block: BOOL = True; const QueueSize: Integer = 5): TSockRet;
begin
//初始化Socket
Result := W2InitSock(S);
if Result.Result then
begin
    //挷定Socket
    Result := W2Bind(S, IP, Name, Server, Port);
    if Result.Result then
    begin
      //监听Socket
      Result.Result := WinSock2.listen(S, QueueSize) = 0;
      if not Result.Result then begin try
          //取得监听错误码
          Result.ErrorCode := WinSock2.WSAGetLastError;
          //格式化错误信息
          FormatChar(Result.ErrorMsg, SocketErrorFormat,
          [Integer(SocketError(Result.ErrorCode)),
          Integer(PChar('listen'))]);
        finally
          //监听关闭Socket
          W2CloseSock(S);
        end;
      end
      else Result.ErrorMsg := 'Listen OK.';
    end;
end;
end;

//接受客户端连接
function W2Accept(const ServerSocket: TSocket; var ClientSocket: TSocket; var lpAddr: TSockAddr;
const lpfnCondition: PCONDITIONPROC = nil; const dwCallbackData: DWORD = 0): TSockRet;
var
AddrLen: Integer;
begin
//填充Socket地址结构
FillChar(lpAddr, SizeOf(lpAddr), 0);
//Socket地址长度指针
AddrLen := SizeOf(lpAddr);
ClientSocket := WinSock2.WSAAccept(ServerSocket, @lpAddr, @AddrLen, lpfnCondition, dwCallbackData);
//检查ClientSocket是否有效，这里可能不会出错，Accept接受的Socket 应该没有问题的
Result.Result := W2ValidSock(ClientSocket);
Result.Socket := ClientSocket;
if not Result.Result then begin
    //取得监听错误码
    Result.ErrorCode := WinSock2.WSAGetLastError;
    //格式化错误信息
    FormatChar(Result.ErrorMsg, SocketErrorFormat,
    [Integer(SocketError(Result.ErrorCode)),
    Integer(PChar('WSAAccept'))]);
end
else FormatChar(Result.ErrorMsg, 'WSAAccept Client IP[%s], Port: [%d] Ok.',
    [Integer(WinSOck2.inet_ntoa(lpAddr.sin_addr)), WinSock2.ntohs(lpAddr.sin_port)]);
end;

//连接服务Socket
function W2Connect(var ClinetSocket: TSocket; const Name: PChar; const Address: PChar;
Port: WORD; lpCalleeData: PWSABUF; const lpCallerData: PWSABUF = nil; const lpSQOS: PQOS = nil;
const lpGQOS: PQOS = nil): TSockRet;
var
ToAddr: TSockAddr;
begin
//初始化ClientSocket
Result := W2InitSock(ClinetSocket);
if Result.Result then begin
     (*
         如果无错误发生，WSAConnect()返回0。否则的话，将返回INVALID_SOCKET错误，
      应用程序可通过WSAGetLastError()来获取相应的错误代码。
         对于阻塞套接口来说，返回值表示连接试图是否成功。
      对于非阻塞套接口来说，连接试图不一定马上完成。在这种情况下，WSAConnect()
      返回SOCKET_ERROR，且WSAGetLastError()返回WSAEWOULDBLOCK. 此时应用程序可以：
         1。利用select()函数，通过检查套接口是否可写来判断连接请求是否完成。或者，
         2。如果应用程序已使用WSAAsyncSelect()函数来确定对连接事件的兴趣，则当连
            接操作完成时应用程序将收到FD _CONNECT通知。或者，
         3。如果应用程序已使用WSAEventSelect()函数来确定对连接事件的兴趣，则当连
            接操作完成时相应的事件对象将设置信号。
         对于一个非阻塞套接口来说，在连接试图完成之前，任何对该套接口的WSAConnect()
      调用都将以WSAEALREADY错误失败。
        如果返回值指出连接试图失败（例如WSAECONNREFUSED, WSAENETUNREACH，WSAETIMEDOUT）
      则应用程序可对该套接口再次调用WSAConnect()函数。
     *)
       //填充Socket地址结构
    FillChar(ToAddr, SizeOf(ToAddr), 0);
    ToAddr.sin_family := PF_INET;
    //ToAddr.sin_port := htons(Port);
    WinSock2.WSAHtons(ClinetSocket, Port, @ToAddr.sin_port);
   // Lookup Name
    if Name <> nil then
      ToAddr.sin_addr := LookupName(Name)
    else if Address <> nil then   //指定IP
      ToAddr.sin_addr.S_addr := WinSock2.inet_addr(Address);
     //连接到服务Socket

     Result.Result := WinSock2.WSAConnect(ClinetSocket, @ToAddr, SizeOf(ToAddr), lpCallerData, lpCalleeData, lpSQOS, lpGQOS) = 0;
     if not Result.Result then
     begin
       //取得监听错误码
       Result.ErrorCode := WinSock2.WSAGetLastError;
       //格式化错误信息
       FormatChar(Result.ErrorMsg, SocketErrorFormat,
       [Integer(SocketError(Result.ErrorCode)),
       Integer(PChar('WSAConnect'))]);
       //对于非阻塞套接口来说，连接试图不一定马上完成。在这种情况下，WSAConnect()
       //返回SOCKET_ERROR，且WSAGetLastError()返回WSAEWOULDBLOCK. 此时应用程序可以
       case Result.ErrorCode of
         WSAEWOULDBLOCK: Result.Result := True;//
         WSAECONNREFUSED: W2CloseSock(ClinetSocket);//连接试图被拒绝
         WSAETIMEDOUT: W2CloseSock(ClinetSocket);//连接超时
       end;
     end
     else FormatChar(Result.ErrorMsg, 'WSAConnect Client IP[%s], Port: [%d] Ok.',
    [Integer(WinSOck2.inet_ntoa(ToAddr.sin_addr)), WinSock2.ntohs(ToAddr.sin_port)]);
end;
end;

//发送数据缓冲
function W2SendBuf(const S: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    const lpNumberOfBytesSent: PDWORD = nil; const dwFlags: DWORD = 0;
    const lpOverlapped: LPWSAOVERLAPPED = nil;
    const lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE = nil): TSockRet;
begin
//发送数据长度由TSockRet.Socket返回
Result.Socket := WinSock2.WSASend(S, lpBuffers, dwBufferCount, lpNumberOfBytesSent,
                             dwFlags, lpOverlapped, lpCompletionRoutine);
Result.Result := Result.Socket <> SOCKET_ERROR;
if not Result.Result then
begin
    //取得发送信人错误码
    Result.ErrorCode := WinSock2.WSAGetLastError;
    //格式化错误信息
    FormatChar(Result.ErrorMsg, SocketErrorFormat,
    [Integer(SocketError(Result.ErrorCode)),
    Integer(PChar('WSASend'))]);
    case Result.ErrorCode of
      WSA_IO_PENDING: Result.Result := True;//错误代码WSA_IO_PENDING表示重叠操作成功启动，过后将有完成指示
      WSAEWOULDBLOCK: ;//W2CloseSock();
    end;
end
else Result.ErrorMsg := 'WSASend Ok.';
end;

//发送数据缓冲From
function W2SendToBuf(const S: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    lpTo: psockaddr; iTolen: u_int;
    const lpNumberOfBytesSent: PDWORD = nil; const dwFlags: DWORD = 0;
    const lpOverlapped: LPWSAOVERLAPPED = nil;
    const lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE = nil): TSockRet;
begin
Result.Socket := WinSock2.WSASendTo(S, lpBuffers, dwBufferCount, lpNumberOfBytesSent, dwFlags,
                                      lpTo, iTolen, lpOverlapped, lpCompletionRoutine);
Result.Result := Result.Socket <> SOCKET_ERROR;
if not Result.Result then
begin
    //取得发送信人错误码
    Result.ErrorCode := WinSock2.WSAGetLastError;
    //格式化错误信息
    FormatChar(Result.ErrorMsg, SocketErrorFormat,
    [Integer(SocketError(Result.ErrorCode)),
    Integer(PChar('WSASendTo'))]);
    case Result.ErrorCode of
      WSA_IO_PENDING: Result.Result := True;//错误代码WSA_IO_PENDING表示重叠操作成功启动，过后将有完成指示
      WSAEWOULDBLOCK: ;//W2CloseSock();
    end;
end
else Result.ErrorMsg := 'WSASendTo Ok.';

end;

//接收数据缓冲
function W2RecvBuf(const S: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    const lpNumberOfBytesRecvd: PDWORD = nil; const lpFlags: PDWORD = nil;
    const lpOverlapped: LPWSAOVERLAPPED = nil;
    const lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE = nil): TSockRet;
begin
//接收数据长度由TSockRet.Socket返回
Result.Socket := WinSock2.WSARecv(S, lpBuffers, dwBufferCount, lpNumberOfBytesRecvd,
                             lpFlags, lpOverlapped, lpCompletionRoutine);
Result.Result := Result.Socket <> SOCKET_ERROR;
if not Result.Result then
begin
    //取得发送信人错误码
    Result.ErrorCode := WinSock2.WSAGetLastError;
    //格式化错误信息
    FormatChar(Result.ErrorMsg, SocketErrorFormat,
    [Integer(SocketError(Result.ErrorCode)),
    Integer(PChar('WSARecv'))]);
    case Result.ErrorCode of
      WSA_IO_PENDING: Result.Result := True;//错误代码WSA_IO_PENDING表示重叠操作成功启动，过后将有完成指示
      WSAEWOULDBLOCK: ;//W2CloseSock();
    end;
end
else Result.ErrorMsg := 'WSARecv Ok.';
end;

//接收数据缓冲RecvFrom
function W2RecvFromBuf(const S: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
    lpFrom: psockaddr; lpFromlen: PInt;
    const lpNumberOfBytesRecvd: PDWORD = nil; const lpFlags: PDWORD = nil;
    const lpOverlapped: LPWSAOVERLAPPED = nil;
    const lpCompletionRoutine: PWSAOVERLAPPED_COMPLETION_ROUTINE = nil): TSockRet;
begin
//接收数据长度由TSockRet.Socket返回
Result.Socket := WinSock2.WSARecvFrom(S, lpBuffers, dwBufferCount, lpNumberOfBytesRecvd,
                             lpFlags, lpFrom, lpFromlen, lpOverlapped, lpCompletionRoutine);
Result.Result := Result.Socket <> SOCKET_ERROR;
if not Result.Result then
begin
    //取得发送信人错误码
    Result.ErrorCode := WinSock2.WSAGetLastError;
    //格式化错误信息
    FormatChar(Result.ErrorMsg, SocketErrorFormat,
    [Integer(SocketError(Result.ErrorCode)),
    Integer(PChar('WSARecvFrom'))]);
    case Result.ErrorCode of
      WSA_IO_PENDING: Result.Result := True;//错误代码WSA_IO_PENDING表示重叠操作成功启动，过后将有完成指示
      WSAEWOULDBLOCK: ;//W2CloseSock();
    end;
end
else Result.ErrorMsg := 'WSARecvFrom Ok.';
end;

//关联完成端口
function W2ConIOCP(S: DWORD; hIOCP: THandle; PKey: DWORD): TSockRet;
begin
//创建完成端口或关联Socket //初始化完成端口:Windows.CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
Result.Socket := Windows.CreateIoCompletionPort(S, hIOCP, PKey, 0);
Result.Result := Result.Socket <> 0;
//失败的
if not Result.Result then
begin
    //取得Windows Lasterror
    Result.ErrorCode := Windows.GetLastError;
    FormatChar(Result.ErrorMsg, 'Windows Api error: %s (%d), on API ''CreateIoCompletionPort''',
      [Integer(SysErrorMessage(Result.ErrorCode )), Result.ErrorCode ]);
end
else
    Result.ErrorMsg := 'CreateIoCompletionPort Ok.';
end;

//查找指定服务的端口
function LookupService(const Service: PChar): Integer;
var
ServEnt: PServEnt;
begin //返回本机上一个存在服务类型所开启的端口
ServEnt := getservbyname(Service, 'tcp');
if ServEnt <> nil then
Result := ntohs(ServEnt.s_port)
else Result := 0;
end;

//查找指定主机IP组
function LookupName(const Name: PChar): TInAddr;
var
HostEnt: PHostEnt;
InAddr: TInAddr;
begin
HostEnt := gethostbyname(Name);
FillChar(InAddr, SizeOf(InAddr), 0);
if HostEnt <> nil then
begin
    with InAddr, HostEnt^ do
    begin
      S_un_b.s_b1 := h_addr^.S_un_b.s_b1;
      S_un_b.s_b2 := h_addr^.S_un_b.s_b2;
      S_un_b.s_b3 := h_addr^.S_un_b.s_b3;
      S_un_b.s_b4 := h_addr^.S_un_b.s_b4;
    end;

    {with InAddr, HostEnt^ do
    begin
      S_un_b.s_b1 := h_addr^[0];
      S_un_b.s_b2 := h_addr^[1];
      S_un_b.s_b3 := h_addr^[2];
      S_un_b.s_b4 := h_addr^[3];
    end;
    }
end;
Result := InAddr;
end;

//MessageBox default 是Error ICON
function MsgBox(const OwnerHwnd: HWND; const lpText: PChar;
const BtnType: DWORD = MB_Error): BOOL;
var
lpTitle: PChar;
H: HWND;
Len: Integer;
YESOK: Integer;
begin
YESOK := 0;
if (BtnType and MB_OKCANCEL = MB_OKCANCEL) then YESOK := IDOK
else if (BtnType and MB_YESNO = MB_YESNO) then YESOK := IDYES;
H := GetActiveWindow;
if OwnerHwnd <> 0 then H := OwnerHwnd;
Len := Windows.GetWindowTextLength(H) + 1;
GetMem(lpTitle, Len);
SendMessage(H, WM_GETTEXT, Len, Longint(lpTitle));
Result := Windows.MessageBox(H, lpText, lpTitle, BtnType) = YESOK;
FreeMem(lpTitle, Len);
end;

//Windows格式化字符串
function FormatChar(OutPut: PChar; const Format: PChar; arglist: array of Integer): Integer;
// Example: var OutPut: array[0..1024] of Char; //Wvsprintf format最长是1kb 1024字节，大于1024会被截断
// FormatChar(OutPut, 'A[%s] - %d', [Integer(PChar('test')), 10]); OutPut := 'A[test] - 10'
begin
Result := Windows.wvsprintf(OutPut, Format, @arglist[Low(arglist)])
end;

// this function from Internet delphibbs
function SocketError(const ErrorCode : Longint; const Format: PChar): PChar;
{ returns an error string for }
{ the winsock error number    }
var
S, Temp: array [0..64] of Char;
begin
S := #0;
case ErrorCode of
    WSAEINTR   : s := 'WSAEintr';
    WSAEBADF   : s := 'WSAEbadf';
    WSAEACCES : s := 'WSAEacces';
    WSAEFAULT : s := 'WSAEfault';
    WSAEINVAL : s := 'WSAEinval';
    WSAEMFILE : s := 'WSAEmfile';

{ windows sockets definitions of regular berkeley error constants }
    WSAEWOULDBLOCK      : s := 'WouldBlock';
    WSAEINPROGRESS      : s := 'InProgress';
    WSAEALREADY         : s := 'Already';
    WSAENOTSOCK         : s := 'NotSock';
    WSAEDESTADDRREQ     : s := 'DestAddrReq';
    WSAEMSGSIZE         : s := 'MsgSize';
    WSAEPROTOTYPE       : s := 'ProtoType';
    WSAENOPROTOOPT      : s := 'NoProtoOpt';
    WSAEPROTONOSUPPORT : s := 'ProtoNoSupport';
    WSAESOCKTNOSUPPORT : s := 'SocktNoSupport';
    WSAEOPNOTSUPP       : s := 'OpNotSupp';
    WSAEPFNOSUPPORT     : s := 'PFNoSupport';
    WSAEAFNOSUPPORT     : s := 'AFNoSupport';
    WSAEADDRINUSE       : s := 'AddrInUse';
    WSAEADDRNOTAVAIL    : s := 'AddrNotAvail';
    WSAENETDOWN         : s := 'NetDown';
    WSAENETUNREACH      : s := 'NetUnreach';
    WSAENETRESET        : s := 'NetReset';
    WSAECONNABORTED     : s := 'ConnAborted';
    WSAECONNRESET       : s := 'ConnReset';
    WSAENOBUFS          : s := 'NoBuffs';
    WSAEISCONN          : s := 'IsConn';
    WSAENOTCONN         : s := 'NotConn';
    WSAESHUTDOWN        : s := 'ShutDown';
    WSAETOOMANYREFS     : s := 'TooManyRefs';
    WSAETIMEDOUT        : s := 'TimedOut';
    WSAECONNREFUSED     : s := 'ConnRefused';
    WSAELOOP            : s := 'Loop';
    WSAENAMETOOLONG     : s := 'NameNotLong';
    WSAEHOSTDOWN        : s := 'HostDown';
    WSAEHOSTUNREACH     : s := 'HostUnreach';
    WSAENOTEMPTY        : s := 'NotEmpty';
    WSAEPROCLIM         : s := 'Proclim';
    WSAEUSERS           : s := 'Users';
    WSAEDQUOT           : s := 'DQuot';
    WSAESTALE           : s := 'Stale';
    WSAEREMOTE          : s := 'Remote';

    { extended windows sockets error constant definitions }
    WSASYSNOTREADY      : s := 'SysNotReady';
    WSAVERNOTSUPPORTED : s := 'VerNotSupported';
    WSANOTINITIALISED   : s := 'NotInitialised';

{ error return codes from gethostbyname() and gethostbyaddr() }
{ (when using the resolver). note that these errors are       }
{ retrieved via WSAGetLastError() and must therefore follow   }
{ the rules for avoiding clashes with error numbers from      }
{ specific implementations or language run-time systems. for }
{ this reason the codes are based at WSABASEERR+1001. note    }
{ also that [WSA]NO_ADDRESS is defined only for compatibility }
{ purposes.                                                   }

{ authoritative answer: Host not found }
WSAHOST_NOT_FOUND : s := 'Host Not Found';

{ non-authoritative: Host not found, or SERVERFAIL }
WSATRY_AGAIN : s := 'Host not found - try again';

{ non-recoverable errors, FORMERR, REFUSED, NOTIMP }
WSANO_RECOVERY : s := 'Unrecoverable error';

{ valid name, no data record of requested type }
WSANO_DATA : s := 'Valid name but no data';

// WSANO_ADDRESS         : s := 'No address, look for MX record';
else
    s := #0;
end;
Result := nil;
if lstrlen(S) > 0 then begin
    FillChar(Temp, SizeOf(Temp), #0);
    if Format <> nil then
      FormatChar(Temp, Format, [ErrorCode, Integer(@S)])
    else
      FormatChar(Temp, 'Error: [%d] - [%s]', [ErrorCode, Integer(@S)]);
    GetMem(Result, lstrlen(Temp) + 1);
    lstrcpy(Result, Temp);
end;
end;

function SysErrorMessage(ErrorCode: Integer): PChar;
var
Buffer: array[0..255] of Char;
Len: Integer;
begin
Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS or
    FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
    SizeOf(Buffer), nil);
while (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do Dec(Len);
Result := nil;
if Len > 0 then begin
    GetMem(Result, Len + 1);
    lstrcpyn(Result, Buffer, Len);
end;
end;

function GetRemoteHost(const FSocket: TSocket): PChar;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
HostEnt: PHostEnt;
ret: BOOL;
begin
Size := SizeOf(SockAddrIn);
ret := getpeername(FSocket, SockAddrIn, Size) = 0;
if ret then begin
HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.s_addr, 4, PF_INET);
Result := HostEnt.h_name;
end else Result := nil;
end;

function GetRemoteAddress(const FSocket: TSocket): PChar;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Size := SizeOf(SockAddrIn);
if getpeername(FSocket, SockAddrIn, Size) = 0 then
Result := inet_ntoa(SockAddrIn.sin_addr)
else Result := '127.0.0.1';
end;

function GetRemotePort(const FSocket: TSocket): Integer;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Size := SizeOf(SockAddrIn);
getpeername(FSocket, SockAddrIn, Size);
Result := ntohs(SockAddrIn.sin_port);
end;

function GetIpByHostName(Host: PChar): PChar;
type
TIPinAddr = array[0..10] of PInAddr;
PIPinAddr =^ TIPinAddr;
var
phe: PHostEnt;
PIP: PIPinAddr;
I: Integer;
begin
Result := nil;
Phe := WinSock2.gethostbyname(Host);
if Phe <> nil then
begin
    I := 0;
    PIP := PIPinAddr(phe^.h_addr_list);
    while PIP^[I] <> nil do
    begin
      if I = 0 then Result := WinSock2.inet_ntoa(PIP^[I]^);
      Inc(I);
    end;
end;
end;

function GetLocalIP: PChar;
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I    : Integer;
begin
Result := nil;
FillChar(Buffer, SizeOf(Buffer), #0);
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do begin
    Result := (inet_ntoa(pptr^[I]^));
    Inc(I);
end;
end;

function GetRemoteAddr(const FSocket: TSocket): TSockAddrIn;
var
Size: Integer;
begin
    FillChar(Result, SizeOf(Result), 0);
    Size := SizeOf(Result);
    if getpeername(FSocket, Result, Size) <> 0 then
      FillChar(Result, SizeOf(Result), 0);
end;

end.