blcksock.pas

snmp设计增加相应SNMP的OID,是实时处理的.

    {:Return peer name from remote side certificate. This is good for verify,
     if certificate is generated for remote side IP name.}
    function SSLGetPeerName: string;

    {:Return subject's hash of remote SSL peer.}
    function SSLGetPeerSubjectHash: Cardinal;

    {:Return issuer's certificate hash of remote SSL peer.}
    function SSLGetPeerIssuerHash: Cardinal;

    {:Return fingerprint of remote SSL peer.}
    function SSLGetPeerFingerprint: string;

    {:Return all detailed information about certificate from remote side of
     SSL/TLS connection. Result string is multilined!}
    function SSLGetCertInfo: string;

    {:Return currently used Cipher.}
    function SSLGetCipherName: string;

    {:Return currently used number of bits in current Cipher algorythm.}
    function SSLGetCipherBits: integer;

    {:Return number of bits in current Cipher algorythm.}
    function SSLGetCipherAlgBits: integer;

    {:Return result value of verify remote side certificate. Look to OpenSSL
     documentation for possible values. For example 0 is successfuly verified
     certificate, or 18 is self-signed certificate.}
    function SSLGetVerifyCert: integer;

    {:Test last SSL operation for errors. If error occured, then is filled
     @link(SSLLastError) and @link(SSLLastErrorDesc) properties.}
    function SSLCheck: Boolean;

    {:Return value of socket type. For TCP return SOCK_STREAM.}
    function GetSocketType: integer; override;

    {:Return value of protocol type for socket creation. For TCP return
     IPPROTO_TCP.}
    function GetSocketProtocol: integer; override;

    {:Is SSL interface loaded or not?}
    property SSLLoaded: Boolean read GetSslLoaded;

    {:By this property you can enable or disable SSL mode. Enabling loads needed
     OpenSSL or SSLeay libraries. Libraries is loaded to memory only once for
     all Synapse's objects.

     Note: when you enable SSL mode, all keys and certificates are loaded (if
     needed property is unempty)}
    property SSLEnabled: Boolean read FSslEnabled write SetSslEnabled;

    {:Contains last SSL error code.}
    property SSLLastError: integer read FSSLLastError;

    {:If some SSL error is occured, then contains human readable description of
     this error.}
    property SSLLastErrorDesc: string read FSSLLastErrorDesc;

    {:@True if is used HTTP tunnel mode.}
    property HTTPTunnel: Boolean read FHTTPTunnel;
  published
    {:Here you can specify requested SSL/TLS mode. Default is autodetection, but
     on some servers autodetection not working properly. In this case you must
     specify requested SSL/TLS mode by your hand!}
    property SSLType: TSSLType read FSSLType write FSSLType;

    {:If is SSL mode enabled and this property is @TRUE, then all data (read
     and write) will not be encrypted/decrypted.}
    property SSLBypass: Boolean read FSslBypass write FSslBypass;

    {:Password for decrypting of encoded certificate.

     Note: This not work with delphi8. You cannot use password protected
     certificates with .NET!}
    property SSLPassword: string read FSSLPassword write FSSLPassword;

    {:By this property you can modify default set of SSL/TLS ciphers.}
    property SSLCiphers: string read FSSLCiphers write FSSLCiphers;

    {:Filename and path to PEM file with your certificate. If certificate need
     password for decrypt, you can assign this password to SSLPassword property.}
    property SSLCertificateFile: string read FSSLCertificateFile write FSSLCertificateFile;

    {:Filename and path to PEM file with your private key.}
    property SSLPrivateKeyFile: string read FSSLPrivateKeyFile write FSSLPrivateKeyFile;

    {:filename and path to file with bundle of CA certificates. (you may use
     ca-bundle.crt file from SynaCert.zip)}
    property SSLCertCAFile: string read FSSLCertCAFile write FSSLCertCAFile;

    {:If @true, then is verified client certificate. (it is good for writing
     SSL/TLS servers.) When you are not server, but you are client, then if this
     property is @true, verify servers certificate.}
    property SSLverifyCert: Boolean read FSSLverifyCert write FSSLverifyCert;

    {:Specify IP address of HTTP proxy. Assingning non-empty value to this
     property enable HTTP-tunnel mode. This mode is for tunnelling any outgoing
     TCP connection through HTTP proxy server. (If policy on HTTP proxy server
     allow this!) Warning: You cannot combine this mode with SOCK5 mode!}
    property HTTPTunnelIP: string read FHTTPTunnelIP Write FHTTPTunnelIP;

    {:Specify port of HTTP proxy for HTTP-tunneling.}
    property HTTPTunnelPort: string read FHTTPTunnelPort Write FHTTPTunnelPort;

    {:Specify authorisation username for access to HTTP proxy in HTTP-tunnel
     mode. If you not need authorisation, then let this property empty.}
    property HTTPTunnelUser: string read FHTTPTunnelUser Write FHTTPTunnelUser;

    {:Specify authorisation password for access to HTTP proxy in HTTP-tunnel
     mode.}
    property HTTPTunnelPass: string read FHTTPTunnelPass Write FHTTPTunnelPass;

    {:Specify timeout for communication with HTTP proxy in HTTPtunnel mode.}
    property HTTPTunnelTimeout: integer read FHTTPTunnelTimeout Write FHTTPTunnelTimeout;
  end;

  {:@abstract(Datagram based communication)
   This class implementing datagram based communication instead default stream
   based communication style.}
  TDgramBlockSocket = class(TSocksBlockSocket)
  public
    {:Fill @link(TBlockSocket.RemoteSin) structure. This address is used for
     sending data.}
    procedure Connect(IP, Port: string); override;

    {:Silently redirected to @link(TBlockSocket.SendBufferTo).}
    function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;

    {:Silently redirected to @link(TBlockSocket.RecvBufferFrom).}
    function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override;
  end;

  {:@abstract(Implementation of UDP socket.)
   NOTE: in this class is all receiving redirected to RecvBufferFrom. You can
   use for reading any receive function. Preffered is RecvPacket! Similary all
   sending is redirected to SendbufferTo. You can use for sending UDP packet any
   sending function, like SendString.

   Supported features: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5
   proxy (only unicasts! Outgoing and incomming.)}
  TUDPBlockSocket = class(TDgramBlockSocket)
  protected
    FSocksControlSock: TTCPBlockSocket;
    function UdpAssociation: Boolean;
    procedure SetMulticastTTL(TTL: integer);
    function GetMulticastTTL:integer;
  public
    destructor Destroy; override;

    {:Enable or disable sending of broadcasts. If seting OK, result is @true.
     This method is not supported in SOCKS5 mode! IPv6 does not support
     broadcasts! In this case you must use Multicasts instead.}
    procedure EnableBroadcast(Value: Boolean);

    {:See @link(TBlockSocket.SendBufferTo)}
    function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; override;

    {:See @link(TBlockSocket.RecvBufferFrom)}
    function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override;
{$IFNDEF CIL}
    {:Add this socket to given multicast group. You cannot use Multicasts in
     SOCKS mode!}
    procedure AddMulticast(MCastIP:string);

    {:Remove this socket from given multicast group.}
    procedure DropMulticast(MCastIP:string);
{$ENDIF}
    {:All sended multicast datagrams is loopbacked to your interface too. (you
     can read your sended datas.) You can disable this feature by this function.
     This function not working on some Windows systems!}
    procedure EnableMulticastLoop(Value: Boolean);

    {:Return value of socket type. For UDP return SOCK_DGRAM.}
    function GetSocketType: integer; override;

    {:Return value of protocol type for socket creation. For UDP return
     IPPROTO_UDP.}
    function GetSocketProtocol: integer; override;

    {:Set Time-to-live value for multicasts packets. It define number of routers
     for transfer of datas. If you set this to 1 (dafault system value), then
     multicasts packet goes only to you local network. If you need transport
     multicast packet to worldwide, then increase this value, but be carefull,
     lot of routers on internet does not transport multicasts packets!}
    property MulticastTTL: Integer read GetMulticastTTL Write SetMulticastTTL;
  end;

  {:@abstract(Implementation of RAW ICMP socket.)
   For this object you must have rights for creating RAW sockets!}
  TICMPBlockSocket = class(TDgramBlockSocket)
  public
    {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
    function GetSocketType: integer; override;

    {:Return value of protocol type for socket creation. For ICMP returns
     IPPROTO_ICMP or IPPROTO_ICMPV6}
    function GetSocketProtocol: integer; override;
  end;

  {:@abstract(Implementation of RAW socket.)
   For this object you must have rights for creating RAW sockets!}
  TRAWBlockSocket = class(TBlockSocket)
  public
    {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
    function GetSocketType: integer; override;

    {:Return value of protocol type for socket creation. For RAW returns
     IPPROTO_RAW.}
    function GetSocketProtocol: integer; override;
  end;

  {:@abstract(Record with definition of IP packet header.)
   For reading data from ICMP or RAW sockets.}
  TIPHeader = record
    VerLen: Byte;
    TOS: Byte;
    TotalLen: Word;
    Identifer: Word;
    FragOffsets: Word;
    TTL: Byte;
    Protocol: Byte;
    CheckSum: Word;
    SourceIp: DWORD;
    DestIp: DWORD;
    Options: DWORD;
  end;

  {:@abstract(Parent class of application protocol implementations.)
   By this class is defined common properties.}
  TSynaClient = Class(TObject)
  protected
    FTargetHost: string;
    FTargetPort: string;
    FIPInterface: string;
    FTimeout: integer;
    FUserName: string;
    FPassword: string;
  public
    constructor Create;
  published
    {:Specify terget server IP (or symbolic name). Default is 'localhost'.}
    property TargetHost: string read FTargetHost Write FTargetHost;

    {:Specify terget server port (or symbolic name).}
    property TargetPort: string read FTargetPort Write FTargetPort;

    {:Defined local socket address. (outgoing IP address). By default is used
     '0.0.0.0' as wildcard for default IP.}
    property IPInterface: string read FIPInterface Write FIPInterface;

    {:Specify default timeout for socket operations.}
    property Timeout: integer read FTimeout Write FTimeout;

    {:If protocol need user authorization, then fill here username.}
    property UserName: string read FUserName Write FUserName;

    {:If protocol need user authorization, then fill here password.}
    property Password: string read FPassword Write FPassword;
  end;

implementation

{$IFDEF ONCEWINSOCK}
var
  WsaDataOnce: TWSADATA;
  e: ESynapseError;
{$ENDIF}


constructor TBlockSocket.Create;
begin
  CreateAlternate('');
end;

constructor TBlockSocket.CreateAlternate(Stub: string);
{$IFNDEF ONCEWINSOCK}
var
  e: ESynapseError;
{$ENDIF}
begin
  inherited Create;
  FDelayedOptions := TList.Create;
  FRaiseExcept := False;
{$IFDEF RAISEEXCEPT}
  FRaiseExcept := True;
{$ENDIF}
  FSocket := INVALID_SOCKET;
  FBuffer := '';
  FLastCR := False;
  FLastLF := False;
  FBinded := False;
  FNonBlockMode := False;
  FMaxLineLength := 0;
  FMaxSendBandwidth := 0;
  FNextSend := 0;
  FMaxRecvBandwidth := 0;
  FNextRecv := 0;
  FConvertLineEnd := False;
  FFamily := SF_Any;
  FFamilySave := SF_Any;
  FIP6used := False;
  FPreferIP4 := True;
  FInterPacketTimeout := True;
  FRecvCounter := 0;
  FSendCounter := 0;
  FSendMaxChunk := c64k;
  FStopFlag := False;
{$IFNDEF ONCEWINSOCK}
  if Stub = '' then
    Stub := DLLStackName;
  if not InitSocketInterface(Stub) then
  begin
    e := ESynapseError.Create('Error loading Socket interface (' + Stub + ')!');
    e.ErrorCode := 0;
    e.ErrorMessage := 'Error loading Socket interface (' + Stub + ')!';
    raise e;
  end;
  SockCheck(synsock.WSAStartup(WinsockLevel, FWsaDataOnce));
  ExceptCheck;
{$ENDIF}
end;

destructor TBlockSocket.Destroy;
var
  n: integer;
  p: TSynaOption;
begin
  CloseSocket;