VB and VBA Users Source Code: Validating a users windows login credentials using SSPI
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Validating a users windows login credentials using SSPI
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Thursday, October 17, 2002
Hits:
2338
Category:
Networks
Article:
The code below can be used to validate a users windows account login. No special permissions are required on the users box to run this code. Option Explicit Private Const HEAP_ZERO_MEMORY = &H8, SEC_WINNT_AUTH_IDENTITY_ANSI = &H1, SECBUFFER_TOKEN = &H2 Private Const SECURITY_NATIVE_DREP = &H10, SECPKG_CRED_INBOUND = &H1, SECPKG_CRED_OUTBOUND = &H2 Private Const SEC_I_CONTINUE_NEEDED = &H90312, SEC_I_COMPLETE_NEEDED = &H90313, 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 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 dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId 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 NT4QuerySecurityPackageInfo Lib "security" Alias "QuerySecurityPackageInfoA" (ByVal PackageName As String, ByRef pPackageInfo As Long) As Long Private Declare Function QuerySecurityPackageInfo Lib "secur32" Alias "QuerySecurityPackageInfoA" (ByVal PackageName As String, ByRef pPackageInfo As Long) As Long Private Declare Function NT4FreeContextBuffer Lib "security" Alias "FreeContextBuffer" (ByVal pvContextBuffer As Long) As Long Private Declare Function FreeContextBuffer Lib "secur32" (ByVal pvContextBuffer As Long) As Long Private Declare Function NT4InitializeSecurityContext Lib "security" Alias "InitializeSecurityContextA" (ByRef phCredential As SecHandle, ByRef phContext As SecHandle, ByVal pszTargetName As Long, ByVal fContextReq As Long, ByVal Reserved1 As Long, ByVal TargetDataRep As Long, ByRef pInput As SecBufferDesc, ByVal Reserved2 As Long, ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function InitializeSecurityContext Lib "secur32" Alias "InitializeSecurityContextA" (ByRef phCredential As SecHandle, ByRef phContext As SecHandle, ByVal pszTargetName As Long, ByVal fContextReq As Long, ByVal Reserved1 As Long, ByVal TargetDataRep As Long, ByRef pInput As SecBufferDesc, ByVal Reserved2 As Long, ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function NT4InitializeSecurityContext2 Lib "security" Alias "InitializeSecurityContextA" (ByRef phCredential As SecHandle, ByVal phContext As Long, ByVal pszTargetName As Long, ByVal fContextReq As Long, ByVal Reserved1 As Long, ByVal TargetDataRep As Long, ByVal pInput As Long, ByVal Reserved2 As Long, ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function InitializeSecurityContext2 Lib "secur32" Alias "InitializeSecurityContextA" (ByRef phCredential As SecHandle, ByVal phContext As Long, ByVal pszTargetName As Long, ByVal fContextReq As Long, ByVal Reserved1 As Long, ByVal TargetDataRep As Long, ByVal pInput As Long, ByVal Reserved2 As Long, ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function NT4AcquireCredentialsHandle Lib "security" Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, ByVal pszPackage As String, ByVal fCredentialUse As Long, ByVal pvLogonId As Long, ByRef pAuthData As SEC_WINNT_AUTH_IDENTITY, ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, ByRef phCredential As SecHandle, ByRef 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, ByRef pAuthData As SEC_WINNT_AUTH_IDENTITY, ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function NT4AcquireCredentialsHandle2 Lib "security" Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, ByVal pszPackage As String, ByVal fCredentialUse As Long, ByVal pvLogonId As Long, ByVal pAuthData As Long, ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function AcquireCredentialsHandle2 Lib "secur32" Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, ByVal pszPackage As String, ByVal fCredentialUse As Long, ByVal pvLogonId As Long, ByVal pAuthData As Long, ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function NT4AcceptSecurityContext Lib "security" Alias "AcceptSecurityContext" (ByRef phCredential As SecHandle, ByRef phContext As SecHandle, ByRef pInput As SecBufferDesc, ByVal fContextReq As Long, ByVal TargetDataRep As Long, ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function AcceptSecurityContext Lib "secur32" (ByRef phCredential As SecHandle, ByRef phContext As SecHandle, ByRef pInput As SecBufferDesc, ByVal fContextReq As Long, ByVal TargetDataRep As Long, ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function NT4AcceptSecurityContext2 Lib "security" Alias "AcceptSecurityContext" (ByRef phCredential As SecHandle, ByVal phContext As Long, ByRef pInput As SecBufferDesc, ByVal fContextReq As Long, ByVal TargetDataRep As Long, ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function AcceptSecurityContext2 Lib "secur32" Alias "AcceptSecurityContext" (ByRef phCredential As SecHandle, ByVal phContext As Long, ByRef pInput As SecBufferDesc, ByVal fContextReq As Long, ByVal TargetDataRep As Long, ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long Private Declare Function NT4CompleteAuthToken Lib "security" Alias "CompleteAuthToken" (ByRef phContext As SecHandle, ByRef pToken As SecBufferDesc) As Long Private Declare Function CompleteAuthToken Lib "secur32" (ByRef phContext As SecHandle, ByRef pToken As SecBufferDesc) As Long Private Declare Function NT4DeleteSecurityContext Lib "security" Alias "DeleteSecurityContext" (ByRef phContext As SecHandle) As Long Private Declare Function DeleteSecurityContext Lib "secur32" (ByRef phContext As SecHandle) As Long Private Declare Function NT4FreeCredentialsHandle Lib "security" Alias "FreeCredentialsHandle" (ByRef phContext As SecHandle) As Long Private Declare Function FreeCredentialsHandle Lib "secur32" (ByRef phContext As SecHandle) 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 GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer Private zbNT4 As Boolean 'Purpose : Checks the username and password are a valid login. 'Inputs : sUserName The username for the account to check ' sPassword The password for the account to check ' [sDomain] If omitted uses the local account database, else uses specified domain 'Outputs : Returns True if the password and user name are valid. 'Author : Andrew Baker 'Date : 25/03/2000 'Notes : Public Function ValidateUser(sUserName As String, sPassword As String, Optional sDomain As String = vbNullString) As Boolean Dim lSPI As Long, lMaxToken As Long Dim tSPI As SecPkgInfo Dim lClientBuf As Long Dim lServerBuf As Long Dim tAuth As SEC_WINNT_AUTH_IDENTITY Dim tAuthClient As AUTH_SEQ Dim tAuthServer As AUTH_SEQ Dim lIn As Long Dim lOut As Long Dim bDone As Boolean Dim tOSInfo As OSVERSIONINFO 'Default to false ValidateUser = False If Len(sPassword) = 0 Then 'Don't allow blanks passwords Exit Function End If 'Determine if system is Windows NT (version 4.0 or earlier) tOSInfo.dwOSVersionInfoSize = Len(tOSInfo) tOSInfo.szCSDVersion = Space$(128) GetVersionExA tOSInfo zbNT4 = (tOSInfo.dwPlatformId = VER_PLATFORM_WIN32_NT And tOSInfo.dwMajorVersion <= 4) 'Get the max token size If zbNT4 Then NT4QuerySecurityPackageInfo "NTLM", lSPI Else QuerySecurityPackageInfo "NTLM", lSPI End If CopyMemory tSPI, ByVal lSPI, Len(tSPI) lMaxToken = tSPI.cbMaxToken If zbNT4 Then NT4FreeContextBuffer lSPI Else FreeContextBuffer lSPI End If 'Allocate buffers for client and server messages lClientBuf = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, lMaxToken) If lClientBuf = 0 Then GoTo ExitFunc End If lServerBuf = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, lMaxToken) If lServerBuf = 0 Then GoTo ExitFunc End If 'Initialize authentication structure tAuth.Domain = sDomain tAuth.DomainLength = Len(sDomain) tAuth.User = sUserName tAuth.UserLength = Len(sUserName) tAuth.Password = sPassword tAuth.PasswordLength = Len(sPassword) tAuth.Flags = SEC_WINNT_AUTH_IDENTITY_ANSI 'Prepare client message (negotiate). lOut = lMaxToken If Not zGenClientContext(tAuthClient, tAuth, 0, 0, lClientBuf, lOut, bDone) Then GoTo ExitFunc End If 'Prepare server message (challenge) . lIn = lOut lOut = lMaxToken If Not zGenServerContext(tAuthServer, lClientBuf, lIn, lServerBuf, lOut, bDone) Then 'Most likely failure: AcceptServerContext fails with SEC_E_LOGON_DENIED in the case of bad szUser or szPassword. 'Unexpected Result: Logon will succeed if you pass in a bad user and the guest account is enabled in the specified Domain. GoTo ExitFunc End If 'Prepare client message (authenticate) lIn = lOut lOut = lMaxToken If Not zGenClientContext(tAuthClient, tAuth, lServerBuf, lIn, lClientBuf, lOut, bDone) Then GoTo ExitFunc End If 'Prepare server message (authentication) lIn = lOut lOut = lMaxToken If Not zGenServerContext(tAuthServer, lClientBuf, lIn, lServerBuf, lOut, bDone) Then GoTo ExitFunc End If 'Validated account ValidateUser = True ExitFunc: 'Free resources If tAuthClient.fHaveCtxtHandle Then If zbNT4 Then NT4DeleteSecurityContext tAuthClient.hctxt Else DeleteSecurityContext tAuthClient.hctxt End If End If If tAuthClient.fHaveCredHandle Then If zbNT4 Then NT4FreeCredentialsHandle tAuthClient.hcred Else FreeCredentialsHandle tAuthClient.hcred End If End If If tAuthServer.fHaveCtxtHandle Then If zbNT4 Then NT4DeleteSecurityContext tAuthServer.hctxt Else DeleteSecurityContext tAuthServer.hctxt End If End If If tAuthServer.fHaveCredHandle Then If zbNT4 Then NT4FreeCredentialsHandle tAuthServer.hcred Else FreeCredentialsHandle tAuthServer.hcred End If End If If lClientBuf <> 0 Then HeapFree GetProcessHeap(), 0, lClientBuf End If If lServerBuf <> 0 Then HeapFree GetProcessHeap(), 0, lServerBuf End If End Function Private Function zGenClientContext(ByRef tAuthSeq As AUTH_SEQ, ByRef tAuthIdentity As SEC_WINNT_AUTH_IDENTITY, ByVal lIn As Long, ByVal lCBIn As Long, ByVal lOut As Long, ByRef lCBOut As Long, ByRef bDone As Boolean) As Boolean Dim lRetVal As Long Dim tsExpiry As TimeStamp Dim tSecBufferOutDesc As SecBufferDesc Dim tSecBufferOut As SecBuffer Dim tSecBufferInDesc As SecBufferDesc Dim tSecBufferIn As SecBuffer Dim lContextAttr As Long zGenClientContext = False If Not tAuthSeq.fInitialized Then If zbNT4 Then lRetVal = NT4AcquireCredentialsHandle(0&, "NTLM", SECPKG_CRED_OUTBOUND, 0&, tAuthIdentity, 0&, 0&, tAuthSeq.hcred, tsExpiry) Else lRetVal = AcquireCredentialsHandle(0&, "NTLM", SECPKG_CRED_OUTBOUND, 0&, tAuthIdentity, 0&, 0&, tAuthSeq.hcred, tsExpiry) End If If lRetVal < 0 Then Exit Function End If tAuthSeq.fHaveCredHandle = True End If 'Prepare output buffer tSecBufferOutDesc.ulVersion = 0 tSecBufferOutDesc.cBuffers = 1 tSecBufferOutDesc.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, Len(tSecBufferOut)) tSecBufferOut.cbBuffer = lCBOut tSecBufferOut.BufferType = SECBUFFER_TOKEN tSecBufferOut.pvBuffer = lOut CopyMemory ByVal tSecBufferOutDesc.pBuffers, tSecBufferOut, Len(tSecBufferOut) 'Prepare input buffer If tAuthSeq.fInitialized Then tSecBufferInDesc.ulVersion = 0 tSecBufferInDesc.cBuffers = 1 tSecBufferInDesc.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, Len(tSecBufferIn)) tSecBufferIn.cbBuffer = lCBIn tSecBufferIn.BufferType = SECBUFFER_TOKEN tSecBufferIn.pvBuffer = lIn CopyMemory ByVal tSecBufferInDesc.pBuffers, tSecBufferIn, Len(tSecBufferIn) End If If tAuthSeq.fInitialized Then If zbNT4 Then lRetVal = NT4InitializeSecurityContext(tAuthSeq.hcred, tAuthSeq.hctxt, 0&, 0, 0, SECURITY_NATIVE_DREP, tSecBufferInDesc, 0, tAuthSeq.hctxt, tSecBufferOutDesc, lContextAttr, tsExpiry) Else lRetVal = InitializeSecurityContext(tAuthSeq.hcred, tAuthSeq.hctxt, 0&, 0, 0, SECURITY_NATIVE_DREP, tSecBufferInDesc, 0, tAuthSeq.hctxt, tSecBufferOutDesc, lContextAttr, tsExpiry) End If Else If zbNT4 Then lRetVal = NT4InitializeSecurityContext2(tAuthSeq.hcred, 0&, 0&, 0, 0, SECURITY_NATIVE_DREP, 0&, 0, tAuthSeq.hctxt, tSecBufferOutDesc, lContextAttr, tsExpiry) Else lRetVal = InitializeSecurityContext2(tAuthSeq.hcred, 0&, 0&, 0, 0, SECURITY_NATIVE_DREP, 0&, 0, tAuthSeq.hctxt, tSecBufferOutDesc, lContextAttr, tsExpiry) End If End If If lRetVal < 0 Then GoTo ExitFunc End If tAuthSeq.fHaveCtxtHandle = True 'If necessary, complete token If lRetVal = SEC_I_COMPLETE_NEEDED Or lRetVal = SEC_I_COMPLETE_AND_CONTINUE Then 'Complete token If zbNT4 Then lRetVal = NT4CompleteAuthToken(tAuthSeq.hctxt, tSecBufferOutDesc) Else lRetVal = CompleteAuthToken(tAuthSeq.hctxt, tSecBufferOutDesc) End If If lRetVal < 0 Then GoTo ExitFunc End If End If CopyMemory tSecBufferOut, ByVal tSecBufferOutDesc.pBuffers, Len(tSecBufferOut) lCBOut = tSecBufferOut.cbBuffer If Not tAuthSeq.fInitialized Then tAuthSeq.fInitialized = True End If bDone = Not (lRetVal = SEC_I_CONTINUE_NEEDED Or lRetVal = SEC_I_COMPLETE_AND_CONTINUE) zGenClientContext = True ExitFunc: 'Free resources If tSecBufferOutDesc.pBuffers <> 0 Then HeapFree GetProcessHeap(), 0, tSecBufferOutDesc.pBuffers End If If tSecBufferInDesc.pBuffers <> 0 Then HeapFree GetProcessHeap(), 0, tSecBufferInDesc.pBuffers End If End Function Private Function zGenServerContext(ByRef tAuthSeq As AUTH_SEQ, ByVal lIn As Long, ByVal lCBIn As Long, ByVal lOut As Long, ByRef lCBOut As Long, ByRef bDone As Boolean) As Boolean Dim lRetVal As Long Dim tTimeStamp As TimeStamp Dim tSecBufferOutDesc As SecBufferDesc Dim tSecBufferOut As SecBuffer Dim tSecBufferInDesc As SecBufferDesc Dim tSecBufferIn As SecBuffer Dim lContextAttr As Long zGenServerContext = False If Not tAuthSeq.fInitialized Then If zbNT4 Then lRetVal = NT4AcquireCredentialsHandle2(0&, "NTLM", SECPKG_CRED_INBOUND, 0&, 0&, 0&, 0&, tAuthSeq.hcred, tTimeStamp) Else lRetVal = AcquireCredentialsHandle2(0&, "NTLM", SECPKG_CRED_INBOUND, 0&, 0&, 0&, 0&, tAuthSeq.hcred, tTimeStamp) End If If lRetVal < 0 Then Exit Function End If tAuthSeq.fHaveCredHandle = True End If 'Prepare output buffer tSecBufferOutDesc.ulVersion = 0 tSecBufferOutDesc.cBuffers = 1 tSecBufferOutDesc.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, Len(tSecBufferOut)) tSecBufferOut.cbBuffer = lCBOut tSecBufferOut.BufferType = SECBUFFER_TOKEN tSecBufferOut.pvBuffer = lOut CopyMemory ByVal tSecBufferOutDesc.pBuffers, tSecBufferOut, Len(tSecBufferOut) 'Prepare input buffer tSecBufferInDesc.ulVersion = 0 tSecBufferInDesc.cBuffers = 1 tSecBufferInDesc.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, Len(tSecBufferIn)) tSecBufferIn.cbBuffer = lCBIn tSecBufferIn.BufferType = SECBUFFER_TOKEN tSecBufferIn.pvBuffer = lIn CopyMemory ByVal tSecBufferInDesc.pBuffers, tSecBufferIn, Len(tSecBufferIn) If tAuthSeq.fInitialized Then If zbNT4 Then lRetVal = NT4AcceptSecurityContext(tAuthSeq.hcred, tAuthSeq.hctxt, tSecBufferInDesc, 0, SECURITY_NATIVE_DREP, tAuthSeq.hctxt, tSecBufferOutDesc, lContextAttr, tTimeStamp) Else lRetVal = AcceptSecurityContext(tAuthSeq.hcred, tAuthSeq.hctxt, tSecBufferInDesc, 0, SECURITY_NATIVE_DREP, tAuthSeq.hctxt, tSecBufferOutDesc, lContextAttr, tTimeStamp) End If Else If zbNT4 Then lRetVal = NT4AcceptSecurityContext2(tAuthSeq.hcred, 0&, tSecBufferInDesc, 0, SECURITY_NATIVE_DREP, tAuthSeq.hctxt, tSecBufferOutDesc, lContextAttr, tTimeStamp) Else lRetVal = AcceptSecurityContext2(tAuthSeq.hcred, 0&, tSecBufferInDesc, 0, SECURITY_NATIVE_DREP, tAuthSeq.hctxt, tSecBufferOutDesc, lContextAttr, tTimeStamp) End If End If If lRetVal < 0 Then GoTo ExitFunc End If tAuthSeq.fHaveCtxtHandle = True 'If necessary, complete token If lRetVal = SEC_I_COMPLETE_NEEDED Or lRetVal = SEC_I_COMPLETE_AND_CONTINUE Then 'Complete token If zbNT4 Then lRetVal = NT4CompleteAuthToken(tAuthSeq.hctxt, tSecBufferOutDesc) Else lRetVal = CompleteAuthToken(tAuthSeq.hctxt, tSecBufferOutDesc) End If If lRetVal < 0 Then GoTo ExitFunc End If End If CopyMemory tSecBufferOut, ByVal tSecBufferOutDesc.pBuffers, Len(tSecBufferOut) lCBOut = tSecBufferOut.cbBuffer If Not tAuthSeq.fInitialized Then tAuthSeq.fInitialized = True End If bDone = Not (lRetVal = SEC_I_CONTINUE_NEEDED Or lRetVal = SEC_I_COMPLETE_AND_CONTINUE) zGenServerContext = True ExitFunc: 'Free resources If tSecBufferOutDesc.pBuffers <> 0 Then HeapFree GetProcessHeap(), 0, tSecBufferOutDesc.pBuffers End If If tSecBufferInDesc.pBuffers <> 0 Then HeapFree GetProcessHeap(), 0, tSecBufferInDesc.pBuffers End If End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
