blcksock.pas

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

{==============================================================================|
| Project : Ararat Synapse                                       | 008.003.007 |
|==============================================================================|
| Content: Library base                                                        |
|==============================================================================|
| Copyright (c)1999-2004, Lukas Gebauer                                        |
| All rights reserved.                                                         |
|                                                                              |
| Redistribution and use in source and binary forms, with or without           |
| modification, are permitted provided that the following conditions are met:  |
|                                                                              |
| Redistributions of source code must retain the above copyright notice, this  |
| list of conditions and the following disclaimer.                             |
|                                                                              |
| Redistributions in binary form must reproduce the above copyright notice,    |
| this list of conditions and the following disclaimer in the documentation    |
| and/or other materials provided with the distribution.                       |
|                                                                              |
| Neither the name of Lukas Gebauer nor the names of its contributors may      |
| be used to endorse or promote products derived from this software without    |
| specific prior written permission.                                           |
|                                                                              |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
| DAMAGE.                                                                      |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)1999-2004.                |
| All Rights Reserved.                                                         |
|==============================================================================|
| Contributor(s):                                                              |
|==============================================================================|
| History: see HISTORY.HTM from distribution package                           |
|          (Found at URL: http://www.ararat.cz/synapse/)                       |
|==============================================================================}

{
Special thanks to Gregor Ibic <[e-mail]>
 (Intelicom d.o.o., http://www.intelicom.si)
 for good inspiration about SSL programming.
}

{$DEFINE ONCEWINSOCK}
{Note about define ONCEWINSOCK:
If you remove this compiler directive, then socket interface is loaded and
initialized on constructor of TBlockSocket class for each socket separately.
Socket interface is used only if your need it.

If you leave this directive here, then socket interface is loaded and
initialized only once at start of your program! It boost performace on high
count of created and destroyed sockets. It eliminate possible small resource
leak on Windows systems too.
}

//{$DEFINE RAISEEXCEPT}
{When you enable this define, then is Raiseexcept property is on by default
}

{:@abstract(Synapse's library core)

Core with implementation basic socket classes.
}

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$IFDEF VER125}
  {$DEFINE BCB}
{$ENDIF}
{$IFDEF BCB}
  {$ObjExportAll On}
{$ENDIF}
{$Q-}
{$H+}
{$M+}

unit blcksock;

interface

uses
  SysUtils, Classes,
{$IFDEF LINUX}
  {$IFDEF FPC}
  synafpc,
  {$ENDIF}
  Libc,
{$ENDIF}
{$IFDEF WIN32}
  Windows,
{$ENDIF}
  synsock, synautil, synacode
{$IFDEF CIL}
  ,System.Net
  ,System.Net.Sockets
  ,System.Text
{$ENDIF}
  , synassl;

const

  SynapseRelease = '35';

  cLocalhost = '127.0.0.1';
  cAnyHost = '0.0.0.0';
  cBroadcast = '255.255.255.255';
  c6Localhost = '::1';
  c6AnyHost = '::0';
  c6Broadcast = 'ffff::1';
  cAnyPort = '0';
  CR = #$0d;
  LF = #$0a;
  CRLF = CR + LF;
  c64k = 65535;


type

  {:@abstract(Exception clas used by Synapse)
   When you enable generating of exceptions, this exception is raised by
   Synapse's units.}
  ESynapseError = class(Exception)
  private
    FErrorCode: Integer;
    FErrorMessage: string;
  published
    {:Code of error. Value depending on used operating system}
    property ErrorCode: Integer read FErrorCode Write FErrorCode;
    {:Human readable description of error.}
    property ErrorMessage: string read FErrorMessage Write FErrorMessage;
  end;

  {:Types of OnStatus events}
  THookSocketReason = (
    {:Resolving is begin. Resolved IP and port is in parameter in format like:
     'localhost.somewhere.com:25'.}
    HR_ResolvingBegin,
    {:Resolving is done. Resolved IP and port is in parameter in format like:
     'localhost.somewhere.com:25'. It is always same as in HR_ResolvingBegin!}
    HR_ResolvingEnd,
    {:Socket created by CreateSocket method. It reporting Family of created
     socket too!}
    HR_SocketCreate,
    {:Socket closed by CloseSocket method.}
    HR_SocketClose,
    {:Socket binded to IP and Port. Binded IP and Port is in parameter in format
     like: 'localhost.somewhere.com:25'.}
    HR_Bind,
    {:Socket connected to IP and Port. Connected IP and Port is in parameter in
     format like: 'localhost.somewhere.com:25'.}
    HR_Connect,
    {:Called when CanRead method is used with @True result.}
    HR_CanRead,
    {:Called when CanWrite method is used with @True result.}
    HR_CanWrite,
    {:Socket is swithed to Listen mode. (TCP socket only)}
    HR_Listen,
    {:Socket Accepting client connection. (TCP socket only)}
    HR_Accept,
    {:report count of bytes readed from socket. Number is in parameter string.
     If you need is in integer, you must use StrToInt function!}
    HR_ReadCount,
    {:report count of bytes writed to socket. Number is in parameter string. If
     you need is in integer, you must use StrToInt function!}
    HR_WriteCount,
    {:If is limiting of bandwidth on, then this reason is called when sending or
     receiving is stopped for satisfy bandwidth limit. Parameter is count of
     waiting milliseconds.}
    HR_Wait,
    {:report situation where communication error occured. When raiseexcept is
     @true, then exception is called after this Hook reason.}
    HR_Error
    );

  {:Procedural type for OnStatus event. Sender is calling TBlockSocket object,
   Reason is one of set Status events and value is optional data.}
  THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason;
    const Value: string) of object;

  {:this procedural type is used for dataFilter hooks.}
  THookDataFilter = procedure(Sender: TObject; var Value: string) of object;

  {:This procedural type is used for hook OnCreateSocket. By this hook you can
   insert your code after initialisation of socket. (you can set special socket
   options, etc.)}
  THookCreateSocket = procedure(Sender: TObject) of object;

  {:Specify family of socket.}
  TSocketFamily = (
    {:Default mode. Socket family is defined by target address for connection.
     It allows instant access to IPv4 and IPv6 nodes. When you need IPv6 address
     as destination, then is used IPv6 mode. othervise is used IPv4 mode.
     However this mode not working properly with preliminary IPv6 supports!}
    SF_Any,
    {:Turn this class to pure IPv4 mode. This mode is totally compatible with
     previous Synapse releases.}
    SF_IP4,
    {:Turn to only IPv6 mode.}
    SF_IP6
    );

  {:specify possible values of SOCKS modes.}
  TSocksType = (
    ST_Socks5,
    ST_Socks4
    );

  {:Specify requested SSL/TLS version for secure connection.}
  TSSLType = (
    LT_SSLv2,
    LT_SSLv3,
    LT_TLSv1,
    LT_all
    );

  {:Specify type of socket delayed option.}
  TSynaOptionType = (
    SOT_Linger,
    SOT_RecvBuff,
    SOT_SendBuff,
    SOT_NonBlock,
    SOT_RecvTimeout,
    SOT_SendTimeout,
    SOT_Reuse,
    SOT_TTL,
    SOT_Broadcast,
    SOT_MulticastTTL,
    SOT_MulticastLoop
    );

  {:@abstract(this object is used for remember delayed socket option set.)}
  TSynaOption = class(TObject)
  public
    Option: TSynaOptionType;
    Enabled: Boolean;
    Value: Integer;
  end;

  {:@abstract(Basic IP object.)
   This is parent class for other class with protocol implementations. Do not
   use this class directly! Use @link(TICMPBlockSocket), @link(TRAWBlockSocket),
   @link(TTCPBlockSocket) or @link(TUDPBlockSocket) instead.}
  TBlockSocket = class(TObject)
  private
    FOnStatus: THookSocketStatus;
    FOnReadFilter: THookDataFilter;
    FOnWriteFilter: THookDataFilter;
    FOnCreateSocket: THookCreateSocket;
    FLocalSin: TVarSin;
    FRemoteSin: TVarSin;
    FTag: integer;
    FBuffer: string;
    FRaiseExcept: Boolean;
    FNonBlockMode: Boolean;
    FMaxLineLength: Integer;
    FMaxSendBandwidth: Integer;
    FNextSend: ULong;
    FMaxRecvBandwidth: Integer;
    FNextRecv: ULong;
    FConvertLineEnd: Boolean;
    FLastCR: Boolean;
    FLastLF: Boolean;
    FBinded: Boolean;
    FFamily: TSocketFamily;
    FFamilySave: TSocketFamily;
    FIP6used: Boolean;
    FPreferIP4: Boolean;
    FDelayedOptions: TList;
    FInterPacketTimeout: Boolean;
    {$IFNDEF CIL}
    FFDSet: TFDSet;
    {$ENDIF}
    FRecvCounter: Integer;
    FSendCounter: Integer;
    FSendMaxChunk: Integer;
    FStopFlag: Boolean;
    function GetSizeRecvBuffer: Integer;
    procedure SetSizeRecvBuffer(Size: Integer);
    function GetSizeSendBuffer: Integer;
    procedure SetSizeSendBuffer(Size: Integer);
    procedure SetNonBlockMode(Value: Boolean);
    procedure SetTTL(TTL: integer);
    function GetTTL:integer;
    function IsNewApi: Boolean;
    procedure SetFamily(Value: TSocketFamily); virtual;
    procedure SetSocket(Value: TSocket); virtual;
    function GetWsaData: TWSAData;
  protected
    FSocket: TSocket;
    FLastError: Integer;
    FLastErrorDesc: string;
    procedure SetDelayedOption(const Value: TSynaOption);
    procedure DelayedOption(const Value: TSynaOption);
    procedure ProcessDelayedOptions;
    procedure InternalCreateSocket(Sin: TVarSin);
    procedure SetSin(var Sin: TVarSin; IP, Port: string);
    function GetSinIP(Sin: TVarSin): string;
    function GetSinPort(Sin: TVarSin): Integer;
    procedure DoStatus(Reason: THookSocketReason; const Value: string);
    procedure DoReadFilter(Buffer: TMemory; var Len: Integer);
    procedure DoWriteFilter(Buffer: TMemory; var Len: Integer);
    procedure DoCreateSocket;
    procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: ULong);
    procedure SetBandwidth(Value: Integer);
    function TestStopFlag: Boolean;
  public
    constructor Create;

    {:Create object and load all necessary socket library. What library is
     loaded is described by STUB parameter. If STUB is empty string, then is
     loaded default libraries.}
    constructor CreateAlternate(Stub: string);
    destructor Destroy; override;

    {:If @link(family) is not SF_Any, then create socket with type defined in
     @link(Family) property. If family is SF_Any, then do nothing! (socket is
     created automaticly when you know what type of socket you need to create.
     (i.e. inside @link(Connect) or @link(Bind) call.) When socket is created,
     then is aplyed all stored delayed socket options.}
    procedure CreateSocket;

    {:It create socket. Address resolving of Value tells what type of socket is