idtunnelmaster.pas

Indy控件的使用源代码

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10403: IdTunnelMaster.pas 
{
{   Rev 1.0    2002.11.12 10:58:30 PM  czhower
}
unit IdTunnelMaster;

interface

uses
  Classes, SyncObjs,
  IdTCPServer, IdTCPClient, IdTunnelCommon;

type
  TIdTunnelMaster = class;

  ///////////////////////////////////////////////////////////////////////////////
  // Master Tunnel classes
  //
  // Thread to communicate with the service
  MClientThread = class(TThread)
  public
    MasterParent: TIdTunnelMaster;
    UserId: Integer;
    MasterThread: TIdPeerThread;
    OutboundClient: TIdTCPClient;
    DisconnectedOnRequest: Boolean;
    Locker: TCriticalSection;
    SelfDisconnected: Boolean;

    procedure Execute; override;
    constructor Create(AMaster: TIdTunnelMaster);
    destructor Destroy; override;
  end;

  // Slave thread - communicates with the Master, tunnel
  TSlaveData = class(TObject)
  public
    Receiver: TReceiver;
    Sender: TSender;
    Locker: TCriticalSection;
    SelfDisconnected: Boolean;
    UserData: TObject;
  end;

  TIdSendMsgEvent  = procedure(Thread: TIdPeerThread; var CustomMsg: String) of object;
  TIdSendTrnEvent  = procedure(Thread: TIdPeerThread; var Header: TIdHeader; var CustomMsg: String) of object;
  TIdSendTrnEventC = procedure(var Header: TIdHeader; var CustomMsg: String) of object;
  TIdTunnelEventC  = procedure(Receiver: TReceiver) of object;
  TIdSendMsgEventC = procedure(var CustomMsg: String) of object;
//  TTunnelEvent   = procedure(Thread: TSlaveThread) of object;

  TIdTunnelMaster = class(TIdTCPServer)
  protected
    fiMappedPort: Integer;
    fsMappedHost: String;
    Clients: TThreadList;
    fOnConnect,
    fOnDisconnect,
    fOnTransformRead: TIdServerThreadEvent;
    fOnTransformSend: TSendTrnEvent;
    fOnInterpretMsg: TSendMsgEvent;
    OnlyOneThread: TCriticalSection;

    // LockSlavesNumber: TCriticalSection;
    //LockServicesNumber: TCriticalSection;
    StatisticsLocker: TCriticalSection;
    fbActive: Boolean;
    fbLockDestinationHost: Boolean;
    fbLockDestinationPort: Boolean;
    fLogger: TLogger;

    // Statistics counters
    flConnectedSlaves,            // Number of connected slave tunnels
    flConnectedServices,          // Number of connected service threads
    fNumberOfConnectionsValue,
    fNumberOfPacketsValue,
    fCompressionRatioValue,
    fCompressedBytes,
    fBytesRead,
    fBytesWrite: Integer;
    procedure ClientOperation(Operation: Integer; UserId: Integer; s: String);
    procedure SendMsg(MasterThread: TIdPeerThread; var Header: TIdHeader; s: String);
    procedure DisconectAllUsers;
    procedure DisconnectAllSubThreads(TunnelThread: TIdPeerThread);
    function  GetNumSlaves: Integer;
    function  GetNumServices: Integer;
    function GetClientThread(UserID: Integer): MClientThread;
    procedure SetActive(pbValue: Boolean); override;
    procedure DoConnect(Thread: TIdPeerThread); override;
    procedure DoDisconnect(Thread: TIdPeerThread); override;
    function DoExecute(Thread: TIdPeerThread): boolean; override;
    procedure DoTransformRead(Thread: TIdPeerThread); virtual;
    procedure DoTransformSend(Thread: TIdPeerThread; var Header: TIdHeader; var CustomMsg: String);
     virtual;
    procedure DoInterpretMsg(Thread: TIdPeerThread; var CustomMsg: String); virtual;
    procedure LogEvent(Msg: String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure SetStatistics(Module: Integer; Value: Integer);
    procedure GetStatistics(Module: Integer; var Value: Integer);

    property Active: Boolean read FbActive write SetActive Default True;
    property Logger: TLogger read fLogger write fLogger;
    property NumSlaves: Integer read GetNumSlaves;
    property NumServices: Integer read GetNumServices;
  published
    property MappedHost: string read fsMappedHost write fsMappedHost;
    property MappedPort: Integer read fiMappedPort write fiMappedPort;
    property LockDestinationHost: Boolean read fbLockDestinationHost write fbLockDestinationHost
     default False;
    property LockDestinationPort: Boolean read fbLockDestinationPort write fbLockDestinationPort
     default False;
    property OnConnect: TIdServerThreadEvent read FOnConnect write FOnConnect;
    property OnDisconnect: TIdServerThreadEvent read FOnDisconnect write FOnDisconnect;
    property OnTransformRead: TIdServerThreadEvent read fOnTransformRead write fOnTransformRead;
    property OnTransformSend: TSendTrnEvent read fOnTransformSend write fOnTransformSend;
    property OnInterpretMsg: TSendMsgEvent read fOnInterpretMsg write fOnInterpretMsg;
  end;
  //
  // END Master Tunnel classes
  ///////////////////////////////////////////////////////////////////////////////


implementation
  uses IdException,
       IdGlobal, IdStack, IdResourceStrings, SysUtils;


///////////////////////////////////////////////////////////////////////////////
// Master Tunnel classes
//
constructor TIdTunnelMaster.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Clients := TThreadList.Create;

  fbActive := False;
  flConnectedSlaves := 0;
  flConnectedServices := 0;

  fNumberOfConnectionsValue := 0;
  fNumberOfPacketsValue := 0;
  fCompressionRatioValue := 0;
  fCompressedBytes := 0;
  fBytesRead := 0;
  fBytesWrite := 0;

  OnlyOneThread := TCriticalSection.Create;
  StatisticsLocker := TCriticalSection.Create;
end;

destructor TIdTunnelMaster.Destroy;
begin
  Logger := nil;
  Active := False;
  if (csDesigning in ComponentState) then begin
    DisconectAllUsers; // disconnects service threads
  end;

  FreeAndNil(Clients);
  FreeAndNil(OnlyOneThread);
  FreeAndNil(StatisticsLocker);

  inherited Destroy;
end;


procedure TIdTunnelMaster.SetActive(pbValue: Boolean);
begin
  if fbActive = pbValue then
    exit;

//  if not ((csLoading in ComponentState) or (csDesigning in ComponentState)) then begin
  if pbValue then begin
    inherited SetActive(True);
  end
  else begin
    inherited SetActive(False);
    DisconectAllUsers; // also disconnectes service threads
  end;

//  end;
  fbActive := pbValue;
end;

procedure TIdTunnelMaster.LogEvent(Msg: String);
begin
  if Assigned(fLogger) then
    fLogger.LogEvent(Msg);
end;

function TIdTunnelMaster.GetNumSlaves: Integer;
var
  ClientsNo: Integer;
begin
  GetStatistics(NumberOfSlavesType, ClientsNo);
  Result := ClientsNo;
end;

function TIdTunnelMaster.GetNumServices: Integer;
var
  ClientsNo: Integer;
begin
  GetStatistics(NumberOfServicesType, ClientsNo);
  Result := ClientsNo;
end;

procedure TIdTunnelMaster.GetStatistics(Module: Integer; var Value: Integer);
begin
  StatisticsLocker.Enter;
  try
    case Module of
      NumberOfSlavesType: begin
         Value := flConnectedSlaves;
      end;

      NumberOfServicesType: begin
         Value := flConnectedServices;
      end;
    
      NumberOfConnectionsType: begin
        Value := fNumberOfConnectionsValue;
      end;

      NumberOfPacketsType: begin
        Value := fNumberOfPacketsValue;
      end;

      CompressionRatioType: begin
        if fCompressedBytes > 0 then begin
          Value := Trunc((fBytesRead * 1.0) / (fCompressedBytes * 1.0) * 100.0)
        end
        else begin
          Value := 0;
        end;
      end;

      CompressedBytesType: begin
         Value := fCompressedBytes;
      end;

      BytesReadType: begin
         Value := fBytesRead;
      end;

      BytesWriteType: begin
         Value := fBytesWrite;
      end;
    end;
  finally
    StatisticsLocker.Leave;
  end;
end;

procedure TIdTunnelMaster.SetStatistics(Module: Integer; Value: Integer);
var
  packets: Real;
  ratio: Real;
begin
  StatisticsLocker.Enter;
  try
    case Module of
      NumberOfSlavesType: begin
        if TIdStatisticsOperation(Value) = soIncrease then begin
          Inc(flConnectedSlaves);
        end
        else begin
          Dec(flConnectedSlaves);
        end;
      end;

      NumberOfServicesType: begin
        if TIdStatisticsOperation(Value) = soIncrease then begin
          Inc(flConnectedServices);
          Inc(fNumberOfConnectionsValue);
        end
        else begin
          Dec(flConnectedServices);
        end;
      end;

      NumberOfConnectionsType: begin
        Inc(fNumberOfConnectionsValue);
      end;

      NumberOfPacketsType: begin
        Inc(fNumberOfPacketsValue);
      end;

      CompressionRatioType: begin
        ratio := fCompressionRatioValue;
        packets := fNumberOfPacketsValue;
        ratio := (ratio/100.0 * (packets - 1.0) + Value/100.0) / packets;
        fCompressionRatioValue := Trunc(ratio * 100);
      end;

      CompressedBytesType: begin
        fCompressedBytes := fCompressedBytes + Value;
      end;

      BytesReadType: begin
        fBytesRead := fBytesRead + Value;
      end;

      BytesWriteType: begin
        fBytesWrite := fBytesWrite + Value;
      end;
    end;
  finally
    StatisticsLocker.Leave;
  end;
end;

procedure TIdTunnelMaster.DoConnect(Thread: TIdPeerThread);
begin

  Thread.Data := TSlaveData.Create;
  with TSlaveData(Thread.Data) do begin
    Receiver := TReceiver.Create;
    Sender := TSender.Create;
    SelfDisconnected := False;
    Locker := TCriticalSection.Create;
  end;
  if Assigned(OnConnect) then begin
    OnConnect(Thread);
  end;
  SetStatistics(NumberOfSlavesType, Integer(soIncrease));

end;


procedure TIdTunnelMaster.DoDisconnect(Thread: TIdPeerThread);
begin

  SetStatistics(NumberOfSlavesType, Integer(soDecrease));
  // disconnect all service threads, owned by this tunnel
  DisconnectAllSubThreads(Thread);
  if Thread.Connection.Connected then
    Thread.Connection.Disconnect;

  If Assigned(OnDisconnect) then begin
    OnDisconnect(Thread);
  end;

  with TSlaveData(Thread.Data) do begin
    Receiver.Free;
    Sender.Free;
    Locker.Free;
    TSlaveData(Thread.Data).Free;
  end;
  Thread.Data := nil;

end;


function TIdTunnelMaster.DoExecute(Thread: TIdPeerThread): boolean;
var
  user: TSlaveData;
  clientThread: MClientThread;
  s: String;
  ErrorConnecting: Boolean;
  sIP: String;
  CustomMsg: String;
  Header: TIdHeader;
begin
  result := true;

  user := TSlaveData(Thread.Data);
  if Thread.Connection.IOHandler.Readable(IdTimeoutInfinite) then  begin
    user.receiver.Data := Thread.Connection.CurrentReadBuffer;

    // increase the packets counter
    SetStatistics(NumberOfPacketsType, 0);

    while user.receiver.TypeDetected do begin
      // security filter
      if not (user.receiver.Header.MsgType in [tmData, tmDisconnect, tmConnect, tmCustom]) then begin
        Thread.Connection.Disconnect;