adwnport.pas

Async Professional 4.04

{*********************************************************}
{*                   ADWNPORT.PAS 4.04                   *}
{*      Copyright (C) TurboPower Software 1997-2002      *}
{*                 All rights reserved.                  *}
{*********************************************************}

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

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

unit AdWnPort;
  { -Winsock comport component }

interface

uses
  {-----RTL}
  Messages,
  SysUtils,
  Classes,
  Forms,
  WinTypes,
  WinProcs,
  OoMisc,
  AwUser,
  AwWnSock,
  AdSocket,
  AdWUtil,
  AdExcept,
  AdPort,
  AdPacket;

const
  adwDefWsMode = WsClient;
  adwDefWsPort = 'telnet';
  adwDefWsTelnet = True;

type

{$IFNDEF Apax}
  { This is also declared in ADWUTIL.PAS -- it's included here to support }
  { the OnAccept event -- both type declarations should be identical }
  PInAddr = ^TInAddr;
  TInAddr = packed record
    case Integer of
      0 : (S_un_b : SunB);
      1 : (S_un_w : SunW);
      2 : (S_addr : LongInt);
  end;
{$ENDIF}

  TApdSocksVersion = (svNone, svSocks4, svSocks4a, svSocks5);

  TApdSocksServerInfo = class (TPersistent)
    private
      FAddress      : string;
      FPassword     : string;
      FPort         : Word;
      FSocksVersion : TApdSocksVersion;
      FUserCode     : string;
      
    protected
      procedure SetAddress (v : string);
      procedure SetPassword (v : string);
      procedure SetPort (v : Word);
      procedure SetSocksVersion (v : TApdSocksVersion);
      procedure SetUserCode (v : string);
      
    public
      constructor Create; 
      
    published
      property Address : string read FAddress write SetAddress;
      property Password : string read FPassword write SetPassword;
      property Port : Word read FPort write SetPort;
      property SocksVersion : TApdSocksVersion
               read FSocksVersion write SetSocksVersion default svNone;
      property UserCode : string read FUserCode write SetUserCode;
  end;

  TWsAcceptEvent = procedure(Sender : TObject; Addr : TInAddr;
                             var Accept : Boolean) of object;
  TWsErrorEvent = procedure(Sender : TObject; ErrCode : Integer) of object;


  {Custom Port component}
  TApdCustomWinsockPort = class(TApdCustomComPort)
  protected {private}
    { Property Support }
    FOnWsAccept : TWsAcceptEvent;
    FOnWsConnect : TNotifyEvent;
    FOnWsDisconnect : TNotifyEvent;
    FOnWsError : TWsErrorEvent;
    FWsAddress : string;
    FWsMode : TWsMode;
    FWsPort : string;
    FWsTelnet : Boolean;
    FSockInstance : TFarProc;
    FComWindowProc : Pointer;
    FWsLocalAddresses : TStringList;
    FWsLocalAddressIndex : Integer;
    FWsSocksServerInfo : TApdSocksServerInfo;
    FConnectPacket : TApdDataPacket;
    FSocksComplete : Boolean;
    FTimer : Integer;

  protected
    function ActivateDeviceLayer : TApdBaseDispatcher; override;
    procedure DeviceLayerChanged; override;
    function  DoAccept(Addr : LongInt) : Boolean; virtual;
    procedure DoConnect; virtual;
    procedure DoDisconnect; virtual;
    procedure DoError(ErrCode : Integer); virtual;
    procedure EnumHostAddresses;
    function  InitializePort : Integer; override;
    procedure PortOpen; override;
    procedure PortClose; override;
    procedure ValidateComport; override;
    procedure SetUseMSRShadow(NewUse : Boolean); override;
    procedure SetWsAddress(Value : string);
    procedure SetWsLocalAddresses (Value : TStringList);
    function GetWsLocalAddresses: TStringList;                           {!!.04}
    procedure SetWsLocalAddressIndex (Value : Integer);
    procedure SetWsMode(Value : TWsMode);
    procedure SetWsPort(Value : string);
    procedure SockWndProc(var Message : TMessage);
    function OpenSocksConnection : Integer;
    function OpenSocksSocket : Integer;
    procedure ContinueSocksNegotiation;
    procedure ConnectToSocks4;
    procedure ConnectToSocks4a;
    procedure ConnectToSocks5;
    procedure EnableSocks4Reply;
    procedure EnableSocks5Reply;
    procedure EnableSocks5UserNameReply;
    procedure EnableSocks5RequestReply;
    procedure EnableSocks5RequestEndReply (Len : Integer);
    procedure SendSocks5UserName;
    procedure SendSocks5Request;
    procedure Socks4Packet (Sender : TObject; Data : Pointer; Size : Integer);
    procedure Socks5Packet (Sender : TObject; Data : Pointer; Size : Integer);
    procedure Socks5UserNamePacket (Sender : TObject; Data : Pointer;
                                    Size : Integer);
    procedure Socks5RequestPacket (Sender : TObject; Data : Pointer;
                                   Size : Integer);
    procedure Socks5RequestEndPacket (Sender : TObject; Data : Pointer;
                                      Size : Integer);

  public
    property WsAddress : string read FWsAddress write SetWsAddress;
    property WsLocalAddresses : TStringList
             read GetWsLocalAddresses write SetWsLocalAddresses;         {!!.04}
    property WsLocalAddressIndex : Integer
             read FWsLocalAddressIndex write SetWsLocalAddressIndex;
    property WsMode : TWsMode read FWsMode write SetWsMode default adwDefWsMode;
    property WsPort : string read FWsPort write SetWsPort;
    property WsSocksServerInfo : TApdSocksServerInfo
             read FWsSocksServerInfo write FWsSocksServerInfo;
    property WsTelnet : Boolean read FWsTelnet write FWsTelnet default adwDefWsTelnet;

    property OnWsAccept : TWsAcceptEvent read FOnWsAccept write FOnWsAccept;
    property OnWsConnect : TNotifyEvent read FOnWsConnect write FOnWsConnect;
    property OnWsDisconnect : TNotifyEvent read FOnWsDisconnect write FOnWsDisconnect;
    property OnWsError : TWsErrorEvent read FOnWsError write FOnWsError;

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


  {Port component}
  TApdWinsockPort = class(TApdCustomWinsockPort)
  published
    { Properties }
    property WsAddress;
    property WsLocalAddresses;
    property WsLocalAddressIndex;
    property WsMode;
    property WsPort;
    property WsSocksServerInfo;
    property WsTelnet;

    { Inherited Properties }
    property AutoOpen;
    property Baud;
    property BufferFull;
    property BufferResume;
    property CommNotificationLevel;
    property ComNumber;
    property DataBits;
    property DeviceLayer;
    property DTR;
    property HWFlowOptions;
    property InSize;
    property RS485Mode;
    property TraceAllHex;                                                {!!.04}                                           
    property Tracing;
    property TraceSize;
    property TraceName;
    property TraceHex;
    property LogAllHex;                                                  {!!.04}
    property Logging;
    property LogSize;
    property LogName;
    property LogHex;
    property Open;
    property OutSize;
    property Parity;
    property PromptForPort;                                              {!!.04}
    property RTS;
    property StopBits;
    property SWFlowOptions;
    property Tag;
    property TapiMode;
    property UseEventWord;
    property UseMSRShadow;
    property XOffChar;
    property XOnChar;

    { Events }
    property OnWsAccept;
    property OnWsConnect;
    property OnWsDisconnect;
    property OnWsError;
    property OnTrigger;
    property OnTriggerAvail;
    property OnTriggerData;
    property OnTriggerStatus;
    property OnTriggerTimer;
    property OnTriggerLineError;
    property OnTriggerModemStatus;
    property OnTriggerOutbuffFree;
    property OnTriggerOutbuffUsed;
    property OnTriggerOutSent;
    property OnWaitChar;
  end;


implementation

{$IFDEF TRIALRUN}
  {$I TRIAL07.INC}
  {$I TRIAL03.INC}
  {$I TRIAL01.INC}
{$ENDIF}

constructor TApdSocksServerInfo.Create;
begin
  inherited Create;

  FSocksVersion := svNone;
end;

procedure TApdSocksServerInfo.SetAddress (v : string);
begin
  if v <> FAddress then
    FAddress := v;
end;

procedure TApdSocksServerInfo.SetPassword (v : string);
begin
  if v <> FPassword then
    FPassword := v;
end;

procedure TApdSocksServerInfo.SetPort (v : Word);
begin
  if v <> FPort then
    FPort := v;
end;

procedure TApdSocksServerInfo.SetSocksVersion (v : TApdSocksVersion);
begin
  if v <> FSocksVersion then
    FSocksVersion := v;
end;

procedure TApdSocksServerInfo.SetUserCode (v : string);
begin
  if v <> FUserCode then
    FUserCode := v;
end;

constructor TApdCustomWinsockPort.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FDeviceLayers := FDeviceLayers + [dlWinsock];
  FWsPort := adwDefWsPort;
  FWsTelnet := adwDefWsTelnet;

  FWsSocksServerInfo := TApdSocksServerInfo.Create;

  FWsLocalAddresses := TStringList.Create;
  EnumHostAddresses;
end;

destructor TApdCustomWinsockPort.Destroy;
begin
  FWsLocalAddresses.Free;
  FWsSocksServerInfo.Free;

  inherited Destroy;
end;

function TApdCustomWinsockPort.ActivateDeviceLayer : TApdBaseDispatcher;
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
begin
  if DeviceLayer = dlWinsock then
    Result := TApdWinSockDispatcher.Create(Self)
  else
    Result := inherited ActivateDeviceLayer;
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
end;                   

procedure TApdCustomWinsockPort.DeviceLayerChanged;
begin
  if DeviceLayer = dlWinsock then begin
    TapiMode := tmOff;
    FUseMSRShadow := False;
  end else
    TapiMode := tmAuto;
end;