HOWTO: Set DCOM Client's Authentication Level Programmatically

• Microsoft Visual Basic Control Creation, Learning, Professional, and Enterprise Editions for Windows, version 5.0
  on the following platforms: NT, Win95, Win98

SUMMARY

There are specific network situations where you will need to specify DCOM security settings on a remote client machine. 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. This eliminates the need to have DCOMCNFG.EXE run on the DCOM client machines. Please see the DCOM95 release notes for more information regarding this feature. Go to www.microsoft.com\com and select the DCOM link.

MORE INFORMATION

This article contains a function that can be used to set a DCOM client's remote Authentication Level from within a Visual Basic program.

The SetAuthentication function:

By providing this function with your DCOM server's first class name and your authentication level request (1-None or 2-Connect), you can set up the security for your client from within setup1.vbp after the exe gets registered.

This will enable your security settings for the client before it has ever executed on the client machine. Note that setting this value from within the client process will not affect security until the client is restarted. Therefore, it is recommended using this function in your setup program, as this sample demonstrates. This will have no effect on Windows NT 4.0. This functionality will be available in later versions of Windows NT.

NOTE: You should always make a backup copy of the Setup1 folder and its associated files before modifying the project for a custom set up. Setup Wizard reads the setup1.vbp project from the setup1 folder. If this is not done, your set up files will be permanently modified.

1. Make a copy of the ...\DevStudio\VB\setupkit\setup1 folder and rename it Setuporg (unless you have already done so).



2. Open the project ...\DevStudio\VB\setupkit\setup1\Setup1.vbp.



3. Add the following code to a new standard module in setup1.vbp:
   

   
         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 SetAuthentication _
         (ClassName As String, AuthLevel As Integer) 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 myclsid As String
   
          If ClassName = "" Then
             SetAuthentication = -1 'invalid classname
             Exit Function
          End If
          If (AuthLevel < 1) Or (AuthLevel > 2) Then
             SetAuthentication = -2 'invalid Authentication Level
              Exit Function
          End If
          sKeyName = ClassName
          lRetVal = RegOpenKey(HKEY_CLASSES_ROOT, sKeyName, hKey)
          If lRetVal = ERROR_SUCCESS Then
             lpData = Space$(40)
             lpcbData = Len(lpData) + 1
             lpType = REG_SZ
             lRetVal = RegQueryValue(hKey, "CLSID", lpData, lpcbData)
             If lRetVal = ERROR_NONE Then
                myclsid = Left$(lpData, lpcbData - 1)
                RegCloseKey (hKey)
                sKeyName = "AppID\" & myclsid
                lRetVal = RegOpenKeyEx(HKEY_CLASSES_ROOT, sKeyName, 0&, _
                KEY_ALL_ACCESS, hKey)
                If lRetVal = ERROR_SUCCESS Then
                   lpData2 = CLng(AuthLevel)
                   lpcbData = Len(lpData2)
                   lpType = REG_DWORD
                   lRetVal = RegSetValueEx(hKey, "AuthenticationLevel", _
                    0&, lpType, lpData2, lpcbData)
                   If lRetVal = ERROR_NONE Then
                      SetAuthentication = AuthLevel
                   Else
                      SetAuthentication = -3 'Unable to write new auth level
                   End If
                Else
                  SetAuthentication = -4 'Cannot find CLSID for sKeyName
                End If
                RegCloseKey (hKey)
             Else
               SetAuthentication = -5 'Cannot read CLSID value for sKeyName
             End If
          Else
             SetAuthentication = -6 'Cannot find class name sKeyName
          End If
          Exit Function
         QueryValueExExit:
          SetAuthentication = -7 'Unexpected error
          Exit Function
         QueryValueExError:
          Resume QueryValueExExit
          End Function 




4. You can now call this function from within the setup project. You should use the SetAuthentication function after the major portion of setup has completed.



5. In the Form_Load event of Setup1.frm you will find a label named ExitSetup:. Add the call to SetAuthentication just above this label using the following syntax:
   

   
         '** added for DCOM security setting on client machine **
         'write custom authentication level
          Dim iSetAuth As Integer
          Dim auth as Integer
          auth = 1 'none
          iSetAuth = SetAuthentication("YourDCOMServer.YourFirstClass", auth)
          If iSetAuth <> auth Then
             MsgError "Error setting DCOM authentication level: " _
              & iSetAuth, vbExclamation Or vbOKOnly, gstrTitle
             ExitSetup Me, gintRET_FATAL 'abort setup
          End If
   
          ExitSetup: 'existing label in setup1.frm.
    




6. Change the first parameter to the name of your server's first class.



7. Set the second parameter to 2 if you want to use Connect authentication.



8. Save and compile the project and run Setup Wizard as usual.



9. If an error occurs, then calling ExitSetup with the gintRET_FATAL constant will safely abort the entire setup. You can choose to handle the error any way you deem appropriate.



10. Your custom setup will now include client side security and should not require the use or installation of DCOMCNFG.EXE.



11. Rename the Setuporg directory to Setup1.

REFERENCES

There is a complimentary article that is the reverse of this function and named GetAuthentication. This function will return the current authentication level for a remotely-registered DCOM server. For more information regarding the GetAuthentication function please see the following article in the Microsoft Knowledge Base:

Q186274 : HOWTO: Retrieve a DCOM Client's Authentication Level

Q183607 : HOWTO: Configure DCOM for Visual Basic 5.0 Using DCOMCNFG.EXE

Q175510 : FILE: VB5 DCOM Demonstration using Callbacks and WithEvents

Additional query words: DCOMCNFG.EXE permissions security "error 70" "error 429" kbDSupport kbVBp500
kbDCOM kbdss kbVBp

Keywords : kbGrpVB
Version : WINDOWS:5.0
Platform : WINDOWS
Issue type : kbhowto