Microsoft KB Archive/186274

{|
 * width="100%"|

HOWTO: Retrieve a DCOM clients Authentication Level

 * }

ID: Q186274

-

The information in this article applies to:


 * Microsoft Visual Basic Professional and Enterprise Editions for Windows, versions 5.0, 6.0

-

SUMMARY
There are specific network situations where you will need to specify DCOM security settings on a remote client machine. You do not want to ask your end-users to open and use DCOMCNFG.EXE before they can run the DCOM client on their machines. As of version 1.1 of DCOM95, you can now specify process- specific security for a DCOM client running on a Windows 95 or Windows 98 machine. Please see the DCOM release notes for more information regarding this feature. This article contains a function that can be used to retrieve a DCOM client's Authentication Level from within a Visual Basic program.

MORE INFORMATION
The GetAuthentication function:

By providing this function with your DCOM clients exe name you can retrieve the current authentication level (1-None, 2-Connect).

NOTE: This does not work with Windows NT 4.0 Service Packs 3 or earlier. This functionality will be available in later versions of Windows NT and Windows 2000.

This article reads a registry key that will not be available by default. Refer to the complimentary article Q186275: HOWTO: Set DCOM Client's Authentication Level Programmatically.

Step-by-Step Procedure
 Open the Visual Basic project to which you want to add this function.  Add the following code to a standard module in your project:

     Option Explicit 'registry api constants and functions Private Const REG_SZ = 1 Private Const REG_DWORD = 4 Private Const HKEY_CLASSES_ROOT = &H80000000 Private Const ERROR_SUCCESS = 0 Private Const ERROR_NONE = 0 Private Const KEY_ALL_ACCESS = &H3F

Private Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long Private Declare Function RegOpenKey Lib "advapi32.dll" _ Alias "RegOpenKeyA" _ (ByVal hKey As Long, ByVal lpSubKey As String, _      phkResult As Long) As Long Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _ Alias "RegOpenKeyExA" _ (ByVal hKey As Long, ByVal lpSubKey As String, _      ByVal ulOptions As Long, ByVal samDesired As Long, _       phkResult As Long) As Long Private Declare Function RegQueryValue Lib "advapi32.dll" _ Alias "RegQueryValueA" _ (ByVal hKey As Long, ByVal lpSubKey As String, _      ByVal lpValue As String, lpcbValue As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" _ Alias "RegQueryValueExA" _ (ByVal hKey As Long, ByVal lpValueName As String, _      ByVal lpReserved As Long, lpType As Long, lpData As Any, _       lpcbData As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" _ Alias "RegSetValueExA" _ (ByVal hKey As Long, ByVal lpValueName As String, _      ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, _       ByVal cbData As Long) As Long

Public Function GetAuthentication(ClassName As String) As Integer Dim lRetVal As Long     'result of the API functions Dim hKey As Long        'handle of opened key Dim sKeyName As String Dim lpType As Long Dim lpData As String Dim lpData2 As Long Dim lpcbData As Long Dim myappid As String Dim auth As Integer

If ClassName = "" Then GetAuthentication = -1 MsgBox "Invalid class name" Exit Function End If       sKeyName = ClassName lRetVal = RegOpenKey(HKEY_CLASSES_ROOT, sKeyName, hKey) If lRetVal = ERROR_SUCCESS Then lpcbData = 40 lpData = Space$(40) lRetVal = RegQueryValue(hKey, "CLSID", lpData, lpcbData)

If lRetVal = ERROR_NONE Then myappid = Left$(lpData, lpcbData - 1) RegCloseKey (hKey) sKeyName = "AppID\" & myappid lRetVal = RegOpenKeyEx(HKEY_CLASSES_ROOT, sKeyName, 0&, _         KEY_ALL_ACCESS, hKey) If lRetVal = ERROR_SUCCESS Then lpData2 = CLng(0) lpcbData = Len(lpData2) lpType = REG_DWORD lRetVal = RegQueryValueEx(hKey, "AuthenticationLevel", 0&, _          lpType, lpData2, lpcbData) If lRetVal = ERROR_NONE Then auth = CInt(lpData2) GetAuthentication = auth Else MsgBox lRetVal & " - Unable to read authentication level." GetAuthentication = -2 End If         Else MsgBox lRetVal & " - Cannot find AppID for " & sKeyName GetAuthentication = -3 End If         RegCloseKey (hKey) Else MsgBox lRetVal & " - Cannot read AppID value for " & sKeyName GetAuthentication = -4 End If       Else MsgBox lRetVal & " - Cannot find exe name - " & sKeyName GetAuthentication = -5 End If       Exit Function QueryValueExExit: MsgBox lRetVal & " - Unexpected error" GetAuthentication = -7 Exit Function QueryValueExError: Resume QueryValueExExit End Function  You can now call this function from anywhere within the project.  Add the call to GetAuthentication to your project using the following syntax:

     Dim iSetAuth As Integer iSetAuth = GetAuthentication("YourDCOMServer.YourFirstClass") If iSetAuth < 1 Then MsgBox "Error retrieving authentication level: " & iSetAuth End If  Change the parameter to the name of your remote server's first class. The function will return an integer less than zero if an error occurred, a 1 for No authentication, or a 2 for Connect authentication.