rascomp32.~pas

DELIPHI编写的小程序

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;