⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 adras.pas

📁 Async Professional 4.04
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{*********************************************************}
{*                    ADRAS.PAS 4.04                     *}
{*      Copyright (C) TurboPower Software 1996-2002      *}
{*                 All rights reserved.                  *}
{*********************************************************}

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

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

unit AdRas;
  {-Delphi remote access (RAS) dialer component}

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  ExtCtrls,
  Dialogs,
  AdRasUtl,
  OoMisc,
  AdExcept;

type {Enumerated type definitions}
  TApdRasDialMode        = (dmSync, dmAsync);
  TApdRasSpeakerMode     = (smDefault, smSpeakerOn, smSpeakerOff);
  TApdRasCompressionMode = (cmDefault, cmCompressionOn, cmCompressionOff);
  TApdRasDialOption      = (doPrefixSuffix, doPausedStates,
                            doDisableConnectedUI, doDisableReconnectUI,
                            doNoUser, doPauseOnScript);
  TApdRasDialOptions     = set of TApdRasDialOption;


type {Event handler prototypes}
  TApdRasStatusEvent    = procedure(Sender : TObject;
                                    Status : Integer) of object;
  TApdRasErrorEvent     = procedure(Sender : TObject;
                                    Error : Integer) of object;

type
  {Forwards}
  TApdAbstractRasStatus = class;

  {Custom RAS dialer component}
  TApdCustomRasDialer = class(TApdBaseComponent)
  protected {private}
    {internal variables}
    DialEventHandle  : HWND;
    DialEventMsg     : Word;
    DialExtensions   : TRasDialExtensions;
    EntryDialParams  : TRasDialParams;
    DialDlgInfo      : TRasDialDlgInfo;
    MonitorDlgInfo   : TRasMonitorDlgInfo;
    PhonebookDlgInfo : TRasPhonebookDlgInfo;
    DisconnectTimer  : TTimer;

    {property variables}
    FDialOptions     : TApdRasDialOptions;
    FDialMode        : TApdRasDialMode;
    FSpeakerMode     : TApdRasSpeakerMode;
    FCompressionMode : TApdRasCompressionMode;
    FPhonebook       : string;
    FEntryName       : string;
    FHangupOnDestroy : Boolean;
    FPhoneNumber     : string;
    FCallBackNumber  : string;
    FUserName        : string;
    FPassword        : string;
    FDomain          : string;
    FConnection      : THandle;
    FStatusDisplay   : TApdAbstractRasStatus;
    FPlatformID      : DWord;

    {event variables}
    FOnConnected     : TNotifyEvent;
    FOnDialStatus    : TApdRasStatusEvent;
    FOnDialError     : TApdRasErrorEvent;
    FOnDisconnected  : TNotifyEvent;

    {internal methods}
    function  AssembleDialExtensions : PRasDialExtensions;
    function  AssembleDialParams : PRasDialParams;
    procedure DialEventWindowProc(var Msg: TMessage);
    procedure DoOnDialError(Error : Integer);
    procedure DoOnDialStatus(Status : Integer);
    procedure DoOnConnected;
    procedure DoOnDisconnected;
    procedure DoDisconnectTimer(Sender : TObject);
    function  GetConnection : THandle;
    function  GetConnectState : Integer;
    function  GetDeviceName : string;
    function  GetDeviceType : string;
    function  GetFullConnectStatus(PRCS : PRasConnStatus) : Integer;
    function GetIsRasAvailable: Boolean;                                 {!!.01}
    procedure Notification(AComponent : TComponent;
                           Operation : TOperation); override;
    procedure SetEntryName(Value : string);

  protected {properties}
    property CallBackNumber : string
               read FCallBackNumber write FCallBackNumber;
    property CompressionMode : TApdRasCompressionMode
               read FCompressionMode write FCompressionMode;
    property DialMode : TApdRasDialMode
               read FDialMode write FDialMode;
    property DialOptions : TApdRasDialOptions
               read FDialOptions write FDialOptions;
    property Domain : string
               read FDomain write FDomain;
    property EntryName : string
               read FEntryName write SetEntryName;
    property HangupOnDestroy : Boolean
               read FHangupOnDestroy write FHangupOnDestroy;
    property Password : string
               read FPassword write FPassword;
    property Phonebook : string
               read FPhonebook write FPhonebook;
    property PhoneNumber : string
               read FPhoneNumber write FPhoneNumber;
    property SpeakerMode : TApdRasSpeakerMode
               read FSpeakerMode write FSpeakerMode;
    property StatusDisplay : TApdAbstractRasStatus
               read FStatusDisplay write FStatusDisplay;
    property UserName : string
               read FUserName write FUserName;

  protected {events}
    property OnConnected : TNotifyEvent
               read FOnConnected write FOnConnected;
    property OnDialStatus : TApdRasStatusEvent
               read FOnDialStatus write FOnDialStatus;
    property OnDialError : TApdRasErrorEvent
               read FOnDialError write FOnDialError;
    property OnDisconnected : TNotifyEvent
               read FOnDisconnected write FOnDisconnected;

  public {run-time properties}
    property Connection : THandle
               read GetConnection;
    property ConnectState : Integer
               read GetConnectState;
    property DeviceName : string
               read GetDeviceName;
    property DeviceType : string
               read GetDeviceType;
    property PlatformID : DWord
               read FPlatformID;
    property IsRasAvailable : Boolean                                    {!!.01}
               read GetIsRasAvailable;                                   {!!.01}

  public {methods}
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    function  CreatePhonebookEntry : Integer;
    function  DeletePhonebookEntry : Integer;
    function  Dial : Integer;
    function  DialDlg : Integer;
    function  EditPhonebookEntry : Integer;
    function  GetErrorText(Error : Integer) : string;
    function  GetStatusText(Status : Integer) : string;
    procedure Hangup;
    function  ListConnections(List : TStrings) : Integer;
    function  ListEntries(List : TStrings) : Integer;
    function  MonitorDlg : Integer;
    function  PhonebookDlg : Integer;
    function  GetDialParameters : Integer;
    function  SetDialParameters : Integer;
  end;

  {Abstract RAS status class}
  TApdAbstractRasStatus = class(TApdBaseComponent)
  protected {private}
    FCtl3D     : Boolean;
    FDisplay   : TForm;
    FPosition  : TPosition;
    FRasDialer : TApdCustomRasDialer;

  protected {methods}
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure SetCtl3D(Value : Boolean);
    procedure SetPosition(Value : TPosition);

  public {properties}
    property Display : TForm
      read FDisplay write FDisplay;

  public {methods}
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure CreateDisplay(const EntryName : string); dynamic; abstract;
    procedure DestroyDisplay; dynamic; abstract;
    procedure UpdateDisplay(const StatusMsg : string); virtual; abstract;

  published {properties}
    property Ctl3D : Boolean
      read FCtl3D write SetCtl3D;
    property Position : TPosition
      read FPosition write SetPosition;
    property RasDialer : TApdCustomRasDialer
      read FRasDialer write FRasDialer;
  end;


type {Ras dialer component}
  TApdRasDialer = class(TApdCustomRasDialer)
  published {properties}
    property CallBackNumber;
    property CompressionMode;
    property DialMode;
    property DialOptions;
    property Domain;
    property EntryName;
    property HangupOnDestroy;
    property OnConnected;
    property OnDialStatus;
    property OnDialError;
    property OnDisconnected;
    property Password;
    property Phonebook;
    property PhoneNumber;
    property SpeakerMode;
    property StatusDisplay;
    property UserName;
  end;

implementation

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

const
  RasBaseStatusString = 4500;


{ TApdCustomRasDialer }
constructor TApdCustomRasDialer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FDialMode := dmAsync;
  FConnection := 0;
  FEntryName := '';
  FHangupOnDestroy := True;
  DialEventMsg := RegisterWindowMessage(AdRasDialEvent);
  if (DialEventMsg = 0) then
    DialEventMsg := WM_RASDIALEVENT;
  DialEventHandle := AllocateHWnd(DialEventWindowProc);
  FPlatFormID := AdRasPlatformID;
  DisconnectTimer := TTimer.Create(Self);
  with DisconnectTimer do begin
    Name := 'ApdRasDiscTimer';
    Enabled := False;
    Interval := 1000;
    OnTimer := DoDisconnectTimer;
  end;
end;

destructor TApdCustomRasDialer.Destroy;
begin
  if Assigned(DisconnectTimer) then
    DisconnectTimer.Free;
  if not (csDesigning in ComponentState) then
    if HangupOnDestroy then
      try
        Hangup;
      except  { swallow any hangup errors }
      end;
  if (DialEventHandle <> 0) then
    DeallocateHWnd(DialEventHandle);
  inherited Destroy;
end;

function TApdCustomRasDialer.AssembleDialExtensions : PRasDialExtensions;
begin
  FillChar(DialExtensions, SizeOf(DialExtensions), #0);
  DialExtensions.dwSize := SizeOf(DialExtensions);
  with DialExtensions do begin
    if (doPrefixSuffix in FDialOptions) then
      dwfOptions := dwfOptions or deUsePrefixSuffix;
    if (doPausedStates in FDialOptions) then
      dwfOptions := dwfOptions or dePausedStates;
    if (doDisableConnectedUI in FDialOptions) then
      dwfOptions := dwfOptions or deDisableConnectedUI;
    if (doDisableReConnectUI in FDialOptions) then
      dwfOptions := dwfOptions or deDisableReconnectUI;
    if (doNoUser in FDialOptions) then
      dwfOptions := dwfOptions or deNoUser;
    if (doPauseOnScript in FDialOptions) then
      dwfOptions := dwfOptions or dePauseOnScript;

    if (FSpeakerMode <> smDefault) then begin
      dwfOptions := dwfOptions or deIgnoreModemSpeaker;
      if (FSpeakerMode = smSpeakerOn) then
        dwfOptions := dwfOptions or deSetModemSpeaker;
      {otherwise speaker is already off}
    end;

    if (FCompressionMode <> cmDefault) then begin
      dwfOptions := dwfOptions or deIgnoreSoftwareCompression;
      if (FCompressionMode = cmCompressionOn) then
        dwfOptions := dwfOptions or deSetSoftwareCompression;
      {otherwise SW compression is already off}
    end;
  end;
  Result := @DialExtensions;
end;

function TApdCustomRasDialer.AssembleDialParams : PRasDialParams;
begin
  FillChar(EntryDialParams, SizeOf(EntryDialParams), #0);
  with EntryDialParams do begin
    dwSize := SizeOf(EntryDialParams);
    StrPCopy(szEntryName, FEntryName);
    StrPCopy(szPhoneNumber, FPhoneNumber);
    StrPCopy(szCallbackNumber, FCallBackNumber);
    StrPCopy(szUserName, FUserName);
    StrPCopy(szPassword, FPassword);
    StrPCopy(szDomain, FDomain);
  end;
  Result := @EntryDialParams;
end;

function TApdCustomRasDialer.CreatePhonebookEntry : Integer;
begin
  Result := AdRasCreatePhonebookEntry(0, FPhonebook);
end;

function TApdCustomRasDialer.DeletePhonebookEntry : Integer;
begin
  Result := ecRasCannotFindPhonebookEntry;
  if (FEntryName <> '') then
    Result := AdRasDeleteEntry(FPhonebook, FEntryName);
end;

function TApdCustomRasDialer.Dial : Integer;
var
  hDialEvent : HWnd;
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
begin
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
  Hangup;
  if (FDialMode = dmAsync) then begin                                
    hDialEvent := DialEventHandle;
    if Assigned(FStatusDisplay) then                                 
      FStatusDisplay.CreateDisplay(FEntryName);                      
  end else
    hDialEvent := 0;
  FConnection := 0;
  Result := AdRasDial(AssembleDialExtensions, FPhonebook, AssembleDialParams,
    ntNotifyWindow, hDialEvent, FConnection);
  if (Result <> ecOK) then
    Hangup
  else
    DisconnectTimer.Enabled := True;
end;

function TApdCustomRasDialer.DialDlg : Integer;
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -