adsocket.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   ADSOCKET.PAS 4.06                   *}
{*********************************************************}
{* Winsock support classes                               *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$G+,X+,F+,T-}
{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}

unit AdSocket;
  { -Apro Winsock support classes }

interface

uses
  WinTypes,
  WinProcs,
  Messages,
  SysUtils,
  Classes,
  Forms,
  OOMisc,
  AdWUtil;

const
  IPStrSize = 15;
  { This should be the same in AWUSER.PAS }                          
  CM_APDSOCKETMESSAGE = WM_USER + $0711;
  CM_APDSOCKETQUIT    = WM_USER + $0712;

  { APRO Specific errors }
  ADWSBASE   =  9000;                                                  

  ADWSERROR        = (ADWSBASE + 1);                                   
  ADWSLOADERROR    = (ADWSBASE + 2);                                   
  ADWSVERSIONERROR = (ADWSBASE + 3);                                   
  ADWSNOTINIT      = (ADWSBASE + 4);                                   
  ADWSINVPORT      = (ADWSBASE + 5);                                   
  ADWSCANTCHANGE   = (ADWSBASE + 6);                                   
  ADWSCANTRESOLVE  = (ADWSBASE + 7);
  { Socks 4/4a errors }
  ADWSREQUESTFAILED  = (ADWSBASE + 8);
  ADWSREJECTEDIDENTD = (ADWSBASE + 9);
  ADWSREJECTEDUSERID = (ADWSBASE + 10);
  ADWSUNKNOWNERROR   = (ADWSBASE + 11);
  { Socks 5 errors }
  ADWSSOCKSERROR           = (ADWSBASE + 12);
  ADWSCONNECTIONNOTALLOWED = (ADWSBASE + 13);
  ADWSNETWORKUNREACHABLE   = (ADWSBASE + 14);
  ADWSHOSTUNREACHABLE      = (ADWSBASE + 15);
  ADWSREFUSED              = (ADWSBASE + 16);
  ADWSTTLEXPIRED           = (ADWSBASE + 17);
  ADWSBADCOMMAND           = (ADWSBASE + 18);
  ADWSBADADDRESSTYPE       = (ADWSBASE + 19);
  ADWSUNSUPPORTEDREPLY     = (ADWSBASE + 20);
  ADWSINVALIDREPLY         = (ADWSBASE + 21);

type
  TCMAPDSocketMessage = record
    Msg: Cardinal;
    Socket: TSocket;
    SelectEvent: Word;
    SelectError: Word;
    Result: Longint;
  end;

  EApdSocketException = class(Exception)
    ErrorCode : Integer;
    { Dummy parameters are a hack to make BCB happy }
    constructor CreateNoInit(ErrCode : Integer; Dummy : PChar);
    constructor CreateTranslate(ErrCode, Dummy1, Dummy2 : Integer);
  end;

  TWsMode = (wsClient, wsServer);

  TWsNotifyEvent = procedure (Sender : TObject; Socket : TSocket) of object;
  TWsSocketErrorEvent =
    procedure (Sender : TObject; Socket : TSocket; ErrCode : Integer) of object;

  TApdSocket = class(TComponent)
  protected {private}
    { Property Support Fields }
    FHandle : HWnd;
    FOnWsAccept : TWsNotifyEvent;
    FOnWsConnect : TWsNotifyEvent;
    FOnWsDisconnect : TWsNotifyEvent;
    FOnWsError : TWsSocketErrorEvent;
    FOnWsRead : TWsNotifyEvent;
    FOnWsWrite : TWsNotifyEvent;
    { Internal Use }
    asDllLoaded : Boolean;
    asStartErrorCode : Integer;
    asWSData : TWSAData;
    function GetDescription : string;
    function GetHandle : HWnd;
    function GetLastError : Integer;
    function GetLocalHost : string;
    function GetLocalAddress : string;
    function GetSystemStatus : string;
    procedure CMAPDSocketMessage(var Message: TCMAPDSocketMessage); message CM_APDSOCKETMESSAGE;
    procedure WndProc(var Message : TMessage);
  protected
    procedure ShowErrorMessage(Err : Integer); dynamic;
    procedure DoAccept(Socket : TSocket); virtual;
    procedure DoConnect(Socket : TSocket); virtual;
    procedure DoDisconnect(Socket : TSocket); virtual;
    procedure DoError(Socket : TSocket; ErrCode : Integer); virtual;
    procedure DoRead(Socket : TSocket); virtual;
    procedure DoWrite(Socket : TSocket); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Conversion routines }
    procedure CheckLoaded;
    procedure DefaultHandler(var Message); override;
    function htonl(HostLong : LongInt) : LongInt;
    function htons(HostShort : Word) : Word;
    function ntohl(NetLong : LongInt) : LongInt;
    function ntohs(NetShort : Word) : Word;
    function NetAddr2String(InAddr : TInAddr) : string;
    function String2NetAddr(const S : string) : TInAddr;
    { Lookup routines }
    function LookupAddress(InAddr : TInAddr) : string;
    function LookupName(const Name : string) : TInAddr;
    function LookupPort(Port : Word) : string;
    function LookupService(const Service : string) : Integer;
    { Socket methods }
    function AcceptSocket(Socket : TSocket; var Address : TSockAddrIn) : TSocket;
    function BindSocket(Socket : TSocket; Address : TSockAddrIn) : Integer;
    function CanReadSocket(Socket : TSocket; WaitTime : Longint) : Boolean;
    function CanWriteSocket(Socket : TSocket; WaitTime : Longint) : Boolean;
    function CloseSocket(Socket : TSocket) : Integer;
    function ConnectSocket(Socket : TSocket; Address : TSockAddrIn) : Integer;
    function CreateSocket : TSocket;
    function ListenSocket(Socket : TSocket; Backlog : Integer) : Integer;
    function ReadSocket(Socket : TSocket; var Buf; BufSize, Flags : Integer) : Integer;
    function ShutdownSocket(Socket : TSocket; How : Integer) : Integer;
    function SetSocketOptions(Socket : TSocket; Level : Cardinal; OptName : Integer;
             var OptVal; OptLen : Integer): Integer;
    function SetAsyncStyles(Socket : TSocket; lEvent : LongInt) : Integer;
    function WriteSocket(Socket : TSocket; var Buf; BufSize, Flags : Integer) : Integer;
    { Properties }
    property Description : string read GetDescription;
    property Handle : HWnd read GetHandle;
    property HighVersion : Word read asWSData.wHighVersion;
    property LastError : Integer read GetLastError;
    property LocalHost : string read GetLocalHost;
    property LocalAddress : string read GetLocalAddress;
    property MaxSockets : Word read asWSData.iMaxSockets;
    property SystemStatus : string read GetSystemStatus;
    property WsVersion : Word read asWSData.wVersion;
    { Events }
    property OnWsAccept : TWsNotifyEvent read FOnWsAccept write FOnWsAccept;
    property OnWsConnect : TWsNotifyEvent read FOnWsConnect write FOnWsConnect;
    property OnWsDisconnect : TWsNotifyEvent read FOnWsDisconnect write FOnWsDisconnect;
    property OnWsError : TWsSocketErrorEvent read FOnWsError write FOnWsError;
    property OnWsRead : TWsNotifyEvent read FOnWsRead write FOnWsRead;
    property OnWsWrite : TWsNotifyEvent read FOnWsWrite write FOnWsWrite;
  end;

implementation

uses
  AdExcept;

{ - Winsock exception stuff }
constructor EApdSocketException.CreateNoInit(ErrCode : Integer; Dummy : PChar);
begin
  ErrorCode := ErrCode;
  inherited CreateFmt(AproLoadStr(ADWSNOTINIT), [AproLoadStr(ErrCode)]);
end;

constructor EApdSocketException.CreateTranslate(ErrCode, Dummy1, Dummy2 : Integer);
begin
  ErrorCode := ErrCode;
  inherited Create(AproLoadStr(ErrorCode));
end;

{ -Creates the TApdSocket instance }
constructor TApdSocket.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { Load the Winsock DLL and initialize function pointers }
  asDllLoaded := LoadWinsock;
  if not asDllLoaded then begin
    { Be nice to the COMPLIB - an exception would not be good here }
    ShowErrorMessage(ADWSLOADERROR);
    asStartErrorCode := ADWSLOADERROR;
    Exit;
  end;
  { Start Winsock }
  asStartErrorCode := SockFuncs.WSAStartup(SOCK_VERSION, asWSData);
  if asStartErrorCode <> 0 then begin
    ShowErrorMessage(asStartErrorCode);
    Exit;
  end;
  { Verify version }
  if (HiByte(asWSData.wVersion) <> HiByte(SOCK_VERSION)) or
    (LoByte(asWSData.wVersion) <> LoByte(SOCK_VERSION)) then begin
      asStartErrorCode := ADWSVERSIONERROR;
      ShowErrorMessage(asStartErrorCode);
    end;
  FHandle := AllocateHWnd(WndProc);                                
end;

{ -Destroys the TApdSocket instance }
destructor TApdSocket.Destroy;
begin
  if asDllLoaded then begin
    with SockFuncs do begin
      { Cancel blocking calls if we had any }
      WSACancelBlockingCall;
      { Shut down Winsock }
      WSACleanup;
    end;
  end;
  if FHandle <> 0 then DeallocateHWnd(FHandle);
  inherited Destroy;
end;

{ -Gets the info in the Description field of WSAData }
function TApdSocket.GetDescription : string;
begin
  Result := StrPas(asWSData.szDescription);
end;

{ -Creates window handle for class }
function TApdSocket.GetHandle : HWnd;
begin
  Result := FHandle;
end;

{ -Gets the last Winsock error }
function TApdSocket.GetLastError : Integer;
begin
  CheckLoaded;
  Result := SockFuncs.WSAGetLastError;
end;

{ -Gets the name of the local host machine }
function TApdSocket.GetLocalHost : string;
var
  HostStr : array[0..255] of AnsiChar;
begin
  Result := '';
  CheckLoaded;
  if SockFuncs.GetHostName(@HostStr, SizeOf(HostStr)) = 0 then begin
    Result := StrPas(HostStr);
  end;
end;

{ -Gets the address of the local host machine }
function TApdSocket.GetLocalAddress : string;
var
  HostStr : array[0..255] of AnsiChar;
  HostEnt : PHostEnt;
begin
  Result := '';
  CheckLoaded;
  if SockFuncs.GetHostName(@HostStr, SizeOf(HostStr)) = 0 then begin
    HostEnt := SockFuncs.GetHostByName(@HostStr);
    if Assigned(HostEnt) then
      Result := NetAddr2String (HostEnt.h_addr_list[0]^);
  end;
end;

{ -Gets the info in the SystemStatus field of WSAData }
function TApdSocket.GetSystemStatus : string;
begin
  Result := StrPas(asWSData.szSystemStatus);
end;

{ -Message handler for Winsock messages }
procedure TApdSocket.CMAPDSocketMessage(var Message: TCMAPDSocketMessage);
begin
  with Message do begin
    if SelectError = 0 then begin
      case SelectEvent of
        FD_CONNECT : DoConnect(Socket);
        FD_CLOSE   : DoDisconnect(Socket);
        FD_READ    : DoRead(Socket);
        FD_WRITE   : DoWrite(Socket);
        FD_ACCEPT  : DoAccept(Socket);
      end;
    end else begin
      DoError(Socket, SelectError);
    end;
  end;
end;

{ -Default handler (intentionally empty) }