Visual Basic Network Services

InitializeSecurityContext: Authenticate User via the NT Challenge Process
     
Posted:   Saturday March 16, 2002
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   As coded, Windows 2000, Windows XP.
Author:   VBnet - Randy Birch, MSKB
     

Related:  

IsUserAnAdmin: Determine if the Current User is an Administrator
LookupAccountName: Verify a User's Account
LookupAccountSid: Determine if the Current Process is Running Under Admin Account
OpenUserBrowser: Add Selection of Users and Groups
     
 Prerequisites
Network or DUN connection.

Windows users in a corporate environment are familiar with the NT Challenge procedure .. they call it logging on.  In a nutshell, the NT Challenge attempts to confirm the credentials entered by the user against security information on the login machine - the local workstation or domain server. When the challenge is successful, the login continues; when it is not, the user's attempted login count is incremented by one until the administrator-defined account lockout point is reached.

The MSKB provides a rather complex and convoluted example of using InitializeSecurityContext, QuerySecurityPackageInfo, AcquireCredentialsHandle, AcceptSecurityContext to perform a NT Challenge. This demo, although still quite involved, attempts to trim some of the fat (not to mention the GoTo's) from the MSKB code to present a method that will validate the user against either the local workstation or a domain controller.

There are three issues to consider with the following code: 

First, because MS decided, on NT4, to implement the APIs in a different core DLL than used on 9x through XP, an application wanting to perform the challenge must be coded to accommodate the APIs in use on the calling system. To use the code below on NT4, the references to "secur32" (secur32.dll) in the API declarations need to be changed to "security" (security.dll), and the code in the IsWin2000Plus() function downgraded to return True when running NT4 (OSV.dwVerMajor = 4). 

The second issue I discovered concerns the passing domain name ... if the user name and password are both correct, the call returns True regardless of what is entered in the Domain box. This appears to be an anomaly of systems system where authentication is performed against the local user manager table for that machine. Several readers using true Windows 2000 and NT4 domains have verified the methods work as expected (with the declare change mentioned for NT4).

The third issue deals with Internationalization ... since the routine shown here uses the "A" versions of APIs rather than the "W" (wide) versions, usernames or passwords containing letters outside the norm for North American ANSI characters will not validate using this code. I do not have a "W" version of the routines available.

And now a word from the System Admin (aka the BOFH): The process of collecting credentials from a user-mode application can provide a possible security hole in a network computing environment (as well as being annoying to a user). The Unified Logon requirement (which specifies that the user should only have to type his or her credentials once, at the logon screen), was added to the Microsoft BackOffice logo requirements for these reasons. It is important to ascertain whether your application's design really must rely on asking for a user's complete credentials, or whether a more secure method of credential validation is not more appropriate, for example by reconfirming just the user name as shown in LookupAccountName: Verify a User's Account . Regardless of the validation, it is strongly recommended that all developers consult both the local system administrator as well as security documentation in the Platform SDK for guidance.

 BAS Module Code
None.

 Form Code
To a form add a command button (Command1), a label (Label1) for the authentication result, and three text boxes (Text1, Text2, Text3), along with the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const SEC_E_OK = 0
Private Const HEAP_ZERO_MEMORY = &H8
Private Const SEC_WINNT_AUTH_IDENTITY_ANSI = &H1
Private Const SECBUFFER_TOKEN = &H2
Private Const SECURITY_NATIVE_DREP = &H10
Private Const SECPKG_CRED_INBOUND = &H1
Private Const SECPKG_CRED_OUTBOUND = &H2
Private Const SEC_I_CONTINUE_NEEDED = &H90312
Private Const SEC_I_COMPLETE_NEEDED = &H90313
Private Const SEC_I_COMPLETE_AND_CONTINUE = &H90314
Private Const VER_PLATFORM_WIN32_NT = &H2

Private Type SecPkgInfo
   fCapabilities As Long
   wVersion As Integer
   wRPCID As Integer
   cbMaxToken As Long
   Name As Long
   Comment As Long
End Type

Private Type SecHandle
    dwLower As Long
    dwUpper As Long
End Type

Private Type AUTH_SEQ
   fInitialized As Boolean
   fHaveCredHandle As Boolean
   fHaveCtxtHandle As Boolean
   hcred As SecHandle
   hctxt As SecHandle
End Type

Private Type SEC_WINNT_AUTH_IDENTITY
   User As String
   UserLength As Long
   Domain As String
   DomainLength As Long
   Password As String
   PasswordLength As Long
   Flags As Long
End Type

Private Type SEC_WINNT_AUTH_IDENTITYL
   User As Long
   UserLength As Long
   Domain As Long
   DomainLength As Long
   Password As Long
   PasswordLength As Long
   Flags As Long
End Type

Private Type TimeStamp
   LowPart As Long
   HighPart As Long
End Type

Private Type SecBuffer
   cbBuffer As Long
   BufferType As Long
   pvBuffer As Long
End Type

Private Type SecBufferDesc
   ulVersion As Long
   cBuffers As Long
   pBuffers As Long
End Type

Private Type OSVERSIONINFO
  OSVSize         As Long
  dwVerMajor      As Long
  dwVerMinor      As Long
  dwBuildNumber   As Long
  PlatformID      As Long
  szCSDVersion    As String * 128
End Type

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)
   
Private Declare Function CompleteAuthToken Lib "secur32" _
  (ByRef phContext As SecHandle, _
   ByRef pToken As SecBufferDesc) As Long

Private Declare Function DeleteSecurityContext Lib "secur32" _
  (ByRef phContext As SecHandle) As Long

Private Declare Function FreeCredentialsHandle Lib "secur32" _
  (ByRef phContext As SecHandle) As Long
   
Private Declare Function FreeContextBuffer Lib "secur32" _
  (ByVal pvContextBuffer As Long) As Long

Private Declare Function GetProcessHeap Lib "kernel32" () As Long

Private Declare Function HeapAlloc Lib "kernel32" _
  (ByVal hHeap As Long, _
   ByVal dwFlags As Long, _
   ByVal dwBytes As Long) As Long

Private Declare Function HeapFree Lib "kernel32" _
  (ByVal hHeap As Long, _
   ByVal dwFlags As Long, _
   ByVal lpMem As Long) As Long

Private Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" _
  (lpVersionInformation As OSVERSIONINFO) As Long
   
Private Declare Function QuerySecurityPackageInfo Lib "secur32" _
   Alias "QuerySecurityPackageInfoA" _
  (ByVal PackageName As String, _
   ByRef pPackageInfo As Long) As Long

Private Declare Function InitializeSecurityContext Lib "secur32" _
   Alias "InitializeSecurityContextA" _
  (phCredential As Any, _
   phContext As Any, _
   ByVal pszTargetName As Long, _
   ByVal fContextReq As Long, _
   ByVal Reserved1 As Long, _
   ByVal TargetDataRep As Long, _
   pInput As Any, _
   ByVal Reserved2 As Long, _
   phNewContext As SecHandle, _
   pOutput As SecBufferDesc, _
   pfContextAttr As Long, _
   ptsExpiry As TimeStamp) As Long

Private Declare Function AcquireCredentialsHandle Lib "secur32" _
   Alias "AcquireCredentialsHandleA" _
  (ByVal pszPrincipal As Long, _
   ByVal pszPackage As String, _
   ByVal fCredentialUse As Long, _
   ByVal pvLogonId As Long, _
   pAuthData As Any, _
   ByVal pGetKeyFn As Long, _
   ByVal pvGetKeyArgument As Long, _
   phCredential As SecHandle, _
   ptsExpiry As TimeStamp) As Long

Private Declare Function AcceptSecurityContext Lib "secur32" _
   (phCredential As SecHandle, _
   phContext As Any, _
   pInput As SecBufferDesc, _
   ByVal fContextReq As Long, _
   ByVal TargetDataRep As Long, _
   phNewContext As SecHandle, _
   pOutput As SecBufferDesc, _
   pfContextAttr As Long, _
   ptsExpiry As TimeStamp) As Long



Private Sub Form_Load()

   Label1.Caption = ""
   Text1.Text = ""           'domain/workstation
   Text2.Text = ""           'user name
   Text3.Text = ""           'password

End Sub


Private Sub Command1_Click()
   
   Label1.Caption = AuthenticateUser(Text1.Text, _
                                     Text2.Text, _
                                     Text3.Text)

End Sub


Private Sub Text3_KeyPress(KeyAscii As Integer)

   If KeyAscii = vbKeyReturn Then
      KeyAscii = 0
      Command1.Value = True
   End If
   
End Sub


Private Function GetClientContext(AuthSeq As AUTH_SEQ, _
                                  AuthIdentity As SEC_WINNT_AUTH_IDENTITY, _
                                  ByVal pIn As Long, _
                                  ByVal cbIn As Long, _
                                  ByVal pOut As Long, _
                                  cbOut As Long, _
                                  fDone As Boolean) As Boolean

   Dim sbdOut        As SecBufferDesc
   Dim sbOut         As SecBuffer
   Dim sbdIn         As SecBufferDesc
   Dim sbIn          As SecBuffer
   Dim tsExpiry      As TimeStamp
   Dim fContextAttr  As Long
   Dim success       As Long
   
   If Not AuthSeq.fInitialized Then
      
      If AcquireCredentialsHandle(0&, _
                                  "NTLM", _
                                  SECPKG_CRED_OUTBOUND, _
                                   0&, _
                                  AuthIdentity, _
                                  0&, _
                                  0&, _
                                  AuthSeq.hcred, _
                                  tsExpiry) Then
               
        'failed to get credentials, so bail
         GetClientContext = False
         Exit Function
         
      Else
      
         AuthSeq.fHaveCredHandle = True
      
      End If  'If AcquireCredentialsHandle
   End If  'If Not AuthSeq.fInitialized

  'Prepare the output buffer
   With sbdOut
      .ulVersion = 0
      .cBuffers = 1
      .pBuffers = HeapAlloc(GetProcessHeap(), _
                            HEAP_ZERO_MEMORY, _
                            Len(sbOut))
   End With
   
   With sbOut
      .cbBuffer = cbOut
      .BufferType = SECBUFFER_TOKEN
      .pvBuffer = pOut
   End With
   
   CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)
   
  'attempt to establish a security context
  'between the server and a remote client. 
   If AuthSeq.fInitialized Then
      
      With sbdIn
         .ulVersion = 0
         .cBuffers = 1
         .pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
            Len(sbIn))
      End With
   
      With sbIn
         .cbBuffer = cbIn
         .BufferType = SECBUFFER_TOKEN
         .pvBuffer = pIn
      End With
      
      CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)
   
      success = InitializeSecurityContext(AuthSeq.hcred, _
                                     AuthSeq.hctxt, _
                                     0&, _
                                      0, _
                                     0, _
                                     SECURITY_NATIVE_DREP, _
                                     sbdIn, _
                                     0, _
                                     AuthSeq.hctxt, _
                                     sbdOut, _
                                     fContextAttr, _
                                     tsExpiry)
               
               
   Else
      
         success = InitializeSecurityContext(AuthSeq.hcred, _
                                         ByVal 0&, _
                                         0&, _
                                         0, _
                                         0, _
                                         SECURITY_NATIVE_DREP, _
                                         0&, _
                                         0, _
                                         AuthSeq.hctxt, _
                                         sbdOut, _
                                         fContextAttr, _
                                         tsExpiry)
   End If  'If AuthSeq.fInitialized

   If success >= SEC_E_OK Then
   
     'the security context received from
     'the client was accepted. If an output
     'token was generated by the function,
     'it must be sent to the client process.
      AuthSeq.fHaveCtxtHandle = True

     'if a protocol (such as DCE) needs to
     'revise the security information after
     'the transport application has updated
     'some message parameters, pass it to
     'CompleteAuthToken
      If success = SEC_I_COMPLETE_NEEDED Or _
         success = SEC_I_COMPLETE_AND_CONTINUE Then
   
         If CompleteAuthToken(AuthSeq.hctxt, sbdOut) < SEC_E_OK Then
         
           'couldn't complete, so return false
            FreeMemory sbdOut.pBuffers
            FreeMemory sbdIn.pBuffers
            GetClientContext = False
            Exit Function
            
         End If  ' If CompleteAuthToken
                  
      End If  'If success

      CopyMemory sbOut, ByVal sbdOut.pBuffers, Len(sbOut)
      cbOut = sbOut.cbBuffer

      AuthSeq.fInitialized = True

      fDone = Not (success = SEC_I_CONTINUE_NEEDED Or _
                   success = SEC_I_COMPLETE_AND_CONTINUE)

      GetClientContext = True

   End If  'If success >= SEC_E_OK

   FreeMemory sbdOut.pBuffers
   FreeMemory sbdIn.pBuffers

End Function


Private Function GetServerContext(AuthSeq As AUTH_SEQ, _
                                  ByVal pIn As Long, _
                                  ByVal cbIn As Long, _
                                  ByVal pOut As Long, _
                                  cbOut As Long, _
                                  fDone As Boolean) As Boolean

   Dim sbdOut        As SecBufferDesc
   Dim sbOut         As SecBuffer
   Dim sbdIn         As SecBufferDesc
   Dim sbIn          As SecBuffer
   Dim tsExpiry      As TimeStamp
   Dim fContextAttr  As Long
   Dim success       As Long
   
   If Not AuthSeq.fInitialized Then
      
      If AcquireCredentialsHandle(0&, _
                                  "NTLM", _
                                  SECPKG_CRED_INBOUND, _
                                  0&, _
                                  ByVal 0&, _
                                  0&, _
                                  0&, _
                                  AuthSeq.hcred, _
                                  tsExpiry) Then
               
        'failed to get credentials, so bail
         GetServerContext = False
         Exit Function
         
      Else:
      
         AuthSeq.fHaveCredHandle = True
      
      End If  'If AcquireCredentialsHandle
   
   End If  'If Not AuthSeq.fInitialized


  'Prepare the output and input buffers
   With sbdOut
      .ulVersion = 0
      .cBuffers = 1
      .pBuffers = HeapAlloc(GetProcessHeap(), _
                            HEAP_ZERO_MEMORY, _
                            Len(sbOut))
   End With
   
   With sbOut
      .cbBuffer = cbOut
      .BufferType = SECBUFFER_TOKEN
      .pvBuffer = pOut
   End With
   
   With sbdIn
      .ulVersion = 0
      .cBuffers = 1
      .pBuffers = HeapAlloc(GetProcessHeap(), _
                            HEAP_ZERO_MEMORY, _
                            Len(sbIn))
   End With
   
   With sbIn
      .cbBuffer = cbIn
      .BufferType = SECBUFFER_TOKEN
      .pvBuffer = pIn
   End With
      
   CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)
   CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)
   
  'attempt to establish a security context
   If AuthSeq.fInitialized Then
  
   
      success = AcceptSecurityContext(AuthSeq.hcred, _
                                      AuthSeq.hctxt, _
                                      sbdIn, _
                                      0, _
                                      SECURITY_NATIVE_DREP, _
                                      AuthSeq.hctxt, _
                                      sbdOut, _
                                      fContextAttr, _
                                      tsExpiry)
   Else
      
      success = AcceptSecurityContext(AuthSeq.hcred, _
                                      ByVal 0&, _
                                      sbdIn, _
                                      0, _
                                      SECURITY_NATIVE_DREP, _
                                      AuthSeq.hctxt, _
                                      sbdOut, _
                                      fContextAttr, _
                                      tsExpiry)

   End If  'If AuthSeq.fInitialized

   If success >= SEC_E_OK Then
   
     'the security context received from
     'the client was accepted. If an output
     'token was generated by the function,
     'it must be sent to the client process.
      AuthSeq.fHaveCtxtHandle = True

     'if a protocol (such as DCE) needs to
     'revise the security information after
     'the transport application has updated
     'some message parameters, pass it to
     'CompleteAuthToken
      If success = SEC_I_COMPLETE_NEEDED Or _
         success = SEC_I_COMPLETE_AND_CONTINUE Then
   
         If CompleteAuthToken(AuthSeq.hctxt, sbdOut) < SEC_E_OK Then
         
           'couldn't complete, so return false
            FreeMemory sbdOut.pBuffers
            FreeMemory sbdIn.pBuffers
            GetServerContext = False
            Exit Function
            
         End If  ' If CompleteAuthToken
                  
      End If  'If success

      CopyMemory sbOut, ByVal sbdOut.pBuffers, Len(sbOut)
      cbOut = sbOut.cbBuffer

      AuthSeq.fInitialized = True

      fDone = Not (success = SEC_I_CONTINUE_NEEDED Or _
                   success = SEC_I_COMPLETE_AND_CONTINUE)

      GetServerContext = True

   End If  'If success >= SEC_E_OK

   FreeMemory sbdOut.pBuffers
   FreeMemory sbdIn.pBuffers

End Function


Private Function AuthenticateUser(ByVal sDomain As String, _
                                  ByVal sUser As String, _
                                  ByVal sPassword As String) As Boolean

   Dim osinfo        As OSVERSIONINFO
   Dim authClient    As AUTH_SEQ
   Dim authServer    As AUTH_SEQ
   Dim swai          As SEC_WINNT_AUTH_IDENTITY
   Dim spi           As SecPkgInfo
   Dim ptrSpi        As Long
   Dim cbMaxToken    As Long
   Dim pClientBuf    As Long
   Dim pServerBuf    As Long
   Dim cbIn          As Long
   Dim cbOut         As Long
   Dim fDone         As Boolean


  'Determine if user's OS version
  'is Windows NT 5.0 or later
   If IsWinNT2000Plus() Then
   
     'Get max token size by passing to
     'QuerySecurityPackageInfo the name
     'of the security package to obtain
     'a pointer to a SECPKGINFO structure
     'containing security package information.
     '"NTLM" refers to "NT LAN Manager"
     'authentication, referred to as an
     '"NT Challenge"
      If QuerySecurityPackageInfo("NTLM", ptrSpi) = SEC_E_OK Then
      
         CopyMemory spi, ByVal ptrSpi, Len(spi)
         cbMaxToken = spi.cbMaxToken
         FreeContextBuffer ptrSpi
      
        'Allocate buffers for client
        'and server messages
         pClientBuf = HeapAlloc(GetProcessHeap(), _
                                HEAP_ZERO_MEMORY, _
                                cbMaxToken)
   
         If pClientBuf <> 0 Then

            pServerBuf = HeapAlloc(GetProcessHeap(), _
                                   HEAP_ZERO_MEMORY, _
                                   cbMaxToken)
         
            If pServerBuf <> 0 Then
       
              'Initialize authentication
              'identity structure
               With swai
                  .Domain = sDomain
                  .DomainLength = Len(sDomain)
                  .User = sUser
                  .UserLength = Len(sUser)
                  .Password = sPassword
                  .PasswordLength = Len(sPassword)
                  
                  'credentials passed are in ANSI
                  .Flags = SEC_WINNT_AUTH_IDENTITY_ANSI
               End With
         
              'Prepare the client message (negotiate)
               cbOut = cbMaxToken
               If GetClientContext(authClient, _
                                   swai, _
                                   0, _
                                   0, _
                                   pClientBuf, _
                                   cbOut, _
                                   fDone) Then
              
                 'Prepare the server message (challenge).
                 'Most likely failure: AcceptServerContext
                 'fails with SEC_E_LOGON_DENIED in the case
                 'of bad szUser or szPassword.
                 '
                 'Note that there can be an unexpected result:
                 'Validation will succeed if you
                 'pass in a bad username to the call
                 'when the guest account is enabled
                 'in the specified domain.
                  cbIn = cbOut
                  cbOut = cbMaxToken
                  
                  If GetServerContext(authServer, _
                                      pClientBuf, _
                                      cbIn, _
                                      pServerBuf, _
                                      cbOut, _
                                      fDone) Then
      
                    'Prepare client message (authenticate)
                     cbIn = cbOut
                     cbOut = cbMaxToken
                     
                     If GetClientContext(authClient, _
                                         swai, _
                                         pServerBuf, _
                                         cbIn, _
                                         pClientBuf, _
                                         cbOut, _
                                         fDone) Then
      
                       'Prepare server message (authenticate)
                        cbIn = cbOut
                        cbOut = cbMaxToken
                        If GetServerContext(authServer, _
                                            pClientBuf, _
                                            cbIn, _
                                            pServerBuf, _
                                            cbOut, _
                                            fDone) Then
         
                           AuthenticateUser = True

                        End If 'If GetServerContext(authServer
                     End If  'If GetClientContext(authClient
                  End If  'If GetServerContext(authServer
               End If  'If GetClientContext(authClient
            End If  'If pServerBuf <> 0
         End If  ' If pClientBuf <> 0
      End If  'If QuerySecurityPackageInfo <> 0

     'Clean up resources
      If authClient.fHaveCtxtHandle Then DeleteSecurityContext authClient.hctxt
      If authServer.fHaveCtxtHandle Then DeleteSecurityContext authServer.hctxt
      If authClient.fHaveCredHandle Then FreeCredentialsHandle authClient.hcred
      If authServer.fHaveCtxtHandle Then FreeCredentialsHandle authServer.hcred
      FreeMemory pClientBuf
      FreeMemory pServerBuf
      
   End If

End Function


Private Function IsWinNT2000Plus() As Boolean

  'returns True if running Win2000 or WinXP
   #If Win32 Then
  
      Dim OSV As OSVERSIONINFO
   
      OSV.OSVSize = Len(OSV)
   
      If GetVersionEx(OSV) = 1 Then
   
        'PlatformId contains a value representing the OS.
         IsWinNT2000Plus = (OSV.PlatformID = VER_PLATFORM_WIN32_NT) And _
                           (OSV.dwVerMajor >= 5)
      End If

   #End If

End Function


Private Sub FreeMemory(memblock As Long)

   If memblock <> 0 Then HeapFree GetProcessHeap(), 0, memblock
   
End Sub
 Comments

Q279815 shows the original code this demo is based on.


 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter