wsocket_rtc.pas

Delphi快速开发Web Server

    procedure   SetAddr(InAddr : String);
    function    GetAddr : String;
    procedure   SetRemotePort(sPort : String); virtual;
    function    GetRemotePort : String;

    procedure   SetLocalAddr(sLocalAddr : String);
    procedure   SetLocalPort(sLocalPort : String);
    procedure   BindSocket; virtual;

    function    RealSend(Data : Pointer; Len : Integer) : Integer; virtual;
    procedure   RaiseExceptionFmt(const Fmt : String; args : array of const); virtual;
    procedure   RaiseException(const Msg : String); virtual;

    function    TriggerDataReceived(Error : Word) : Boolean; virtual;
    procedure   TriggerSessionAvailable(Error : Word); virtual;

    procedure   TriggerDataSent(Error : Word); virtual;
    procedure   TriggerDataOut(Len:Cardinal); virtual;
    procedure   TriggerDataIn(Len:Cardinal); virtual;
    procedure   TriggerChangeState(OldState, NewState : TSocketState); virtual;

    procedure   TriggerDNSLookupDone(Error : Word); virtual;

    procedure   TriggerError; virtual;
    function    DoRecv(var Buffer;
                       BufferSize : Integer;
                       Flags      : Integer) : Integer; virtual;

    procedure   DupConnected; virtual;

    procedure   CancelDnsLookup; virtual;

    procedure   SetLingerOption(aborting:boolean=False);

    procedure   PutDataInSendBuffer(Data : Pointer; Len : Integer);
    procedure   DeleteBufferedData;

    procedure   Dup(NewHSocket : TSocket); virtual;
    procedure   Shutdown(How : Integer); virtual;

  public
    sin         : TSockAddrIn;

    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure   Connect; virtual;
    procedure   Close; virtual;
    procedure   CloseDelayed; virtual;

    procedure   Release; virtual;
    procedure   Abort; virtual;
    procedure   Listen; virtual;
    function    Accept: TSocket; virtual;

    function    GetRcvdCount : LongInt; virtual;
    function    Receive(var Buffer; BufferSize: integer) : integer; virtual;
    function    SendData(Data : Pointer; Len : Integer) : integer; virtual;
    function    ToBuff(Data : Pointer; Len : Integer) : integer; virtual;

    function    ReceiveStr : string; virtual;
    function    SendStr(const Str : String) : Integer; virtual;
    function    BuffStr(const Str : String) : Integer; virtual;

    function    GetPeerAddr: string; virtual;
    function    GetPeerPort: string; virtual;

    function    GetXPort: string; virtual;
    function    GetXAddr: string; virtual;

    function    GetSrcPort: string;
    function    GetSrcAddr: string;

    procedure   SetProtocol(Value:TSocketProtocol);

    procedure   Do_FD_CONNECT(Err:word); virtual;
    procedure   Do_FD_CLOSE(Err:word); virtual;
    procedure   Do_FD_READ; virtual;
    procedure   Do_FD_WRITE; virtual;
    procedure   Do_FD_ACCEPT; virtual;
    procedure   Do_CloseDelayed; virtual;
    procedure   Do_Release; virtual;

    procedure   Call_FD_CONNECT(Err:word); virtual;
    procedure   Call_FD_CLOSE(Err:word); virtual;
    procedure   Call_FD_READ; virtual;
    procedure   Call_FD_WRITE; virtual;
    procedure   Call_FD_ACCEPT; virtual;
    procedure   Call_CloseDelayed; virtual;
    procedure   Call_Release; virtual;

    function GetWindowHandle:HWND;

  protected
    procedure   HandleBackGroundException(E: Exception); virtual;

    property Protocol : TSocketProtocol             read FProtocol
                                                    write SetProtocol;

    property PortNum : Integer                      read  FPortNum;
    property Handle : HWND                          read  GetWindowHandle;
    property MessageCode : Cardinal                 read  FMessageCode;
    property HSocket : TSocket                      read  FHSocket
                                                    write Dup;

    property Addr : string                          read  GetAddr
                                                    write SetAddr;
    property Port : string                          read  GetRemotePort
                                                    write SetRemotePort;

    property LocalPort : String                     read  FLocalPortStr
                                                    write SetLocalPort;
    property LocalAddr : String                     read  FLocalAddr
                                                    write SetLocalAddr;

    property PeerAddr : String                      read  GetPeerAddr;
    property PeerPort : String                      read  GetPeerPort;

    property State : TSocketState                   read  FState;

    property AllSent   : Boolean                    read  bAllSent;

    property LastError : Integer                    read  FLastError;

    property BufSize   : Integer                    read  FBufSize
                                                    write FBufSize;
    property ListenBacklog : Integer                read  FListenBacklog
                                                    write FListenBacklog;

    property UdpMultiCast       : Boolean           read  FMultiCast
                                                    write FMultiCast;
    property UdpMultiCastAddrStr: String            read  FMultiCastAddrStr
                                                    write FMultiCastAddrStr;
    property UdpMultiCastIpTTL  : Integer           read  FMultiCastIpTTL
                                                    write FMultiCastIpTTL;
    property UdpReuseAddr       : Boolean           read  FReuseAddr
                                                    write FReuseAddr;

    property OnDataReceived : TDataReceived       read  FOnDataReceived
                                                    write FOnDataReceived;
    property OnDataSent      : TDataSent            read  FOnDataSent
                                                    write FOnDataSent;
    property OnDataOut       : TDataOut             read  FOnDataOut
                                                    write FOnDataOut;
    property OnDataIn        : TDataIn             read  FOnDataIn
                                                    write FOnDataIn;
    property OnSessionAvailable : TSessionAvailable read  FOnSessionAvailable
                                                    write FOnSessionAvailable;
    property OnChangeState      : TChangeState      read  FOnChangeState
                                                    write FOnChangeState;
    property OnDnsLookupDone    : TDnsLookupDone    read  FOnDnsLookupDone
                                                    write FOnDnsLookupDone;
    property OnError            : TNotifyEvent      read  FOnError
                                                    write FOnError;
    property OnBgException      : TBgExceptionEvent read  FOnBgException
                                                    write FOnBgException;
    property MultiThreaded: boolean                 read FMultiThreaded
                                                    write FMultiThreaded;
  end;

  TWSocket = class(TCustomWSocket)
  public
    property PortNum;
    property Handle;
    property HSocket;
    property BufSize;
    property AllSent;

  published
    property MultiThreaded;

    property Addr;
    property Port;
    property LocalAddr;
    property LocalPort;
    property PeerPort;
    property PeerAddr;
    property State;

    property Protocol;

    property UdpMultiCast;
    property UdpMultiCastAddrStr;
    property UdpMultiCastIpTTL;
    property UdpReuseAddr;

    property LastError;

    property ListenBacklog;

    property OnDataReceived;
    property OnDataSent;
    property OnDataOut;
    property OnDataIn;
    property OnSessionAvailable;

    property OnChangeState;

    property OnDnsLookupDone;
    property OnError;
    property OnBgException;
  end;

  TWSocketServer = class(TWSocket);
  TWSocketClient = class(TWSocket);

procedure WinSockLoad;

function WSocketErrorDesc(error: integer) : string;

function WSocket_closesocket(s: TSocket): Integer;
function WSocket_shutdown(s: TSocket; how: Integer): Integer;

function WSocket_htons(hostshort: u_short): u_short;
function WSocket_ntohs(netshort: u_short): u_short;
function WSocket_ntohl(netlong: u_long): u_long;

implementation

const
    SIO_RCVALL = $98000001;

var
    GReqVerLow      : BYTE    = 1;
    GReqVerHigh     : BYTE    = 1;

type
    TWSAStartup            = function (wVersionRequired: word;
                                       var WSData: TWSAData): Integer; stdcall;
    TWSACleanup            = function : Integer; stdcall;
    TWSASetLastError       = procedure (iError: Integer); stdcall;
    TWSAGetLastError       = function : Integer; stdcall;
    TWSACancelAsyncRequest = function (hAsyncTaskHandle: THandle): Integer; stdcall;
    TWSAAsyncGetHostByName = function (HWindow: HWND;
                                       wMsg: u_int;
                                       name, buf: PChar;
                                       buflen: Integer): THandle; stdcall;
    TWSAAsyncGetHostByAddr = function (HWindow: HWND;
                                       wMsg: u_int; addr: PChar;
                                       len, Struct: Integer;
                                       buf: PChar;
                                       buflen: Integer): THandle; stdcall;
    TWSAAsyncSelect        = function (s: TSocket;
                                       HWindow: HWND;
                                       wMsg: u_int;
                                       lEvent: Longint): Integer; stdcall;
    TGetServByName         = function (name, proto: PChar): PServEnt; stdcall;
    TGetProtoByName        = function (name: PChar): PProtoEnt; stdcall;
    TGetHostByName         = function (name: PChar): PHostEnt; stdcall;
    TGetHostByAddr         = function (addr: Pointer; len, Struct: Integer): PHostEnt; stdcall;
    TGetHostName           = function (name: PChar; len: Integer): Integer; stdcall;
    TOpenSocket            = function (af, Struct, protocol: Integer): TSocket; stdcall;
    TShutdown              = function (s: TSocket; how: Integer): Integer; stdcall;
    TSetSockOpt            = function (s: TSocket; level, optname: Integer;
                                       optval: PChar;
                                       optlen: Integer): Integer; stdcall;
    TGetSockOpt            = function (s: TSocket; level, optname: Integer;
                                       optval: PChar;
                                       var optlen: Integer): Integer; stdcall;
    TSendTo                = function (s: TSocket; var Buf;
                                       len, flags: Integer;
                                       var addrto: TSockAddr;
                                       tolen: Integer): Integer; stdcall;
    TSend                  = function (s: TSocket; var Buf;
                                       len, flags: Integer): Integer; stdcall;
    TRecv                  = function (s: TSocket;
                                       var Buf;
                                       len, flags: Integer): Integer; stdcall;
    TRecvFrom              = function (s: TSocket;
                                       var Buf; len, flags: Integer;
                                       var from: TSockAddr;
                                       var fromlen: Integer): Integer; stdcall;
    Tntohs                 = function (netshort: u_short): u_short; stdcall;
    Tntohl                 = function (netlong: u_long): u_long; stdcall;
    TListen                = function (s: TSocket;
                                       backlog: Integer): Integer; stdcall;
    TIoctlSocket           = function (s: TSocket; cmd: DWORD;
                                       var arg: u_long): Integer; stdcall;
    TInet_ntoa             = function (inaddr: TInAddr): PChar; stdcall;
    TInet_addr             = function (cp: PChar): u_long; stdcall;
    Thtons                 = function (hostshort: u_short): u_short; stdcall;
    Thtonl                 = function (hostlong: u_long): u_long; stdcall;
    TGetSockName           = function (s: TSocket; var name: TSockAddr;
                                       var namelen: Integer): Integer; stdcall;
    TGetPeerName           = function (s: TSocket; var name: TSockAddr;
                                       var namelen: Integer): Integer; stdcall;
    TConnect               = function (s: TSocket; var name: TSockAddr;
                                       namelen: Integer): Integer; stdcall;
    TCloseSocket           = function (s: TSocket): Integer; stdcall;
    TBind                  = function (s: TSocket; var addr: TSockAddr;
                                       namelen: Integer): Integer; stdcall;
    TAccept                = function (s: TSocket; addr: PSockAddr;
                                       addrlen: PInteger): TSocket; stdcall;
var
    _WSAStartup            : TWSAStartup;
    _WSACleanup            : TWSACleanup;

    _WSAGetLastError       : TWSAGetLastError;
    _WSACancelAsyncRequest : TWSACancelAsyncRequest;
    _WSAAsyncSelect        : TWSAAsyncSelect;
    _GetServByName         : TGetServByName;
    _GetHostByName         : TGetHostByName;
    _Socket                : TOpenSocket;
    _Shutdown              : TShutdown;
    _SetSockOpt            : TSetSockOpt;
    _GetSockOpt            : TGetSockOpt;
    _SendTo                : TSendTo;
    _Send                  : TSend;
    _Recv                  : TRecv;
    _RecvFrom              : TRecvFrom;
    _ntohs                 : Tntohs;
    _ntohl                 : Tntohl;
    _Listen                : TListen;
    _IoctlSocket           : TIoctlSocket;
    _Inet_ntoa             : TInet_ntoa;
    _Inet_addr             : TInet_addr;
    _htons                 : Thtons;
    _GetSockName           : TGetSockName;
    _GetPeerName           : TGetPeerName;
    _Connect               : TConnect;
    _CloseSocket           : TCloseSocket;
    _Bind                  : TBind;
    _Accept                : TAccept;

// *** API calls not needed ...
//   _WSASetLastError       : TWSASetLastError;
//   _WSAAsyncGetHostByName : TWSAAsyncGetHostByName;
//   _WSAAsyncGetHostByAddr : TWSAAsyncGetHostByAddr;
//   _GetProtoByName        : TGetProtoByName;
//   _GetHostByAddr         : TGetHostByAddr;
//   _GetHostName           : TGetHostName;
//   _htonl                 : Thtonl;

    FDllHandle     : THandle  = 0;
    LibCS: TRtcCritSec;

const
    socksNoError              = 20000;
    socksProtocolError        = 20001;
    socksVersionError         = 20002;
    socksAuthMethodError      = 20003;
    socksGeneralFailure       = 20004;
    socksConnectionNotAllowed = 20005;
    socksNetworkUnreachable   = 20006;
    socksHostUnreachable      = 20007;
    socksConnectionRefused    = 20008;
    socksTtlExpired           = 20009;
    socksUnknownCommand       = 20010;
    socksUnknownAddressType   = 20011;
    socksUnassignedError      = 20012;
    socksInternalError        = 20013;
    socksDataReceiveError     = 20014;
    socksAuthenticationFailed = 20015;
    socksRejectedOrFailed     = 20016;
    socksHostResolutionFailed = 20017;

var
    GInitData      : TWSADATA;

function WSAGetLastError:integer;
  begin
  Result := _WSAGetLastError();
  end;

function atoi(value : string) : Word;
var
    i : Integer;
begin
    Result := 0;
    i := 1;
    while (i <= Length(Value)) and (Value[i] = ' ') do
        i := i + 1;
    while (i <= Length(Value)) and (Value[i] >= '0') and (Value[i] <= '9')do begin
        Result := Result * 10 + ord(Value[i]) - ord('0');
        i := i + 1;
    end;
end;

function IsDigit(Ch : Char) : Boolean;
begin
    Result := (ch >= '0') and (ch <= '9');
end;


function WSocketIsDottedIP(const S : String) : Boolean;
var
    I          : Integer;
    DotCount   : Integer;
    NumVal     : Integer;
begin
    Result     := FALSE;
    DotCount   := 0;
    NumVal     := 0;
    I          := 1;
    { Skip leading spaces }
    while (I <= Length(S)) and (S[I] = ' ') do
        Inc(I);
    { Can't begin with a dot }
    if (I <= Length(S)) and (S[I] = '.') then
        Exit;
    { Scan full string }
    while I <= Length(S) do begin
        if S[I] = '.' then begin
            Inc(DotCount);
            if (DotCount > 3) or (NumVal > 255) then
                Exit;