rascomp32.~pas

DELIPHI编写的小程序

unit rascomp32;

{-----------------------------------------------------
DELPHI RAS COMPONENT - version 3.0 - 17th March 1999
(C) 1996 Daniel Polistchuck and 1999 Magenta Systems Ltd

Updated by Angus Robertson, Magenta Systems Ltd, England
in 1999, [e-mail], http://www.magsys.co.uk/delphi/
Copyright Magenta Systems Ltd

Compatible with Delphi 2, 3 and 4, Windows 95, 98 and NT 4.0.

TRAS is an installable Delphi non-visual component, supplied with
full source and a demo program, for accessing Dial Up Networking
or Remote Access Services functions.  This is an updated version of
Daniel Polistchuck's and Mike Armstrong's earlier component.

It adds support for phone books including DUN password update,
using existing connections, NT compatible, improved events and
progress messages, on demand DLL loading to allow application use
without RAS installed, connection IP addressed, performance
statistics for Win95/98/NT showing data transmitted and received.

A new demo program illustrates nearly all the methods and properties.
By using TRAS, it is not necessary to understand any of the RAS APIs
or structures.

Since TRAS does need design time properties, it need not really be
installed as such, but may be created in the application as needed,
as shown in the demo program.


Known Problems
--------------

Please note that getting performance statistics from Windows 95/98 can
sometimes be difficult.  This component now searches the registry for any
Dial-Up Adaptors and will default to the first found.  If there are two or
more adaptors installed, I'm not currently sure how to determine which is
being used, but a list is returned and a property may be changed to select
one. To get performance statistics running, make sure that Connection
Properties, Server Types, Record a Log File is ticked, and in Modem
Properties, Options, Display Modem Status is ticked.  You may need to
reboot after these changes and then make a connection, at which point the
correct registry keys should be created.  Users have reported difficulties
geting performance statistics from DUN version earlier than 1.2, so this
is recommended.

It does not appear to be possible to get Multilink (ISDN dual channel) info
from the structures under Win95/98, despite DUN 1.2 supporting this stuff.



Distribution
------------

TRAS may be freely distributed via web pages, FTP sites, BBS and
conferencing systems or on CD-ROM in unaltered zip format, but no charge
may be made other than reasonable media or bandwidth cost.

TRAS may be used freely in Delphi applications, but it would be polite to 
mention in the documentation that your application is using "TRAS from 
Daniel Polistchuck and Magenta Systems Ltd".  Please email Magenta Systems 
Ltd at [e-mail] if you use TRAS in some way, so you can be 
notified of upgrades or other important changes.
            
Magenta Systems Ltd uses TRAS in its DUN Manager and CamCollect 
applications that may be found at http://www.magsys.co.uk/ so if you
want to support the effort that has gone into enhancing and testing this 
component, please look at one or both of those applications and register 
them.


------------------------------------------------------------------------

Updated in 1998 by Angus Robertson, Magenta Systems Ltd, England

Added various functions:
IntDisConnect		- disconnect without error handling
AutoConnect			- GetDialParams, then Connect
LeaveOpen			- stops disconnection when component destroyed
ReOpen				- access an existing connection
GetDialParams		- read phone book logon and password
SetDialParams		- write phone book logon and password
MessText			- gets description for CurrentState
TestRAS				- see if RAS available
EditPhonebook		- displays a dialog to edit a connection
CreatePhonebook		- displays a dialog to create a connection
DeletePhonebook		- deletes a connection
CreatePhonebook		- renames a connection
StateChanged		- event called whenever RAS status changes
ResetPerfStats		- resets the performance counters
EnablePerfStats		- enable performance counters
GetPerfStats		- get current performance counters
GetEntryProperties  - read connection properties (dial number etc), note
                        that not all are processed yet)
GetConnection       - check for existing connection and get name

Other minor changes include:

Improved error handling
StateChanged event handles all progress messages
Get RAS username and password, access phone books
Only call functions if DLL is loaded so application will run without RAS installed
When disconnecting, wait until it happens
Added more progress messages
Error during connection now reported properly
Improved connection progress literals
Corrected a major memory leak in TConnectionList.Clear

Changes in 2.6
Win95/98 performance stats needs registry settings that may be translated
or change, so added search option to EnablePerfStats which will set the
first Dial Up Adaptor found listed

Changes in 2.7
Ensure ConnectState cleared during disconnection so application does not
   think we are still on-line
Increased maximum number of phone book entries from 20 to 100

Changes in 2.8
Supported multi-link connections, using RASSUBENTRY - NT4 only
Changed compiler directive so that programs compiled under NT4 will
  only use the Win9x structures for backward compatibility

Changes in 2.9
Added PhoneCanonical property which is completed from Phonebook with
  full canonical number that may be passed to TAPI lineTranslateAddress to
  create a diallable number for Connect
Clear DialParams if request fails
Ensure RASAPI_Loaded cleared during destroy, so RAS can be used again
Close both libraries

Changes in 3.0
Added GetDeviceList to fill DeviceTypeList and DeviceNameList with RAS TAPI devices
Added DevicePort property, NT only for phonebooks
Corrected canonical number where area code is blank

WARNING - you need to use the TAPI APIs and lineTranslateAddress in particular
to translate the canonical number to a dialable number using defined dialling
preferences - otherwise add stuff like P, T or *40 to the front of the dialable
number

}


interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ras_api32, WinPerf;

const
  MaxConnections = 4;
  MaxPhonebooks = 100 ;
  MaxDevices = 30 ;

type
  TConnectionList = class(TList)
	function AddConnection(Connection: TRASConn): Word;
	function RASConn(Index: Integer): HRASConn;
	function EntryName(Index: Integer): String;
    procedure Clear ;
	procedure Delete(Index: Integer);
  end;

  TRasStateEvent = Procedure( Sender: TObject; Error: Longint; ErrorString: String) of Object;

  TRAS = class(TComponent)
  private
	{ Private declarations }
	FEntryName,
	FPhoneNumber,
	FPhoneBookPath,
	FCallbackNumber,
	FUserName,
	FPassword,
	FDomain,
	FDeviceType,
	FClientIP,
	FServerIP,
	FDeviceName,
    FDevicePort: String;    // Angus, 3.0

	FRedialAttempts: Integer;

	fOnCallback,
	fStateChanged,	// ANGUS
	fOnConnect,
	fAboutToOpenPort,
	fPortOpened,
	fAboutToConnDev,
	fDevConnected,
	fAllDevsConnected,
	fAuthenticate,
	fAuthNotify,
	fAuthRetry,
	fAuthCallBack,
	fAuthChangePassword,
	fAuthProject,
	fAuthLinkSpeed,
	fAuthAck,
	fReAuthenticate,
	fAuthenticated,
	fPrepareforCallback,
	fWaitForModemReset,
	fInteractiveStarted,
	fRetryAuth,
	fPasswordExpired : TNotifyEvent;

	fOnDisconnect : TRasStateEvent;
	fWindowHandle: HWND;
	RASEvent: Word;
	RASLib : THandle ;
	RASxlib: THandle ;
	RASDialParams: TRASDialParams;
	RASAPI_Loaded: Boolean ; 	//See if DLL functions are loaded
	RASExtn_Flag: Boolean ; 		//See if extensions are available

// Angus - more useful things
    FLastError: LongInt;
	FRASConn: HRASConn;	{ Connection handle}
	FConnectState: Word;
    FSavedState: Word ;
    FConnectError: Word ;
	FStatusStr: String ;
    FCurConnName: String ;   // reported by RasEnumConnections
    FNumConns: Dword ;       // reported by RasEnumConnections
    fCurRASConn: HRASConn;   // reported by RasEnumConnections
	FPhoneCanonical: string ;  // formatted phone number for TAPI lineTranslateAddress

// Angus - performance statistics variables
	fStatsXmitTot: DWord ;
	fStatsXmitCon: DWord ;
	fStatsRecvTot: DWord ;
	fStatsRecvCon: DWord ;
	fStatsXmitCur: integer ;
	fStatsRecvCur: integer ;
	fStatsConnSpd: integer ;
    fKeyDUNAdap: string ;
    fKeyDUNConn: string ;
    fKeyDUNXmit: string ;
    fKeyDUNRecv: string ;

	procedure SetPhoneBookPath(Value: String);
	procedure StateChanged;	// ANGUS
	procedure Connected;
	procedure DisConnected;
	procedure WaitingForCallBack;
	procedure AboutToOpenPort;
	procedure PortOpened;
	procedure AboutToConnDev;
	procedure DevConnected;
	procedure AllDevsConnected;
	procedure Authenticate;
	procedure AuthNotify;
	procedure AuthRetry;
	procedure AuthCallBack;
	procedure AuthChangePassword;
	procedure AuthProject;
	procedure AuthLinkSpeed;
	procedure AuthAck;
	procedure ReAuthenticate;
	procedure Authenticated;
	procedure PrepareforCallback;
	procedure WaitForModemReset;
	procedure InteractiveStarted;
	procedure RetryAuth;
	procedure PasswordExpired;
	Procedure SetRedialAttempts( Value: Integer );
	function LoadRASAPI: boolean ;
	procedure MoveDialParms ;

	procedure WndProc(var Msg: TMessage);
  protected
	{ Protected declarations }
	RASConnect: Array[1..MaxConnections] OF TRASConn;
  public
	{ Public declarations }
	PhoneBookEntries: TStringList;
	Connections: TConnectionList;
    DialUpAdaptors: TStringList ;
	DeviceTypeList: TStringList;    // 3.0 Angus
	DevicePortList: TStringList;    // 3.0 Angus
	DeviceNameList: TStringList;    // 3.0 Angus

	CONSTRUCTOR Create(AOwner: TComponent); OVERRIDE;
	DESTRUCTOR Destroy; override;
	FUNCTION GetConnectStatus: LongInt;
	FUNCTION DisConnect: LongInt;
	FUNCTION GetErrorString(ErrorCode: LongInt): String;
	FUNCTION Connect: LongInt;
	FUNCTION CurrentStatus: String;
	FUNCTION GetConnections: LongInt;
	FUNCTION GetPhoneBookEntries: LongInt;
	function IntDisConnect: LongInt; { Used internally to bypass fOnDisconnect }
	FUNCTION AutoConnect: LongInt;		 // ANGUS
	FUNCTION LeaveOpen: LongInt;		// ANGUS
	FUNCTION ReOpen (item: integer) : LongInt;  // ANGUS
	FUNCTION GetDialParams: longInt;	// ANGUS
	FUNCTION SetDialParams: longInt;	// ANGUS
	function MessText: String ;			// ANGUS
	function TestRAS: boolean ;			// ANGUS
	function EditPhonebook: LongInt ; 	// ANGUS
	function CreatePhonebook: LongInt ;	// ANGUS
	function DeletePhonebook: LongInt ;	// ANGUS
	function RenamePhonebook (newname: string): LongInt ;  	// ANGUS
	function ValidateName (newname: string): LongInt ;		// ANGUS
	function GetIPAddress: LongInt;		// ANGUS
	procedure ResetPerfStats ;			// ANGUS
	function EnablePerfStats (start, search: boolean): boolean ;  // ANGUS
	function GetPerfStats: boolean ;	 // ANGUS
    function GetEntryProperties: LongInt ;  // ANGUS
 	function GetConnection: String ;     // ANGUS
    function SearchDUA: boolean ;        // ANGUS
	function GetDeviceList: LongInt ;    // 3.0 Angus

  PUBLISHED
	{ Published declarations }
	PROPERTY EntryName:	String		  read fEntryName write fEntryName;
	PROPERTY PhoneNumber: String	  read fPhoneNumber write fPhoneNumber;
	PROPERTY PhoneBookPath:  String	  read fPhoneBookPath write SetPhoneBookPath;
	PROPERTY CallbackNumber: String	  read fCallbackNumber write fCallbackNumber;
	PROPERTY UserName:	String		  read fUserName write fUserName;
	PROPERTY Password:	String		  read fPassword write fPassword;
	PROPERTY RedialAttempts: Integer  read FRedialAttempts write SetRedialAttempts default 1;
	PROPERTY Domain:	  String	  read fDomain write fDomain;
	PROPERTY DeviceType:  String	  read fDeviceType write fDeviceType;
	PROPERTY DeviceName:  String	  read fDeviceName write fDeviceName;
	PROPERTY DevicePort:  String	  read fDevicePort write fDevicePort;  // Angus 3.0

	PROPERTY ClientIP:    String	  read FClientIP ;		// ANGUS
	PROPERTY ServerIP:    String	  read FServerIP ;	 	// ANGUS
	PROPERTY StatsXmit:   Integer	  read fStatsXmitCur ;	// ANGUS
	PROPERTY StatsRecv:   Integer	  read fStatsRecvCur ;	// ANGUS
	PROPERTY StatsConn:   Integer	  read fStatsConnSpd ;	// ANGUS
	PROPERTY LastError:   LongInt     read fLastError ;     // Angus
	PROPERTY RASConn:     HRASConn    read fRASConn ;       // Angus
	PROPERTY ConnectState: Word       read fConnectState ;  // Angus
    PROPERTY SavedState:  Word        read fSavedState ;    // Angus
    PROPERTY ConnectError: Word       read fConnectError ;  // Angus
	PROPERTY StatusStr:   String      read fStatusStr write FStatusStr ;   // Angus
    PROPERTY CurConnName: String      read fCurConnName ;   // Angus
    PROPERTY NumConns: DWord          read fNumConns ;      // Angus
    PROPERTY CurRASConn: HRASConn     read fCurRASConn ;    // Angus
	PROPERTY PhoneCanonical: string	  read FPhoneCanonical ;  // Angus

	PROPERTY KeyDUNAdap: String	      read fKeyDUNAdap write fKeyDUNAdap ; // ANGUS
	PROPERTY KeyDUNConn: String	      read fKeyDUNConn write fKeyDUNConn ; // ANGUS
	PROPERTY KeyDUNXmit: String	      read fKeyDUNXmit write fKeyDUNXmit ; // ANGUS
	PROPERTY KeyDUNRecv: String	      read fKeyDUNRecv write fKeyDUNRecv ; // ANGUS

	PROPERTY OnStateChanged:  	TNotifyEvent	read fStateChanged write fStateChanged;
	PROPERTY OnConnect:	TNotifyEvent	read fOnconnect write fOnConnect;
	PROPERTY OnDisconnect: TRasStateEvent read fOnDisconnect write fOnDisconnect;
	PROPERTY OnCallBack:	TNotifyEvent	read fOnCallBack write fOnCallBack;
	PROPERTY OnAboutToOpenPort:TNotifyEvent read fAboutToOpenPort write fAboutToOpenPort;
	PROPERTY OnPortOpened:	 TNotifyEvent read fPortOpened write fPortOpened;
	PROPERTY OnAboutToConnDev: TNotifyEvent read fAboutToConnDev write fAboutToConnDev;
	PROPERTY OnDevConnected:	TNotifyEvent read fAllDevsConnected write fAllDevsConnected;
	PROPERTY OnAllDevsConnected: TNotifyEvent read fAllDevsConnected write fAllDevsConnected;
	PROPERTY OnAuthenticate:	TNotifyEvent read fAuthenticate write fAuthenticate;
	PROPERTY OnAuthNotify:	 TNotifyEvent read fAuthNotify write fAuthNotify;
	property OnAuthRetry:	  TNotifyEvent read fAuthRetry write fAuthRetry;
	property OnAuthCallBack:	TNotifyEvent read fAuthCallBack write fAuthCallBack;
	property OnAuthChangePassword: TNotifyEvent read fAuthChangePassword write fAuthChangePassword;
	property OnAuthProject:	TNotifyEvent read fAuthProject write fAuthProject;
	property OnAuthLinkSpeed:  TNotifyEvent read fAuthLinkSpeed write fAuthLinkSpeed;
	property OnAuthAck:		TNotifyEvent read fAuthAck write fAuthAck;
	property OnReAuthenticate: TNotifyEvent read fReAuthenticate write fReAuthenticate;
	property OnAuthenticated:  TNotifyEvent read fAuthenticated write fAuthenticated;
	property OnPrepareforCallback: TNotifyEvent read fPrepareforCallback write fPrepareforCallback;
	property OnWaitForModemReset:  TNotifyEvent read fWaitForModemReset write fWaitForModemReset;
	property OnInteractiveStarted: TNotifyEvent read fInteractiveStarted write fInteractiveStarted;
	property OnRetryAuth:		TNotifyEvent read fRetryAuth write fRetryAuth;
	property OnPasswordExpired: TNotifyEvent read fPasswordExpired write fPasswordExpired;
  end;

procedure Register;

implementation

var
  datasize: integer = 0 ;   // performance data buffer size

const

  TOTALBYTES =  8192 ;    // initial buffer size for NT performance data
  BYTEINCREMENT = 1024 ;  // make it bigger

// NT performance counter identifiers, assume they are fixed data
  Pdata_RAS_Total   = '906' ;
  Pdata_Bytes_Xmit  = 872 ;
  Pdata_Bytes_Recv  = 874 ;
  // connect speed is not available on NT, get it from TAPI instead

// keys and names for Win9x performance statistics under HKEY_DYN_DATA
  Reg_PerfStatStart 	= 'PerfStats\StartStat';
  Reg_PerfStatData 		= 'PerfStats\StatData';
  Reg_PerfStatStop 		= 'PerfStats\StopStat';
  Reg_PerfAdap 			= 'Dial-Up Adapter' ;
  Reg_PerfXmit 			= 'TotalBytesXmit' ;
  Reg_PerfRecv 			= 'TotalBytesRecvd' ;
  Reg_PerfConn 			= 'ConnectSpeed' ;

  Reg_PerfStatEmum   = 'System\CurrentControlSet\Control\PerfStats\Enum' ;

{ other keys... Win9x only
Dial-Up Adapter #2\
"Dial-Up Adapter\Buffer"
"Dial-Up Adapter\Framing"
"Dial-Up Adapter\Overrun "
"Dial-Up Adapter\Alignment"
"Dial-Up Adapter\Timeout"
"Dial-Up Adapter\CRC"
"Dial-Up Adapter\Runts"
"Dial-Up Adapter\FramesXmit"
"Dial-Up Adapter\FramesRecvd"
"Dial-Up Adapter\BytesXmit"	these are the same as Total
"Dial-Up Adapter\BytesRecvd"	}


procedure Register;
begin
	RegisterComponents('Samples', [TRAS]);
end;


{ ********************************************************************* }
{							TConnectionList							 }
{ ********************************************************************* }
function TConnectionList.AddConnection(Connection: TRASConn): Word;
var
	Conn: PRASConn;
begin
	Conn := New(PRASConn);
	Conn^ := Connection;
	Add(Conn);
end;

function TConnectionList.RASConn(Index: Integer): HRASConn;
begin
	Result := PRASConn(Items[Index])^.RASConn;
end;