各位新年好，请拨号高手帮我解决一下(20分)

本人使用RASCMP3.0版本DEMO时无法拨上网，检查了不知道问题出在哪里？
不知道哪位帮我一下，多谢了！！！（见程序）
//RASCMP3.0DEMO程序:
unit demo;
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls,
Rascomp32, RAS_API32 ; // the main TRAS component and literals

type
TMainForm = class(TForm)
Status: TStatusBar;
ConnList: TListBox;
Label1: TLabel;
Timer: TTimer;
doCreateConn: TButton;
doEditConn: TButton;
ConnUser: TEdit;
ConnPw: TEdit;
Label2: TLabel;
Label3: TLabel;
doLogonUpdate: TButton;
doConnect: TButton;
doDisConn: TButton;
doExit: TButton;
Label4: TLabel;
doDeleteConn: TButton;
doRenameConn: TButton;
DeviceName: TLabel;
ConnPhone: TLabel;
Label7: TLabel;
ListDUA: TListBox;
Label8: TLabel;
Panel1: TPanel;
Label5: TLabel;
StatXmit: TLabel;
StatRecv: TLabel;
ConnSpeed: TLabel;
Label6: TLabel;
IPAddr: TLabel;
Memory: TLabel;
DeviceList: TListBox;
Label9: TLabel;
ConnCanonical: TLabel;
DeviceType: TLabel;
DevicePort: TLabel;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure doConnectClick(Sender: TObject);
procedure doDisConnClick(Sender: TObject);
procedure doCreateConnClick(Sender: TObject);
procedure doEditConnClick(Sender: TObject);
procedure doLogonUpdateClick(Sender: TObject);
procedure ConnListClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure doExitClick(Sender: TObject);
procedure doDeleteConnClick(Sender: TObject);
procedure doRenameConnClick(Sender: TObject);

private
{ Private declarations }

procedure StateChanged(Sender: TObject); // TRAS event, added manually

public
{ Public declarations }
end;

var
MainForm: TMainForm;
RAS: TRAS ; // the main TRAS component
CurrConnection: string ; // active connection name, if any
StopFlag: boolean ; // if true, stop connection in progress
OnlineFlag: boolean ; // if true, connected
heap: THeapStatus ;


implementation

{$R *.DFM}

// when a connection is clicked, get Phone book info

procedure TMainForm.ConnListClick(Sender: TObject);
begin
if ConnList.ItemIndex = -1 then exit ;
RAS.EntryName := ConnList.Items [ConnList.ItemIndex]; // Connection name
ConnUser.Text := '' ;
ConnPw.Text := '' ;
if RAS.GetDialParams = 0 then // get connection parameters
begin
ConnUser.Text := RAS.UserName ; // display them
ConnPw.Text := RAS.Password ;
if RAS.GetEntryProperties = 0 then
begin
DeviceName.Caption := 'Device Name: ' + RAS.DeviceName ;
DeviceType.Caption := 'Device Type: ' + RAS.DeviceType ;
DevicePort.Caption := 'Device Port: ' + RAS.DevicePort ;
ConnPhone.Caption := 'Phone Number: ' + RAS.PhoneNumber ;
ConnCanonical.Caption := 'Canonical Number: ' + RAS.PhoneCanonical ;
end ;
Timer.Enabled := true ; // not until RAS installed
end
else
Status.Panels[1].Text := RAS.StatusStr ;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
count: integer ;
begin
OnlineFlag := false ;
CurrConnection := '' ; // no active connection, yet
RAS := TRAS.Create (Self) ; // create TRAS component
RAS.OnStateChanged := StateChanged ; // install event handler
if RAS.TestRAS then
begin
// get list of connections
RAS.GetPhoneBookEntries;
ConnList.Items.Assign (RAS.PhoneBookEntries); // display it
if ConnList.Items.Count <> 0 then ConnList.ItemIndex := 0 ; // set first

// get list of RAS capable modems
RAS.GetDeviceList ;
if RAS.DeviceNameList.Count <> 0 then
for count := 0 to RAS.DeviceNameList.Count - 1 do
DeviceList.Items.Add (RAS.DeviceNameList [count] + ' (' +
RAS.DeviceTypeList [count] + ')') ;

// Win95/98 gets performance stats from registry, but the keys may be
// translated and there may be more than one dial up adaptor
// so get a list and select the first found
if NOT RAS.EnablePerfStats (true, true) then
begin
ListDUA.Items.Assign (RAS.DialUpAdaptors) ;
ListDUA.Items.Add ('No Performance Statistics') ;
Status.Panels[1].Text := 'No Performance Statistics' ;
end
else
ListDUA.Items.Assign (RAS.DialUpAdaptors) ;

// initial settings
ConnListClick (self) ; // get connection info
Timer.Enabled := true ;
StateChanged (self) ; // initial status panel
end
else
begin
ConnList.Items.Add (RAS.StatusStr) ; // no RAS available
Status.Panels[1].Text := RAS.StatusStr ;
end ;

end;

// event handler called by TRAS when connection status changes

procedure TMainform.StateChanged(Sender: TObject);
var
info: string ;
begin
if CurrConnection = '' then
info := 'DUN: Offline'
else
info := 'DUN: ' + CurrConnection + ' - ' + RAS.StatusStr ;
Status.Panels[0].Text := info ;
end;

procedure TMainForm.TimerTimer(Sender: TObject);
var
numconns: integer ;
info: string ;
begin

// check for memory leaks
heap := GetHeapStatus ;
Memory.Caption := 'Memory: Allocated ' + IntToStr (heap.TotalAllocated) ;

// see if any connections are open
RAS.GetConnections ; // check for active connections
if Ras.Connections.Count = 0 then // no active connections
begin
OnlineFlag := false ;
if CurrConnection <> '' then // just gone offline
begin
CurrConnection := '' ;
RAS.IntDisconnect ; // disconnect, but ignore errors
RAS.ResetPerfStats ; // clear stats for next connection
StateChanged (self) ;
end
end
else
begin // see if new connection
if CurrConnection <> RAS.Connections.EntryName (0) then
begin
CurrConnection := RAS.Connections.EntryName (0) ;
RAS.ReOpen (0) ; // allow RAS to use this connection
end ;
RAS.CurrentStatus ; // triggers StateChanged event
if (RAS.ConnectState = RASCS_Connected) then
begin
RAS.GetPerfStats ; // get performance info
if NOT OnlineFlag then
begin
OnlineFlag := true ;

// connections speed not available on NT
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
ConnSpeed.Caption := 'Speed: ' +
IntToStr (RAS.StatsConn) + ' bps' ;

// dynamic IP addresses
if RAS.GetIPAddress = 0 then IPAddr.Caption :=
RAS.ClientIP + ' > ' + RAS.ServerIP ;
end ;

// display performance statistics
StatXmit.Caption := 'Xmit: ' +
IntToStr (RAS.StatsXmit) + ' chars' ;
StatRecv.Caption := 'Recv: ' +
IntToStr (RAS.StatsRecv) + ' chars' ;
end ;
end ;
end;

// this proc waits until a connection is achieved or cancelled

procedure TMainForm.doConnectClick(Sender: TObject);
begin
if ConnList.ItemIndex = -1 then exit ;
if CurrConnection <> '' then exit ; // already connected
Timer.Enabled := false ; // must stop progress events during connection
RAS.EntryName := ConnList.Items [ConnList.ItemIndex]; // Connection name
CurrConnection := RAS.EntryName ; // keep it to check later
StopFlag := false ; // set if Disconnect button is pressed
Status.Panels[1].Text := '' ;
Status.Panels[1].Text := CurrConnection + ' - Starting Connection' ;
if RAS.AutoConnect <> 0 then // get phone book, start connection
begin
CurrConnection := '' ;
Timer.Enabled := true ;
Status.Panels[1].Text := 'Connection Failed - ' + RAS.StatusStr ;
beep ;
exit ;
end ;

// need to wait for connection to dial or whatever
while (RAS.ConnectState < RASBase) do
begin
Application.ProcessMessages ;
if StopFlag then break ; // see if Disconnect button pressed
end ;
Timer.Enabled := true ;
if (RAS.ConnectState <> RASCS_Connected) or StopFlag then
begin
Ras.Disconnect;
CurrConnection := '' ;
StateChanged (self) ; // update panel
Status.Panels[1].Text := 'Connection Terminated' ;
beep ;
exit ;
end ;
RAS.Connect;
Status.Panels[1].Text := 'Connection Opened OK' ;
end;

procedure TMainForm.doDisConnClick(Sender: TObject);
begin
Status.Panels[1].Text := '' ;
StopFlag := true ;
if NOT Timer.Enabled then exit ; // not while connecting
RAS.Disconnect ; // disconnect, returns when done
end;

procedure TMainForm.doLogonUpdateClick(Sender: TObject);
begin
Status.Panels[1].Text := '' ;
if ConnList.ItemIndex = -1 then exit ;
RAS.EntryName := ConnList.Items [ConnList.ItemIndex]; // Connection name
RAS.UserName := ConnUser.Text ;
RAS.Password := ConnPw.Text ;
if RAS.SetDialParams = 0 then
Status.Panels[1].Text := 'Connection Updated'
else
Status.Panels[1].Text := RAS.StatusStr ;
end;

procedure TMainForm.doExitClick(Sender: TObject);
var
key: integer ;
begin
Timer.Enabled := false ; // stop connection checks
if RAS.RASConn <> 0 then
begin
key := MessageDlg ('Close Down Dial-Up Connection?',
mtConfirmation, mbYesNoCancel, 0) ;
if key = mrCancel then exit ;
if key = mrYes then
doDisConnClick(Sender)
else
RAS.LeaveOpen ; // stop destroy closing RAS
end ;
Application.Terminate ;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
doExitClick (sender) ;
Application.Terminate ;
end;

procedure TMainForm.doCreateConnClick(Sender: TObject);
begin
Status.Panels[1].Text := '' ;
if RAS.CreatePhonebook <> 0 then
Status.Panels[1].Text := RAS.StatusStr
else
begin
RAS.GetPhoneBookEntries; // get new list of connections
ConnList.Items.Assign (RAS.PhoneBookEntries); // display it
if ConnList.Items.Count <> 0 then ConnList.ItemIndex := 0 ; // set first
ConnListClick (self) ; // get connection info
end ;
end;

procedure TMainForm.doEditConnClick(Sender: TObject);
begin
Status.Panels[1].Text := '' ;
if ConnList.ItemIndex = -1 then exit ;
RAS.EntryName := ConnList.Items [ConnList.ItemIndex]; // Connection name
if RAS.EditPhonebook <> 0 then // display Dialog
Status.Panels[1].Text := RAS.StatusStr ;
end;

procedure TMainForm.doDeleteConnClick(Sender: TObject);
begin
Status.Panels[1].Text := '' ;
if ConnList.ItemIndex = -1 then exit ;
RAS.EntryName := ConnList.Items [ConnList.ItemIndex]; // Connection name
if RAS.DeletePhonebook <> 0 then
Status.Panels[1].Text := RAS.StatusStr
else
begin
RAS.GetPhoneBookEntries; // get new list of connections
ConnList.Items.Assign (RAS.PhoneBookEntries); // display it
if ConnList.Items.Count <> 0 then ConnList.ItemIndex := 0 ; // set first
ConnListClick (self) ; // get connection info
end ;
end;

procedure TMainForm.doRenameConnClick(Sender: TObject);
var
oldname, newname: string ;
begin
Status.Panels[1].Text := '' ;
if ConnList.ItemIndex = -1 then exit ;
oldname := ConnList.Items [ConnList.ItemIndex]; // Connection name
newname := oldname ;
while newname = oldname do
begin
if NOT InputQuery ('Rename Connection', 'New Connection Name',
newname) then exit ;
if RAS.ValidateName (newname) <> 0 then
begin
Status.Panels[1].Text := RAS.StatusStr ;
beep ;
newname := oldname ;
end ;
end ;
Status.Panels[1].Text := '' ;
RAS.EntryName := oldname ;
if RAS.RenamePhonebook (newname) <> 0 then
Status.Panels[1].Text := RAS.StatusStr
else
begin
RAS.GetPhoneBookEntries; // get new list of connections
ConnList.Items.Assign (RAS.PhoneBookEntries); // display it
if ConnList.Items.Count <> 0 then ConnList.ItemIndex := 0 ; // set first
ConnListClick (self) ; // get connection info
end ;

end;

end.

下面是RASCMP3.0控件源码：
unit rascomp32;
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;

function TConnectionList.EntryName(Index: Integer): String;
begin
If PRASConn(Items[Index])^.szEntryName[0] <> #0 THEN
Result := StrPas(PRASConn(Items[Index])^.szEntryName)
ELSE
Result := '';
end;

procedure TConnectionList.Clear; // Angus, must clear memory before Tlist
begin
while (Count > 0) do Delete (count - 1) ;

Inherited Clear ;
end;

procedure TConnectionList.Delete(Index: Integer);
begin
Dispose( PRASConn( Items[ Index ] ) );
Items[ Index ] := Nil;

Inherited Delete( Index );
end;

{ ********************************************************************* }
{ TRASConnection }
{ ********************************************************************* }

CONSTRUCTOR TRAS.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
RASEvent := RegisterWindowMessage(RASDialEvent);
If RASEvent = 0 THEN RASEvent := WM_RASDialEvent;
RASLib := 0 ;
RASxlib := 0 ;
RASAPI_Loaded := False;
RASExtn_Flag := False;

fRASConn := 0;
fConnectState := 0;
fSavedState := 9999 ;
fWindowHandle := 0;
ResetPerfStats ; // clear performance statistics
FRedialAttempts := 1;
fDeviceName := '' ; // Angus
fDeviceType := '' ; // Angus
fDevicePort := '' ; // Angus
fLastError := 0 ;
fStatusStr := '' ;
fKeyDUNAdap := Reg_PerfAdap ;
fKeyDUNConn := Reg_PerfConn ;
fKeyDUNXmit := Reg_PerfXmit ;
fKeyDUNRecv := Reg_PerfRecv ;

PhoneBookEntries := TStringList.Create;
Connections := TConnectionList.Create;
DialUpAdaptors := TStringList.Create;
DeviceTypeList := TStringList.Create;
DevicePortList := TStringList.Create;
DeviceNameList := TStringList.Create;
end;

destructor TRAS.Destroy;
begin
IntDisconnect;
PhoneBookEntries.Free;
Connections.Free;
DialUpAdaptors.Free ;
DeviceTypeList.Free ;
DevicePortList.Free ;
DeviceNameList.Free ;
if (RASxlib <> RASlib) and (RASxlib <> 0) then
FreeLibrary(RASxlib) ;
if RASAPI_Loaded then FreeLibrary(RASlib);
RASAPI_Loaded := false ;
// must close key to allow other applications to be deleted/accessed
if Win32Platform = VER_PLATFORM_WIN32_NT then
RegCloseKey (HKEY_PERFORMANCE_DATA);
inherited Destroy;
end;

// Try and load various RAS DLL functions. Returns false if failed

function TRAS.LoadRASAPI: boolean ;
begin
if Not RASAPI_Loaded then
begin
RasDial := Nil;
RASAPI_Loaded := True;
RASExtn_Flag := false ;
RASlib := LoadLibrary (RASAPI_DLL) ;
If RASlib <> 0 then
begin
RasDial := GetProcAddress(RASlib, 'RasDialA') ;
RasEnumConnections := GetProcAddress(RASlib, 'RasEnumConnectionsA');
RasEnumEntries := GetProcAddress(RASlib, 'RasEnumEntriesA');
RasGetConnectStatus := GetProcAddress(RASlib, 'RasGetConnectStatusA');
RasGetErrorString := GetProcAddress(RASlib, 'RasGetErrorStringA');
RasHangUp := GetProcAddress(RASlib, 'RasHangUpA');
RasGetEntryDialParams := GetProcAddress(RASlib, 'RasGetEntryDialParamsA');
RasSetEntryDialParams := GetProcAddress(RASlib, 'RasSetEntryDialParamsA');
RasMonitorDlg := GetProcAddress(RASlib, 'RasMonitorDlgA');
RasEditPhonebookEntry := GetProcAddress(RASlib, 'RasEditPhonebookEntryA');
RasCreatePhonebookEntry := GetProcAddress(RASlib, 'RasCreatePhonebookEntryA');
RasGetProjectionInfo := GetProcAddress(RASlib, 'RasGetProjectionInfoA');

// now get API extensions that may be in rasapi32.dll or rnaph.dll
RASxLib := RASLib ;
RasGetCountryInfo := GetProcAddress(RASxLib, 'RasGetCountryInfoA');
if Assigned (RasGetCountryInfo) then
RASExtn_Flag := true
else
begin
RASxlib := LoadLibrary (RNAPH_DLL) ;
If RASxlib <> 0 then RASExtn_Flag := true ;
end ;
if RASExtn_Flag then
begin
RasGetCountryInfo := GetProcAddress(RASxLib, 'RasGetCountryInfoA');
RasGetEntryProperties := GetProcAddress(RASxLib, 'RasGetEntryPropertiesA');
RasSetEntryProperties := GetProcAddress(RASxLib, 'RasSetEntryPropertiesA');
RasRenameEntry := GetProcAddress(RASxLib, 'RasRenameEntryA');
RasDeleteEntry := GetProcAddress(RASxLib, 'RasDeleteEntryA');
RasValidateEntryName := GetProcAddress(RASxLib, 'RasValidateEntryNameA');
RasEnumDevices := GetProcAddress(RASxLib, 'RasEnumDevicesA');
end ;
end ;
end ;
result := Assigned (RasDial) ;
end ;

// allow to check if RAS available without calling any functions

function TRAS.TestRAS: boolean ;
begin
result := LoadRASAPI ;
if NOT result then
begin
fLastError := ERROR_DLL_NOT_FOUND ;
fStatusStr := RASAPI_DLL + ' Not Available' ;
end ;
end ;

// get dial parms from specified Phone Book (aka Dialup Connection)

FUNCTION TRAS.GetDialParams: LongInt;
var
fp: LongBool;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
FillChar(RASDialParams, SizeOf(TRasDialParams), 0);
fUserName := '' ;
FPassword := '' ;
// fPhoneNumber := '' ;
fCallBackNumber := '' ;
fDomain := '' ;
with RASDialParams do
begin
dwSize := Sizeof(TRasDialParams);
StrPCopy(szEntryName, fEntryName);
end;
If fPhoneBookPath <> '' THEN
fLastError := RasGetEntryDialParams (PChar(fPhoneBookPath),
RASDialParams, fp)
else
fLastError := RasGetEntryDialParams (nil, RASDialParams, fp);
result := fLastError ;
if fLastError = 0 then
begin
with RASDialParams do
begin
// note no phone number comes back!!, but try anyway
fUserName := StrPas (szUserName) ;
FPassword := '' ;
if fp then Fpassword := StrPas (szPassword) ;
// fPhoneNumber := StrPas (szPhoneNumber) ;
fCallBackNumber := StrPas (szCallBackNumber) ;
fDomain := StrPas (szDomain) ;
end ;
end
else
fStatusStr := GetErrorString (LastError);
;
end;

function FixedToPasStr (fixstr: PChar; fixsize: integer): string ;
var
temp: string ;
begin
SetLength (temp, fixsize);
Move (fixstr^, PChar (temp)^, fixsize); // may include embedded nulls
result := TrimRight (temp) ; // strip trailing nulls
end ;

// get entry properties from specified Phone Book (aka Dialup Connection)

function TRAS.GetEntryProperties: LongInt ;
var
BuffSize, PropsSize, DevSize, count: Longint ;
EntryBuff: PChar ;
RASEntry: TRasEntry ;
dwSize: ^Longint ;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;

// note that NT may return info beyond RASEntry, for extra phone numbers
// so the buffer must be larger, 5K is a guess
BuffSize := 5000 ;
Try
GetMem (EntryBuff, BuffSize) ;
PropsSize := BuffSize ;
pointer (dwSize) := EntryBuff ;
dwSize^ := SizeOf (TRASEntry) ;
DevSize := 0 ;
// currently ignoring the device specific information
If fPhoneBookPath <> '' THEN
Result := RasGetEntryProperties (PChar(fPhoneBookPath),
PChar (fEntryName), Pchar(EntryBuff), PropsSize, nil, DevSize)
else
Result := RasGetEntryProperties (nil, PChar (fEntryName),
Pchar(EntryBuff), PropsSize, nil, DevSize) ;
fLastError := Result ;
if fLastError <> 0 then
fStatusStr := GetErrorString (fLastError)
else
begin
move (EntryBuff^, RASEntry, SizeOf (TRASEntry)) ;
with RASEntry do
begin
if ((dwfOptions and RASEO_UseCountryAndAreaCodes) =
RASEO_UseCountryAndAreaCodes) then
begin
fPhoneNumber := StrPas (szAreaCode) + ' ' +
StrPas (szLocalPhoneNumber) ;
fPhoneCanonical := '+' + IntToStr (dwCountryCode) + ' ' ;
if (szAreaCode [0] >= '0') then fPhoneCanonical :=
fPhoneCanonical + '(' + StrPas (szAreaCode) + ') ' ;
fPhoneCanonical := fPhoneCanonical + StrPas (szLocalPhoneNumber) ;
end
else
begin
fPhoneNumber := StrPas (szLocalPhoneNumber) ;
fPhoneCanonical := fPhoneNumber ;
end ;
// warning, some devices have two nulls strings
fDeviceName := FixedToPasStr (szDeviceName, sizeof (szDeviceName)) ;
fDevicePort := '' ;
count := pos (#0, fDeviceName) ; // see if port follows drvice, NT only
if count > 1 then
begin
fDevicePort := trim (copy (fDeviceName, count + 1, 99)) ;
fDeviceName := trim (copy (fDeviceName, 1, count - 1)) ;
end ;
fDeviceType := StrPas (szDeviceType);
// other connection stuff here, if we need it
// may be extra phone numbers after structure
end ;
end ;
finally
if EntryBuff <> nil then Freemem (EntryBuff) ;
end ;
end ;

// internal proc used to setup dial params for Set and Dial

procedure TRAS.MoveDialParms ;
begin
FillChar(RASDialParams, SizeOf(RASDialParams), #0);
With RASDialParams DO
Begin
dwSize := SizeOf(TRASDialParams);
UniqueString(fEntryName);
StrLCopy(szEntryName, PChar((fEntryName)), RAS_MaxEntryName);
UniqueString(fPhoneNumber);
StrLCopy(szPhoneNumber, PChar(fPhoneNumber), RAS_MaxPhoneNumber);
UniqueString(fCallBackNumber);
StrLCopy(szCallbackNumber, PChar((fCallBackNumber)), RAS_MaxCallbackNumber);
UniqueString(fUserName);
StrLCopy(szUserName,PChar((fUserName)), UNLEN);
UniqueString(fPassWord);
StrLCopy(szPassword, PChar((fPassWord)), PWLEN);
UniqueString(fDomain);
StrLCopy(szDomain, Pchar(fDomain), DNLEN);
End;
end ;

// update dial parms for specified Phonebook (aka Dialup Connection)

function TRAS.SetDialParams: LongInt;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
MoveDialParms ;
If fPhoneBookPath <> '' THEN
fLastError := RasSetEntryDialParams (PChar(fPhoneBookPath),
RASDialParams, false)
else
fLastError := RasSetEntryDialParams (nil, RASDialParams, false);
if fLastError <> 0 then
fStatusStr := GetErrorString (fLastError);
Result := fLastError;
end;

// edit specified Phonebook (aka Dialup Connection)

function TRAS.EditPhonebook: LongInt ;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
Result := RasEditPhonebookEntry (Application.Handle, nil, PChar(fEntryName));
fLastError := Result ;
if fLastError <> 0 then
fStatusStr := GetErrorString (fLastError);
end ;

// delete specified Phonebook (aka Dialup Connection)

function TRAS.DeletePhonebook: LongInt ;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
if NOT RASExtn_Flag then exit ;
Result := RasDeleteEntry (nil, PChar(fEntryName));
fLastError := Result ;
if Result = 0 then
fEntryName := ''
else
fStatusStr := GetErrorString (fLastError);
end ;

// rename specified Phonebook (aka Dialup Connection)
// checks that name is valid first

function TRAS.RenamePhonebook (newname: string): LongInt ;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
if NOT RASExtn_Flag then exit ;
Result := RasValidateEntryName (nil, PChar(newname));
fLastError := Result ;
if fLastError = 0 then
begin
Result := RasRenameEntry (nil, PChar(fEntryName), PChar(newname));
if Result = 0 then fEntryName := newname ;
fLastError := Result ;
end ;
if fLastError <> 0 then
fStatusStr := GetErrorString (fLastError);
end ;

// check specified Phonebook name is valid (aka Dialup Connection)

function TRAS.ValidateName (newname: string): LongInt ;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
if NOT RASExtn_Flag then exit ;
Result := RasValidateEntryName (nil, PChar(newname));
fLastError := Result ;
if fLastError <> 0 then
fStatusStr := GetErrorString (fLastError);
end ;

// create new Phonebook (aka Dialup Connection)

function TRAS.CreatePhonebook: LongInt ;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
Result := RasCreatePhonebookEntry (Application.Handle, nil);
fLastError := Result ;
if fLastError <> 0 then
fStatusStr := GetErrorString (fLastError);
end ;


// for specified Phonebook, get username/password/number, then dial it

function TRAS.AutoConnect: LongInt;
begin
GetDialParams ;
if fLastError = 0 then GetEntryProperties ;
if fLastError = 0 then Connect ;
result := fLastError ;
end ;

// for specified Phonebook, dial it (with given logon and password)

function TRAS.Connect: LongInt;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
If fRASConn <> 0 THEN { Allow only one connection }
IntDisconnect;
If fWindowHandle = 0 THEN
fWindowHandle := AllocateHWnd(WndProc);
fRasConn := 0;
fConnectState := 0; // ANGUS, 16 Apr 98
fSavedState := 9999 ;
ResetPerfStats ; // clear performance statistics
MoveDialParms ;
If fPhoneBookPath <> '' THEN
fLastError := RasDial(Nil, PChar(fPhoneBookPath), @RASDialParams,
$FFFFFFFF, fWindowHandle, fRASConn)
ELSE
fLastError := RasDial(Nil, Nil, @RASDialParams,$FFFFFFFF,
fWindowHandle, fRASConn);
if fLastError <> 0 then // Angus, get more info about failure
fStatusStr := GetErrorString (fLastError) ;
Result := fLastError;
end;

// get a standard Windows Error String

function TRAS.GetErrorString(ErrorCode: LongInt): String;
var
szErrorString: Array[0..256] of Char;
begin
Result := '';
FillChar(szErrorString, SizeOf(szErrorString), #0);
RasGetErrorString(ErrorCode, szErrorString, 256);
If szErrorString[0] <> #0 THEN
Result := StrPas(szErrorString)
Else
// Result := 'Status Unknown';
Result := SysErrorMessage (ErrorCode) ; // Angus, try a windows error
end;

// Leave connection open but disable access from this component
// use this before terminating the program if the connection is
// to be left open, otherwise it's closed automatically

function TRAS.LeaveOpen: LongInt;
begin
fRASConn := 0;
Result := IntDisconnect;
end ;

// ReOpen RAS an existing coonection for access from this component
// used after RAS.GetConnections finds one or more new connections
// entry is specific connection to access

function TRAS.ReOpen (item: integer) : LongInt;
begin
if fRASConn = 0 then
begin
if fCurRASConn = 0 then
begin
fLastError := 6 ; // bad handle
result := fLastError ;
exit ;
end ;
if item > 0 then
fRASConn := Connections.RasConn (item)
else
fRASConn := fCurRASConn ;
end ;
Result := GetConnectStatus ;
// ResetPerfStats ; // clear performance statistics
end ;

// Close RAS connection, wait for it to finish

function TRAS.Disconnect: LongInt;
var
oldstate: integer ;
begin
Result := 0;
OldState := 0 ;
fConnectState := 0 ; // 11 Nov 98 - ensure not left 'connected'
If fRASConn <> 0 THEN
begin
fLastError := ERROR_DLL_NOT_FOUND ;
if NOT LoadRASAPI then exit ;
result := RASHangUp (fRASConn);
while GetConnectStatus = 0 do // ANGUS, wait for it to die
begin
Application.ProcessMessages ; // 16 Apr 98
if oldstate <> fConnectState then
begin
fStatusStr := MessText ;
StateChanged ;
oldstate := fConnectState ;
end ;
end ;
end ;
fRASConn := 0;
If fWindowHandle <> 0 THEN { Stop message flow }
Begin
DeallocateHWnd(fWindowHandle);
fWindowHandle := 0;
End;
fLastError := Result;
Disconnected;
end;

// Close RAS connection, do not wait for it to finish (used by Destroy)

function TRAS.IntDisconnect: LongInt;
begin
Result := 0;
fConnectState := 0 ; // 11 Nov 98 - ensure not left 'connected'
If fRASConn <> 0 THEN
begin
fLastError := ERROR_DLL_NOT_FOUND ;
if NOT LoadRASAPI then exit ;
Result := RASHangUp (fRASConn);
end ;
fRASConn := 0;
If fWindowHandle <> 0 THEN { Stop message flow }
Begin
DeallocateHWnd(fWindowHandle);
fWindowHandle := 0;
End;
fLastError := Result;
end;

// get IP addresses for current RAS connections

function TRAS.GetIPAddress: LongInt;
var
RasPppIp: TRasPppIp ;
varsize: longint ;
begin
Result := 0;
FClientIP := '' ;
FServerIP := '' ;
If fRASConn = 0 THEN exit ;
fLastError := ERROR_DLL_NOT_FOUND ;
if NOT LoadRASAPI then exit ;
FillChar (RasPppIp, SizeOf(RasPppIp), #0);
RASPppIp.dwSize := SizeOf (RasPppIp);
varsize := SizeOf (RasPppIp);
Result := RASGetProjectionInfo(RASConn, RASP_PppIp,
@RasPppIp, varsize) ;
fLastError := Result;
if Result = 0 then
begin
// dwError - PPP control negotiation, 0 OK
fClientIP := StrPas(RasPppIp.szIpAddress);
fServerIP := StrPas(RasPppIp.szServerIpAddress);
end ;
end;

// get list of active RAS connections, ie things online

function TRAS.GetConnections: LongInt;
var
// RASConnect: Array[1..MaxConnections] OF TRASConn;
I,
BufSize: DWord;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
fCurConnName := '' ;
fCurRASConn := 0 ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
Connections.Clear;
FillChar (RASConnect, SizeOf(RASConnect), 0);
RASConnect[1].dwSize := Sizeof (RASConnect[1]);
BufSize := SizeOf(RASConnect);
Result := RasEnumConnections(@RASConnect, BufSize, fNumConns);
fLastError := Result;
if ((fLastError = 0) OR (fLastError = ERROR_BUFFER_TOO_SMALL)) and
(fNumConns <> 0) THEN
begin
For I := 1 TO fNumConns DO
begin
If (I <= MaxConnections) THEN
Connections.AddConnection(RASConnect);
end ;
fCurConnName := RASConnect [1].szEntryName ;
fCurRASConn := RASConnect [1].rasConn ;
end ;
end;

// get single connection details
// this avoids messing with string lists when one connection is common

function TRAS.GetConnection: String;
var
BufSize: DWord ;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
fCurConnName := '' ;
fCurRASConn := 0 ;
result := '' ;
if NOT LoadRASAPI then exit ;
FillChar (RASConnect, SizeOf(RASConnect), 0);
RASConnect[1].dwSize := Sizeof (RASConnect[1]);
BufSize := SizeOf(RASConnect);
fLastError := RasEnumConnections(@RASConnect, BufSize, fNumConns);
if ((fLastError = 0) OR (fLastError = ERROR_BUFFER_TOO_SMALL)) and
(fNumConns <> 0) THEN
begin
fCurConnName := RASConnect [1].szEntryName ;
fCurRASConn := RASConnect [1].rasConn ;
result := fCurConnName ;
end ;
end;

// get list of defined TAPI device, ie modems or ISDN cards

function TRAS.GetDeviceList;
var
RASDevNames: Array[1..MaxDevices] Of TRasDevInfo;
I,
BufSize,
Entries: LongInt ;
count: integer ;
DeviceName, DevicePort: string ;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
if NOT RASExtn_Flag then exit ;
DeviceTypeList.Clear;
DevicePortList.Clear ;
DeviceNameList.Clear;
BufSize := SizeOf(RASDevNames);
FillChar (RASDevNames, SizeOf(RASDevNames), 0);
RASDevNames[1].dwSize := SizeOf(RASDevNames[1]);
Result := RasEnumDevices (@RASDevNames, BufSize, Entries);
fLastError := Result;
If (Result = 0) THEN
For I := 1 TO Entries DO
If (RASDevNames.szDeviceName[0] <> #0) THEN
begin
DeviceTypeList.Add (StrPas(RASDevNames.szDeviceType));
DeviceName := FixedToPasStr (RASDevNames.szDeviceName,
sizeof (RASDevNames[1].szDeviceName)) ;
DevicePort := '' ;
count := pos (#0, DeviceName) ; // see if port follows drvice, NT only
if count > 1 then
begin
DevicePort := copy (DeviceName, count + 1, 99) ;
DeviceName := copy (DeviceName, 1, count - 1) ;
end ;
DevicePortList.Add (DevicePort) ;
DeviceNameList.Add (DeviceName) ;
end ;
end;

// get list of defined Phonebooks (aka DUN Connections)

function TRAS.GetPhoneBookEntries;
var
RASEntryName: Array[1..MaxPhonebooks] Of TRASENTRYNAME;
I,
BufSize,
Entries: DWord;
szPhoneBookPath: PChar;
begin
fLastError := ERROR_DLL_NOT_FOUND ;
result := fLastError ;
if NOT LoadRASAPI then exit ;
PhoneBookEntries.Clear;
FillChar (RASEntryName, SizeOf(RASEntryName), 0);
RASEntryName[1].dwSize := SizeOf(RASEntryName[1]);
BufSize := SizeOf(RASEntryName);
If fPhoneBookPath <> '' THEN
Begin
GetMem(szPhoneBookPath, Length(fPhoneBookPath) + 1);
StrPCopy(szPhoneBookPath, fPhoneBookPath);
Result := RasEnumEntries(Nil, szPhonebookPath, @RASEntryName,
BufSize, Entries);
FreeMem(szPhoneBookPath, Length(fPhoneBookPath) + 1);
End
ELSE
Result := RasEnumEntries(Nil, Nil, @RASEntryName, BufSize, Entries);
fLastError := Result;
If (Result = 0) THEN
For I := 1 TO Entries DO
If (RASEntryName.szEntryName[0] <> #0) THEN
PhoneBookEntries.Add(StrPas(RASEntryName.szEntryName));
end;


// get text for RAS progress message

function TRAS.MessText: String ;
begin
Result := '' ;
Case fConnectState OF
RASCS_OpenPort:
Result := 'Opening Serial Port' ;
RASCS_PortOpened:
Result := 'Serial Port Opened';
RASCS_ConnectDevice:
begin
Result := 'Connecting/Dialling' ;
if fDeviceType <> '' then Result := Result +
' (' + LowerCase (fDeviceType) + ')' ;
end ;
RASCS_DeviceConnected:
begin
Result := 'Connected/Answered' ;
if fDeviceType <> '' then Result := Result +
' (' + LowerCase (fDeviceType) + ')' ;
end ;
RASCS_AllDevicesConnected:
Result := 'Connected/Negotiation';
RASCS_Authenticate:
Result := 'Validating User and Password';
RASCS_AuthNotify:
Result := 'Authentication Notification';
RASCS_AuthCallBack:
Result := 'Authentication Call Back';
RASCS_AuthProject:
Result := 'Projection Started';
RASCS_AuthLinkSpeed:
Result := 'Calculating Link speed';
RASCS_AuthAck:
Result := 'Authentication acknowledged';
RASCS_ReAuthenticate:
Result := 'Reauthenticating';
RASCS_Authenticated:
Result := 'Login Authenticated';
RASCS_PrepareforCallBack:
Result := 'Preparing for Callback';
RASCS_WaitForModemReset:
Result := 'Waiting for Modem Reset';
RASCS_WaitForCallBack:
Result := 'Waiting for Callback';
RASCS_Projected: // ANGUS
Result := 'Projection Completion';
RASCS_StartAuthentication: // ANGUS
Result := 'Start Authentication';
RASCS_CallbackComplete: // ANGUS
Result := 'Callback Complete';
RASCS_LogonNetwork: // ANGUS
Result := 'Logon to Network';
RASCS_Connected: // ANGUS
Result := 'Connected/Online';
RASCS_DisConnected: // ANGUS
Result := 'Disconnected/Offline';
End; { Case }
if Result = '' then
begin
// connect state should not have errors, but of course it does!
If fConnectState > Pending THEN // 600
Result := GetErrorString (fConnectState)
else
Result := 'Unknown State - ' + IntToStr (fConnectState) ;
end ;

end ;

// event handler called by Windows while making a RAS connection

procedure TRAS.WndProc(var Msg: TMessage);
begin
If (Msg.Msg = RASEvent) AND (fRASConn <> 0) THEN
Begin
fConnectError := Msg.lParam ;
If Msg.lParam <> 0 THEN
begin
fLastError := Msg.lParam ;
fConnectState := fLastError ; // ANGUS, ensure errors handled
fStatusStr := GetErrorString (fLastError);
StateChanged ; // ANGUS - general catch all
end
ELSE
Begin
fConnectState := Msg.wParam;
fStatusStr := MessText ;
StateChanged ; // ANGUS - general catch all
Case fConnectState OF
{ RASCS_DeviceConnected: DeviceConnected;}
{Daniel's Addition}
RASCS_OpenPort : AboutToOpenPort;
RASCS_PortOpened : PortOpened;
RASCS_ConnectDevice : AboutToConnDev;
RASCS_DeviceConnected : DevConnected;
RASCS_AllDevicesConnected : AllDevsConnected;
RASCS_Authenticate : Authenticate;
RASCS_AuthNotify : AuthNotify;
RASCS_AuthRetry : AuthRetry;
RASCS_AuthCallback : AuthCallBack;
RASCS_AuthChangePassword : AuthChangePassword;
RASCS_AuthProject : AuthProject;
RASCS_AuthLinkSpeed : AuthLinkSpeed;
RASCS_AuthAck : AuthAck;
RASCS_ReAuthenticate : ReAuthenticate;
RASCS_Authenticated : Authenticated;
RASCS_PrepareForCallback : PrepareforCallback;
RASCS_WaitForModemReset : WaitForModemReset;
RASCS_Interactive : InteractiveStarted;
RASCS_RetryAuthentication : RetryAuth;
RASCS_PasswordExpired : PasswordExpired;
RASCS_Connected : Connected;
RASCS_DisConnected : Disconnected;
RASCS_WaitForCallBack: WaitingForCallBack;
End;
End;
// CurrentStatus;
End
ELSE
DefWindowProc(fWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

Procedure TRAS.SetRedialAttempts( Value: Integer );
Begin
IF ( FRedialAttempts <> Value ) THEN
BEGIN
FRedialAttempts := Value;
END;
End;

// get status of currently open RAS connection

function TRAS.GetConnectStatus: LongInt;
var
RASConnStatus: TRASConnStatus;
begin
fConnectState := 0 ;
Result := ERROR_INVALID_PORT_HANDLE ;
if (fRASConn = 0) THEN Exit;
fLastError := ERROR_DLL_NOT_FOUND ;
Result := fLastError ;
if NOT LoadRASAPI then exit ;
FillChar (RASConnStatus, SizeOf(RASConnStatus), #0);
RASConnStatus.dwSize := SizeOf (RasConnStatus);
fLastError := RasGetConnectStatus(RASConn, @RASConnStatus);
If fLastError = 0 THEN
begin
// removed 27 Aug 98 - not reliable on NT, so get from Phonebook instead
// fDeviceName := StrPas(RASConnStatus.szDeviceName);
// fDeviceType := StrPas(RASConnStatus.szDeviceType);
fConnectState := RASConnStatus.RASConnState;
fConnectError := RASConnStatus.dwError ;
if RASConnStatus.dwError > Pending then // ANGUS
fLastError := RASConnStatus.dwError;
end;
if fLastError <> 0 then // Angus, get more info about failure
fStatusStr := GetErrorString (fLastError) ;
Result := fLastError;
end;

// RAS status procedure, asks windows what is going on

FUNCTION TRAS.CurrentStatus: String;
BEGIN
If fRASConn <> 0 THEN
Begin
GetConnectStatus; // actually makes RasGetConnectStatus
Result := 'Unknown State';
If fLastError <> 0 THEN
Begin
If fLastError > Pending THEN // 600
Result := GetErrorString (fLastError)
ELSE
Case fLastError OF
6: Result := 'Disconnected'; // bad handle
8: Result := 'Not enough memory';
Pending: Result := 'Device Connecting/Dialling' ; // better than pending
End;
End
ELSE
Result := MessText ;
// moved all literals to function MessText
End
ELSE
Result := 'Not Connected';

fStatusStr := Result ;
StateChanged ; // ANGUS - general catch all event
end;

PROCEDURE TRAS.SetPhoneBookPath( Value: String );
BEGIN
fPhoneBookPath := Value;
GetPhoneBookEntries;
END;

PROCEDURE TRAS.Connected;
BEGIN
If ( fRASConn = 0 ) THEN Exit;
If Assigned( fOnConnect ) THEN fOnConnect( Self );
END;

PROCEDURE TRAS.StateChanged; // Angus
BEGIN
If ( fRASConn = 0 ) THEN Exit;
If Assigned( fStateChanged ) THEN
begin
if (LastError <> 0) or (ConnectState <> SavedState) then
fStateChanged( Self );
if (LastError <> 0) then
fSavedState := 0
else
fSavedState := fConnectState ;
end ;
END;

PROCEDURE TRAS.AboutToOpenPort;
BEGIN
If (fRASConn = 0) THEN Exit;
If Assigned(fAboutToOpenPort) THEN fAboutToOpenPort (Self);
end;

procedure TRAS.PortOpened;
begin
If (fRASConn = 0) THEN Exit;
// GetConnectStatus ; // Angus, get device type and device name
If Assigned(fPortOpened) THEN fPortOpened(Self);
end;

procedure TRAS.AboutToConnDev;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAboutToConnDev) THEN fAboutToConnDev (Self);
end;

procedure TRAS.DevConnected;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fDevConnected) THEN fDevConnected(Self);
end;

procedure TRAS.AllDevsConnected;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAllDevsConnected) THEN fAllDevsConnected(Self);
end;

procedure TRAS.Authenticate;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAuthenticate) THEN fAuthenticate(Self);
end;

procedure TRAS.AuthNotify;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAuthNotify) THEN fAuthNotify(Self);
end;

procedure TRAS.AuthRetry;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAuthRetry) THEN fAuthRetry(Self);
end;

procedure TRAS.AuthCallBack;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAuthCallBack) THEN fAuthCallBack(Self);
end;

procedure TRAS.AuthChangePassword;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAuthChangePassword) THEN fAuthChangePassword(Self);
end;

procedure TRAS.AuthProject;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAuthProject) THEN fAuthProject(Self);
end;

procedure TRAS.AuthLinkSpeed;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAuthLinkSpeed) THEN fAuthLinkSpeed(Self);
end;

procedure TRAS.AuthAck;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAuthAck) THEN fAuthAck(Self);
end;

procedure TRAS.ReAuthenticate;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fReAuthenticate) THEN fReAuthenticate(Self);
end;

procedure TRas.Authenticated;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fAuthenticated) THEN fAuthenticated(Self);
end;

procedure TRAS.PrepareforCallback;
begin
if (fRASConn = 0) THEN Exit;
If Assigned(fPrepareforCallback) THEN fPrepareforCallback(Self);
end;

procedure TRAS.WaitForModemReset;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fWaitForModemReset) THEN fWaitForModemReset(Self);
end;

procedure TRAS.InteractiveStarted;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fInteractiveStarted) THEN fInteractiveStarted(Self);
end;

procedure TRAS.RetryAuth;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fRetryAuth) THEN fRetryAuth(Self);
end;

procedure TRAS.PasswordExpired;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fPasswordExpired) THEN fPasswordExpired(Self);
end;

procedure TRAS.DisConnected;
var
RasConnStatus : TRasConnStatus;
ErrorStr : String;
begin
If Assigned(fOnDisConnect) THEN
begin
fLastError := ERROR_DLL_NOT_FOUND ;
if NOT LoadRASAPI then exit ;
FillChar(RASConnStatus, SizeOf(RASConnStatus), #0);
RASConnStatus.dwSize := Sizeof (RasConnStatus);
fLastError := RasGetConnectStatus(RASConn, @RASConnStatus);
ErrorStr := GetErrorString (fLastError);
fOnDisConnect(Self,fLastError,ErrorStr);
end;
end;

procedure TRAS.WaitingForCallBack;
begin
If (fRASConn = 0) THEN Exit;
If Assigned(fOnCallBack) THEN fOnCallBack(Self);
end;

procedure TRAS.ResetPerfStats ;
begin
fStatsXmitCon := fStatsXmitTot ; // tot counters are from IPL
fStatsRecvCon := fStatsRecvTot ;
fStatsXmitCur := 0 ; // cur counters are current connection
fStatsRecvCur := 0 ;
end ;

function TRAS.SearchDUA: boolean ;
var
TempKey, Temp2Key: HKey;
keyname, lockey: string ;
flag: boolean ;
NumSubKeys, NumValues, count: integer ;
dwType, dwSize, Len: DWORD ;
begin
result := false ;
if NOT Win32Platform = VER_PLATFORM_WIN32_WINDOWS then exit ;
DialUpAdaptors.Clear ;
TempKey := 0;
Temp2Key := 0;
result := RegOpenKeyEx (HKEY_LOCAL_MACHINE, PChar(Reg_PerfStatEmum),
0, KEY_READ, TempKey) = ERROR_SUCCESS ;
if result then
result := RegOpenKeyEx (HKEY_DYN_DATA, PChar(Reg_PerfStatStart),
0, KEY_READ, Temp2Key) = ERROR_SUCCESS ;
if result then
begin
NumSubKeys := 0 ;
NumValues := 0 ;
count := RegQueryInfoKey (TempKey, nil, nil, nil, @NumSubKeys,
nil, nil, @NumValues, nil, nil, nil, nil) ;
if NumSubKeys <> 0 then
begin
SetString (lockey, nil, 33);
for count := 0 to NumSubKeys - 1 do
begin
Len := 33 ;
RegEnumKeyEx (TempKey, count, PChar(lockey), Len,
nil, nil, nil, nil);
keyname := PChar (lockey) + '/' + fKeyDUNConn ;
if RegQueryValueEx (Temp2Key, PChar(keyname), nil,
@dwType, nil, @dwSize) = ERROR_SUCCESS then
DialUpAdaptors.Add (PChar (lockey)) ;
end ;
end ;
end ;
if TempKey <> 0 then RegCloseKey (TempKey) ;
if Temp2Key <> 0 then RegCloseKey (Temp2Key) ;
if DialUpAdaptors.Count <> 0 then DialUpAdaptors.Sort ;
end;


function TRAS.EnablePerfStats (start, search: boolean): boolean ;
var
TempKey: HKey;
keyname: string ;
dwType, dwSize: DWORD ;
TempData: Pointer ;

function InitData (ValueName: string): boolean ;
begin
result := false ;
ValueName := fKeyDUNAdap + '/' + ValueName ;
if RegQueryValueEx (TempKey, PChar(ValueName), nil,
@dwType, nil, @dwSize) = ERROR_SUCCESS then
begin
try // read data but ignore it
GetMem (TempData, dwSize) ;
Result := RegQueryValueEx (TempKey, PChar(ValueName), nil,
@dwType, TempData, @dwSize) = ERROR_SUCCESS ;
finally
FreeMem (TempData) ;
end ;
end ;
end ;

begin
result := false ;
if Win32Platform = VER_PLATFORM_WIN32s then exit ;
result := true ;
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
begin
if search then
begin
SearchDUA ;
if DialUpAdaptors.Count = 0 then
begin
result := false ;
exit ;
end ;
fKeyDUNAdap := DialUpAdaptors [0] ; // set first
end ;
TempKey := 0;
if start then
keyname := Reg_PerfStatStart
else
keyname := Reg_PerfStatStop ;
result := RegOpenKeyEx (HKEY_DYN_DATA, PChar(keyname), 0,
KEY_ALL_ACCESS, TempKey) = ERROR_SUCCESS ;
if result then
begin
result := InitData (fKeyDUNXmit) ;
if result then result := InitData (fKeyDUNRecv) ;
if result then result := InitData (fKeyDUNConn) ;
RegCloseKey (TempKey) ;
end ;
end ;
if result then
begin
if start then result := GetPerfStats ; // get counters
ResetPerfStats ; // set current
end ;
end;

function TRAS.GetPerfStats: boolean ;
var
TempKey: HKey;
dwType,
dwSize,
connspd: DWORD ;
perfdata: PPERF_DATA_BLOCK ;
perfobj: PPERF_OBJECT_TYPE ;
perfcdef: PPERF_COUNTER_DEFINITION ;
perfmcdef: array [1..50] of PPERF_COUNTER_DEFINITION ;
perfinst: PPERF_INSTANCE_DEFINITION ;
perfcblk: PPERF_COUNTER_BLOCK ;
regbuff,
objptr,
defptr,
countptr: Pchar ;
actualsize,
DataType: Integer;
objnr,
instnr,
countnr: integer ;
datvalue: ^integer ;
loopflag: boolean ;


function GetData (ValueName: string; var Info: DWORD): boolean ;
begin
ValueName := fKeyDUNAdap + '/' + ValueName ;
dwSize := 4 ; // data is four bytes of binary, aka a DWORD
Result := RegQueryValueEx (TempKey, PChar(ValueName), nil,
@dwType, @Info, @dwSize) = ERROR_SUCCESS;
end ;

begin
result := false ;
if Win32Platform = VER_PLATFORM_WIN32s then exit ;
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then // Win95/98
begin
TempKey := 0;
result := RegOpenKeyEx (HKEY_DYN_DATA, PChar(Reg_PerfStatData),
0, KEY_READ, TempKey) = ERROR_SUCCESS ;
if result then
begin
result := GetData (fKeyDUNXmit, fStatsXmitTot) ;
if result then result := GetData (fKeyDUNRecv, fStatsRecvTot) ;
if result then result := GetData (fKeyDUNConn, connspd) ;
RegCloseKey (TempKey) ;
if result then
begin
if fStatsXmitTot < fStatsXmitCon then ResetPerfStats ;
if fStatsRecvTot < fStatsRecvCon then ResetPerfStats ;
fStatsConnSpd := connspd ;
fStatsXmitCur := fStatsXmitTot - fStatsXmitCon ;
fStatsRecvCur := fStatsRecvTot - fStatsRecvCon ;
end ;
end ;
end
else
begin
DataType := REG_NONE; // Windows NT performance data
try

// start with small buffer, it will be increased in size if necessary the
// first time, to that required for the returned performance data
if datasize = 0 then datasize := TOTALBYTES ;
GetMem (regbuff, datasize) ;
actualsize := datasize ;
while RegQueryValueEx (HKEY_PERFORMANCE_DATA,
pchar(Pdata_RAS_Total), nil, @DataType, PByte(regbuff),
@actualsize) = ERROR_MORE_DATA do
begin
Freemem (regbuff) ;
inc (datasize, BYTEINCREMENT) ; // increase buffers size by 1K
GetMem (regbuff, datasize) ;
actualsize := datasize ;
end ;

// get performance data block
if actualsize < 100 then exit ; // forget it
pointer (perfdata) := regbuff ; // PERF_DATA_BLOCK

// get performance object type blocks
if perfdata.numobjecttypes = 0 then exit ; // no objects to process
objptr := regbuff + perfdata.HeaderLength ;
for objnr := 1 to perfdata.numobjecttypes do
begin
Application.ProcessMessages;
pointer (perfobj) := objptr ; // PERF_OBJECT_TYPE
// perfobj.ObjectNameTitleIndex // not needed
defptr := objptr + perfobj.HeaderLength ;

// get performance counter definitions
if perfobj.numcounters > 0 then
begin

// read through definitions, really looking for length
for countnr := 1 to perfobj.numcounters do
begin
pointer (perfmcdef [countnr]) := defptr ; // keep each definitition
pointer (perfcdef) := defptr ; // PERF_COUNTER_DEFINITION
inc (defptr, perfcdef.bytelength) ;
if countnr > 50 then exit ;
Application.ProcessMessages;
end ;

// now get counter data, perhaps from multiple instances
loopflag := true ;
instnr := 1 ;
while loopflag do
begin
if perfobj.numinstances >= 1 then
begin
pointer (perfinst) := defptr ; // PERF_INSTANCE_DEFINITON
// Instance Name := WideCharToString
// (PWideChar(defptr + perfinst.nameoffset))) ;
inc (defptr, perfinst.bytelength) ;
end ;

// get counter block, then read actual data values
countptr := defptr ; // after reading through blocks
pointer (perfcblk) := countptr ; // PERF_COUNTER_BLOCK

// get counter data, currently only doublewords
for countnr := 1 to perfobj.numcounters do
begin
if perfmcdef [countnr].CounterNameTitleIndex =
Pdata_Bytes_Xmit then
begin
pointer (datvalue) := countptr +
perfmcdef [countnr].counteroffset ;
if Datvalue^ > fStatsXmitCur then
fStatsXmitCur := Datvalue^ ;
end ;
if perfmcdef [countnr].CounterNameTitleIndex =
Pdata_Bytes_Recv then
begin
pointer (datvalue) := countptr +
perfmcdef [countnr].counteroffset ;
if Datvalue^ > fStatsRecvCur then
fStatsRecvCur := Datvalue^ ;
end ;
end ;
inc (defptr, perfcblk.bytelength) ;

// check for more instances of these counters
if perfobj.numinstances >= 1 then
begin
inc (instnr) ;
if instnr > perfobj.numinstances then loopflag := false ;
end
else
loopflag := false ;
end ;
end ;
objptr := objptr + perfobj.totalbytelength ;
end ;
result := true ;
finally
if regbuff <> nil then Freemem (regbuff) ;
end ;
end ;
end;

Initialization
finalization

end.

[?]怎么没有人回答我的问题？版主能不能帮我解决一下，谢谢！！！

[]本人己解决此问题，结束此帖