adwutil.pas

测试用例

                                         Buf : PAnsiChar;
                                         BufLen : Integer) : THandle;
                                         {$IFDEF Win32} stdcall; {$ENDIF}

  TfnwsaCancelAsyncRequest    = function(hAsyncTaskHandle : THandle) : Integer;
                                         {$IFDEF Win32} stdcall; {$ENDIF}

  TfnwsaAsyncSelect           = function(S : TSocket;
                                         HWindow : HWnd;
                                         wMsg : Integer;
                                         lEvent : LongInt) : Integer;
                                         {$IFDEF Win32} stdcall; {$ENDIF}

  {$IFDEF Win32}
  TfnwsaRecvEx                = function(S : TSocket;
                                         var Buf;
                                         Len : Integer;
                                         var Flags : Integer) : Integer; stdcall;

  TfnTransmitFile             = function(hSocket : TSocket;
                                         hFile : THandle;
                                         nNumberOfBytesToWrite : DWORD;
                                         nNumberOfBytesPerSend : DWORD;
                                         lpOverlapped : POverlapped;
                                         lpTransmitBuffers: PTransmitFileBuffers;
                                         dwReserved: DWORD) : BOOL; stdcall;
  {$ENDIF}

  { Record for our function pointers. }
  PSocketFuncs = ^TSocketFuncs;
  TSocketFuncs = record
    Accept                   : TfnAccept;
    Bind                     : TfnBind;
    CloseSocket              : TfnCloseSocket;
    Connect                  : TfnConnect;
    IOCtlSocket              : TfnIOCtlSocket;
    GetPeerName              : TfnGetPeerName;
    GetSockName              : TfnGetSockName;
    GetSockOpt               : TfnGetSockOpt;
    htonl                    : Tfnhtonl;
    htons                    : Tfnhtons;
    INet_Addr                : TfnINet_Addr;
    INet_Ntoa                : TfnINet_Ntoa;
    Listen                   : TfnListen;
    ntohl                    : Tfnntohl;
    ntohs                    : Tfnntohs;
    Recv                     : TfnRecv;
    RecvFrom                 : TfnRecvFrom;
    Select                   : TfnSelect;
    Send                     : TfnSend;
    SendTo                   : TfnSendTo;
    SetSockOpt               : TfnSetSockOpt;
    Shutdown                 : TfnShutdown;
    Socket                   : TfnSocket;
    GetHostByAddr            : TfnGetHostByAddr;
    GetHostByName            : TfnGetHostByName;
    GetHostName              : TfnGetHostName;
    GetServByPort            : TfnGetServByPort;
    GetServByName            : TfnGetServByName;
    GetProtoByNumber         : TfnGetProtoByNumber;
    GetProtoByName           : TfnGetProtoByName;
    wsaStartup               : TfnwsaStartup;
    wsaCleanup               : TfnwsaCleanup;
    wsaSetLastError          : TfnwsaSetLastError;
    wsaGetLastError          : TfnwsaGetLastError;
    wsaIsBlocking            : TfnwsaIsBlocking;
    wsaUnhookBlockingHook    : TfnwsaUnhookBlockingHook;
    wsaSetBlockingHook       : TfnwsaSetBlockingHook;
    wsaCancelBlockingCall    : TfnwsaCancelBlockingCall;
    wsaAsyncGetServByName    : TfnwsaAsyncGetServByName;
    wsaAsyncGetServByPort    : TfnwsaAsyncGetServByPort;
    wsaAsyncGetProtoByName   : TfnwsaAsyncGetProtoByName;
    wsaAsyncGetProtoByNumber : TfnwsaAsyncGetProtoByNumber;
    wsaAsyncGetHostByName    : TfnwsaAsyncGetHostByName;
    wsaAsyncGetHostByAddr    : TfnwsaAsyncGetHostByAddr;
    wsaCancelAsyncRequest    : TfnwsaCancelAsyncRequest;
    wsaAsyncSelect           : TfnwsaAsyncSelect;
    {$IFDEF Win32}
    wsaRecvEx                : TfnwsaRecvEx;
    TransmitFile             : TfnTransmitFile;
    {$ENDIF}
  end;

function LoadWinsock : Boolean;
function wsaMakeSyncReply(Buflen, Error : Word) : LongInt;
function wsaMakeSelectReply(Event, Error : Word) : LongInt;
function wsaGetAsyncBuflen(Param : LongInt) : Word;
function wsaGetAsyncError(Param : LongInt) : Word;
function wsaGetSelectEvent(Param : LongInt) : Word;
function wsaGetSelectError(Param : LongInt) : Word;

var
  SockFuncs : TSocketFuncs;

implementation

const
  {$IFDEF Win32}
  SockDLL = 'WSOCK32';
  {$ELSE}
  SockDLL = 'WINsOCK.DLL';
  {$ENDIF}

var
  SocketModule : THandle;


{ Assure Winsock module is loaded and function pointers are set }
function LoadWinsock : Boolean;
begin
  Result := False;

  { Load Winsock module if it isn't already }
  if SocketModule = 0 then
    SocketModule := LoadLibrary(SockDLL);

  { Validate loading of the module }
  {$IFDEF Win32}
  if SocketModule = 0 then begin
  {$ELSE}
  if SocketModule <= HINsTANCE_ERROR then begin
  {$ENDIF}
    SocketModule := 0;
    Exit;
  end;

  { Load and validate all pointers }
  with SockFuncs do begin

    @Accept := GetProcAddress(SocketModule, 'accept');
    if not Assigned(Accept) then Exit;

    @Bind := GetProcAddress(SocketModule, 'bind');
    if not Assigned(Bind) then Exit;

    @CloseSocket := GetProcAddress(SocketModule, 'closesocket');
    if not Assigned(CloseSocket) then Exit;

    @Connect := GetProcAddress(SocketModule, 'connect');
    if not Assigned(Connect) then Exit;

    @GetPeerName := GetProcAddress(SocketModule, 'getpeername');
    if not Assigned(GetPeerName) then Exit;

    @GetSockName := GetProcAddress(SocketModule, 'getsockname');
    if not Assigned(GetSockName) then Exit;

    @GetSockOpt := GetProcAddress(SocketModule, 'getsockopt');
    if not Assigned(GetSockOpt) then Exit;

    @htonl := GetProcAddress(SocketModule, 'htonl');
    if not Assigned(htonl) then Exit;

    @htons := GetProcAddress(SocketModule, 'htons');
    if not Assigned(htons) then Exit;

    @INet_Addr := GetProcAddress(SocketModule, 'inet_addr');
    if not Assigned(INet_Addr) then Exit;

    @INet_Ntoa := GetProcAddress(SocketModule, 'inet_ntoa');
    if not Assigned(INet_Ntoa) then Exit;

    @IOCtlSocket := GetProcAddress(SocketModule, 'ioctlsocket');
    if not Assigned(IOCtlSocket) then Exit;

    @Listen := GetProcAddress(SocketModule, 'listen');
    if not Assigned(Listen) then Exit;

    @ntohl := GetProcAddress(SocketModule, 'ntohl');
    if not Assigned(ntohl) then Exit;

    @ntohs := GetProcAddress(SocketModule, 'ntohs');
    if not Assigned(ntohs) then Exit;

    @Recv := GetProcAddress(SocketModule, 'recv');
    if not Assigned(Recv) then Exit;

    @RecvFrom := GetProcAddress(SocketModule, 'recvfrom');
    if not Assigned(RecvFrom) then Exit;

    @Select := GetProcAddress(SocketModule, 'select');
    if not Assigned(Select) then Exit;

    @Send := GetProcAddress(SocketModule, 'send');
    if not Assigned(Send) then Exit;

    @SendTo := GetProcAddress(SocketModule, 'sendto');
    if not Assigned(SendTo) then Exit;

    @SetSockOpt := GetProcAddress(SocketModule, 'setsockopt');
    if not Assigned(SetSockOpt) then Exit;

    @Shutdown := GetProcAddress(SocketModule, 'shutdown');
    if not Assigned(Shutdown) then Exit;

    @Socket := GetProcAddress(SocketModule, 'socket');
    if not Assigned(Socket) then Exit;

    @GetHostByAddr := GetProcAddress(SocketModule, 'gethostbyaddr');
    if not Assigned(GetHostByAddr) then Exit;

    @GetHostByName := GetProcAddress(SocketModule, 'gethostbyname');
    if not Assigned(GetHostByName) then Exit;

    @GetHostName := GetProcAddress(SocketModule, 'gethostname');
    if not Assigned(GetHostName) then Exit;

    @GetServByPort := GetProcAddress(SocketModule, 'getservbyport');
    if not Assigned(GetServByPort) then Exit;

    @GetServByName := GetProcAddress(SocketModule, 'getservbyname');
    if not Assigned(GetServByName) then Exit;

    @GetProtoByNumber := GetProcAddress(SocketModule, 'getprotobynumber');
    if not Assigned(GetProtoByNumber) then Exit;

    @GetProtoByName := GetProcAddress(SocketModule, 'getprotobyname');
    if not Assigned(GetProtoByName) then Exit;

    @wsaStartup := GetProcAddress(SocketModule, 'WSAStartup');
    if not Assigned(wsaStartup) then Exit;

    @wsaCleanup := GetProcAddress(SocketModule, 'WSACleanup');
    if not Assigned(wsaCleanup) then Exit;

    @wsaSetLastError := GetProcAddress(SocketModule, 'WSASetLastError');
    if not Assigned(wsaSetLastError) then Exit;

    @wsaGetLastError := GetProcAddress(SocketModule, 'WSAGetLastError');
    if not Assigned(wsaGetLastError) then Exit;

    @wsaIsBlocking := GetProcAddress(SocketModule, 'WSAIsBlocking');
    if not Assigned(wsaIsBlocking) then Exit;

    @wsaUnhookBlockingHook := GetProcAddress(SocketModule, 'WSAUnhookBlockingHook');
    if not Assigned(wsaUnhookBlockingHook) then Exit;

    @wsaSetBlockingHook := GetProcAddress(SocketModule, 'WSASetBlockingHook');
    if not Assigned(wsaSetBlockingHook) then Exit;

    @wsaCancelBlockingCall := GetProcAddress(SocketModule, 'WSACancelBlockingCall');
    if not Assigned(wsaCancelBlockingCall) then Exit;

    @wsaAsyncGetServByName := GetProcAddress(SocketModule, 'WSAAsyncGetServByName');
    if not Assigned(wsaAsyncGetServByName) then Exit;

    @wsaAsyncGetServByPort := GetProcAddress(SocketModule, 'WSAAsyncGetServByPort');
    if not Assigned(wsaAsyncGetServByPort) then Exit;

    @wsaAsyncGetProtoByName := GetProcAddress(SocketModule, 'WSAAsyncGetProtoByName');
    if not Assigned(wsaAsyncGetProtoByName) then Exit;

    @wsaAsyncGetProtoByNumber := GetProcAddress(SocketModule, 'WSAAsyncGetProtoByNumber');
    if not Assigned(wsaAsyncGetProtoByNumber) then Exit;

    @wsaAsyncGetHostByName := GetProcAddress(SocketModule, 'WSAAsyncGetHostByName');
    if not Assigned(wsaAsyncGetHostByName) then Exit;

    @wsaAsyncGetHostByAddr := GetProcAddress(SocketModule, 'WSAAsyncGetHostByAddr');
    if not Assigned(wsaAsyncGetHostByAddr) then Exit;

    @wsaCancelAsyncRequest := GetProcAddress(SocketModule, 'WSACancelAsyncRequest');
    if not Assigned(wsaCancelAsyncRequest) then Exit;

    @wsaAsyncSelect := GetProcAddress(SocketModule, 'WSAAsyncSelect');
    if not Assigned(wsaAsyncSelect) then Exit;

    {$IFDEF Win32}

    {At least one implementation of 32-bit Winsock does not have these calls}
    {@wsaRecvEx := GetProcAddress(SocketModule, 'WSARecvEx');
    if not Assigned(wsaRecvEx) then Exit;}

    {@TransmitFile := GetProcAddress(SocketModule, 'TransmitFile');
    if not Assigned(TransmitFile) then Exit;}
    {$ENDIF}

  end;

  { If we got here -- we succeeded }
  Result := True;
end;

function wsaMakeSyncReply(Buflen, Error : Word) : LongInt;
begin
  Result := MakeLong(Buflen, Error);
end;

function wsaMakeSelectReply(Event, Error : Word) : LongInt;
begin
  Result := MakeLong(Event, Error);
end;

function wsaGetAsyncBuflen(Param : LongInt) : Word;
begin
  Result := LoWord(Param);
end;

function wsaGetAsyncError(Param : LongInt) : Word;
begin
  Result := HiWord(Param);
end;

function wsaGetSelectEvent(Param : LongInt) : Word;
begin
  Result := LoWord(Param);
end;

function wsaGetSelectError(Param : LongInt) : Word;
begin
  Result := HiWord(Param);
end;

procedure WinsockExit; far;
begin
  if SocketModule <> 0 then begin
    FreeLibrary(SocketModule);
    SocketModule := 0;
  end;
end;

initialization
{$IFNDEF Win32}
  AddExitProc(WinsockExit);
{$ENDIF}
  FillChar(SockFuncs, Sizeof(SockFuncs), #0);
  SocketModule := 0;

{$IFDEF Win32}
finalization
  {Free Winsock if we loaded it}
  WinsockExit;
{$ENDIF}

end.