rascomp32.~pas

DELIPHI编写的小程序

	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[I]);
        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[I].szDeviceName[0] <> #0) THEN
            begin
		    	DeviceTypeList.Add (StrPas(RASDevNames[I].szDeviceType));
   				DeviceName := FixedToPasStr (RASDevNames[I].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[I].szEntryName[0] <> #0) THEN
		    	PhoneBookEntries.Add(StrPas(RASEntryName[I].szEntryName));
end;


// get text for RAS progress message

function TRAS.MessText: String ;
begin
	Result := '' ;
	Case fConnectState OF
	RASCS_OpenPort:
			Result := '正在打开串行设备...' ;
	RASCS_PortOpened:
			Result := '串行设备已打开。';
	RASCS_ConnectDevice:
            begin
    			Result := '连接中/拨号中' ;
                if fDeviceType <> '' then Result := Result +
                                ' (' + LowerCase (fDeviceType) + ')' ;
            end ;
	RASCS_DeviceConnected:
            begin
    			Result := '连接成功/应答中' ;
                if fDeviceType <> '' then Result := Result +
                                ' (' + LowerCase (fDeviceType) + ')' ;
            end ;
	RASCS_AllDevicesConnected:
			Result := '连接成功/流通';
	RASCS_Authenticate:
			Result := '正在验证用户名和密码...';
	RASCS_AuthNotify:
			Result := '验证通知。';
	RASCS_AuthCallBack:
			Result := '验证回报。';
	RASCS_AuthProject:
			Result := '发送开始';
	RASCS_AuthLinkSpeed:
			Result := '计算连接速度';
	RASCS_AuthAck:
			Result := '验证公认的';
	RASCS_ReAuthenticate:
			Result := '再验证';
	RASCS_Authenticated:
			Result := '登录验证';
	RASCS_PrepareforCallBack:
			Result := '准备回查';
	RASCS_WaitForModemReset:
			Result := '正在等待Modem重新恢复';
	RASCS_WaitForCallBack:
			Result := '正在等待回叫信号';
    RASCS_Projected:                              // ANGUS
			Result := '发送完成';
    RASCS_StartAuthentication:                    // ANGUS
			Result := '开始验证';
    RASCS_CallbackComplete:                       // ANGUS
			Result := '复查完成';
    RASCS_LogonNetwork:                           // ANGUS
			Result := '登录上网';
	RASCS_Connected:						      // ANGUS
			 Result := '连接中/在线';
	RASCS_DisConnected:					          // ANGUS
			 Result := '连接断开/断线';
 	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 := '未知状态 - ' + 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 := '未知状态';
		If fLastError <> 0 THEN
    	Begin
    		If fLastError > Pending THEN     // 600
	    		Result := GetErrorString (fLastError)
		    ELSE
    		Case fLastError OF
	    		6: Result := '连接断开';	 // bad handle
		    	8: Result := '没有足够的内存空间';
			    Pending: Result := '设备正在连接/拨号中' ; // better than pending
    		End;
	    End
    	ELSE
	    	Result := MessText ;
		// moved all literals to function MessText
	End
	ELSE
		Result := '没有连接';

	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;