在VB中验证Windows和域用户

80酷酷网    80kuku.com

  windowSample Code
The following Visual Basic module contains a public function called SSPValidateUser(). This function attempts to validate the supplied user name, domain name, and password by using SSPI functions.

' Module Name: SSPLogon.bas
Option Explicit

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

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

Type SecHandle
dwLower As Long
dwUpper As Long
End Type

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

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

Type TimeStamp
LowPart As Long
HighPart As Long
End Type

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

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

Public 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

Dim g_NT4 As Boolean

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

Dim ss As Long
Dim tsExpiry As TimeStamp
Dim sbdOut As SecBufferDesc
Dim sbOut As SecBuffer
Dim sbdIn As SecBufferDesc
Dim sbIn As SecBuffer
Dim fContextAttr As Long

GenClientContext = False

If Not AuthSeq.fInitialized Then

If g_NT4 Then
ss = NT4AcquireCredentialsHandle(0&, "NTLM", _
SECPKG_CRED_OUTBOUND, 0&, AuthIdentity, 0&, 0&, _
AuthSeq.hcred, tsExpiry)
Else
ss = AcquireCredentialsHandle(0&, "NTLM", _
SECPKG_CRED_OUTBOUND, 0&, AuthIdentity, 0&, 0&, _
AuthSeq.hcred, tsExpiry)
End If

If ss < 0 Then
Exit Function
End If

AuthSeq.fHaveCredHandle = True

End If

' Prepare output buffer
sbdOut.ulVersion = 0
sbdOut.cBuffers = 1
sbdOut.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
Len(sbOut))

sbOut.cbBuffer = cbOut
sbOut.BufferType = SECBUFFER_TOKEN
sbOut.pvBuffer = pOut

CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)

' Prepare input buffer
If AuthSeq.fInitialized Then

sbdIn.ulVersion = 0
sbdIn.cBuffers = 1
sbdIn.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
Len(sbIn))

sbIn.cbBuffer = cbIn
sbIn.BufferType = SECBUFFER_TOKEN
sbIn.pvBuffer = pIn

CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)

End If

If AuthSeq.fInitialized Then

If g_NT4 Then
ss = NT4InitializeSecurityContext(AuthSeq.hcred, _
AuthSeq.hctxt, 0&, 0, 0, SECURITY_NATIVE_DREP, sbdIn, _
0, AuthSeq.hctxt, sbdOut, fContextAttr, tsExpiry)
Else
ss = InitializeSecurityContext(AuthSeq.hcred, _
AuthSeq.hctxt, 0&, 0, 0, SECURITY_NATIVE_DREP, sbdIn, _
0, AuthSeq.hctxt, sbdOut, fContextAttr, tsExpiry)
End If

Else

If g_NT4 Then
ss = NT4InitializeSecurityContext2(AuthSeq.hcred, 0&, 0&, _
0, 0, SECURITY_NATIVE_DREP, 0&, 0, AuthSeq.hctxt, _
sbdOut, fContextAttr, tsExpiry)
Else
ss = InitializeSecurityContext2(AuthSeq.hcred, 0&, 0&, _
0, 0, SECURITY_NATIVE_DREP, 0&, 0, AuthSeq.hctxt, _
sbdOut, fContextAttr, tsExpiry)
End If

End If

If ss < 0 Then
GoTo FreeResourcesAndExit
End If

AuthSeq.fHaveCtxtHandle = True

' If necessary, complete token
If ss = SEC_I_COMPLETE_NEEDED _
Or ss = SEC_I_COMPLETE_AND_CONTINUE Then

If g_NT4 Then
ss = NT4CompleteAuthToken(AuthSeq.hctxt, sbdOut)
Else
ss = CompleteAuthToken(AuthSeq.hctxt, sbdOut)
End If

If ss < 0 Then
GoTo FreeResourcesAndExit
End If

End If

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

If Not AuthSeq.fInitialized Then
AuthSeq.fInitialized = True
End If

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

GenClientContext = True

FreeResourcesAndExit:

If sbdOut.pBuffers <> 0 Then
HeapFree GetProcessHeap(), 0, sbdOut.pBuffers
End If

If sbdIn.pBuffers <> 0 Then
HeapFree GetProcessHeap(), 0, sbdIn.pBuffers
End If

End Function


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

Dim ss As Long
Dim tsExpiry As TimeStamp
Dim sbdOut As SecBufferDesc
Dim sbOut As SecBuffer
Dim sbdIn As SecBufferDesc
Dim sbIn As SecBuffer
Dim fContextAttr As Long

GenServerContext = False

If Not AuthSeq.fInitialized Then

If g_NT4 Then
ss = NT4AcquireCredentialsHandle2(0&, "NTLM", _
SECPKG_CRED_INBOUND, 0&, 0&, 0&, 0&, AuthSeq.hcred, _
tsExpiry)
Else
ss = AcquireCredentialsHandle2(0&, "NTLM", _
SECPKG_CRED_INBOUND, 0&, 0&, 0&, 0&, AuthSeq.hcred, _
tsExpiry)
End If

If ss < 0 Then
Exit Function
End If

AuthSeq.fHaveCredHandle = True

End If

' Prepare output buffer
sbdOut.ulVersion = 0
sbdOut.cBuffers = 1
sbdOut.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
Len(sbOut))

sbOut.cbBuffer = cbOut
sbOut.BufferType = SECBUFFER_TOKEN
sbOut.pvBuffer = pOut

CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)

' Prepare input buffer
sbdIn.ulVersion = 0
sbdIn.cBuffers = 1
sbdIn.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
Len(sbIn))

sbIn.cbBuffer = cbIn
sbIn.BufferType = SECBUFFER_TOKEN
sbIn.pvBuffer = pIn

CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)

If AuthSeq.fInitialized Then

If g_NT4 Then
ss = NT4AcceptSecurityContext(AuthSeq.hcred, AuthSeq.hctxt, _
sbdIn, 0, SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
fContextAttr, tsExpiry)
Else
ss = AcceptSecurityContext(AuthSeq.hcred, AuthSeq.hctxt, _
sbdIn, 0, SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
fContextAttr, tsExpiry)
End If

Else

If g_NT4 Then
ss = NT4AcceptSecurityContext2(AuthSeq.hcred, 0&, sbdIn, 0, _
SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
fContextAttr, tsExpiry)
Else
ss = AcceptSecurityContext2(AuthSeq.hcred, 0&, sbdIn, 0, _
SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
fContextAttr, tsExpiry)
End If

End If

If ss < 0 Then
GoTo FreeResourcesAndExit
End If

AuthSeq.fHaveCtxtHandle = True

' If necessary, complete token
If ss = SEC_I_COMPLETE_NEEDED _
Or ss = SEC_I_COMPLETE_AND_CONTINUE Then

If g_NT4 Then
ss = NT4CompleteAuthToken(AuthSeq.hctxt, sbdOut)
Else
ss = CompleteAuthToken(AuthSeq.hctxt, sbdOut)
End If

If ss < 0 Then
GoTo FreeResourcesAndExit
End If

End If

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

If Not AuthSeq.fInitialized Then
AuthSeq.fInitialized = True
End If

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

GenServerContext = True

FreeResourcesAndExit:

If sbdOut.pBuffers <> 0 Then
HeapFree GetProcessHeap(), 0, sbdOut.pBuffers
End If

If sbdIn.pBuffers <> 0 Then
HeapFree GetProcessHeap(), 0, sbdIn.pBuffers
End If

End Function


Public Function SSPValidateUser(User As String, Domain As String, _
Password As String) As Boolean

Dim pSPI As Long
Dim SPI As SecPkgInfo
Dim cbMaxToken As Long

Dim pClientBuf As Long
Dim pServerBuf As Long

Dim ai As SEC_WINNT_AUTH_IDENTITY

Dim asClient As AUTH_SEQ
Dim asServer As AUTH_SEQ
Dim cbIn As Long
Dim cbOut As Long
Dim fDone As Boolean

Dim osinfo As OSVERSIONINFO

SSPValidateUser = False

' Determine if system is Windows NT (version 4.0 or earlier)
osinfo.dwOSVersionInfoSize = Len(osinfo)
osinfo.szCSDVersion = Space$(128)
GetVersionExA osinfo
g_NT4 = (osinfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
osinfo.dwMajorVersion <= 4)

' Get max token size
If g_NT4 Then
NT4QuerySecurityPackageInfo "NTLM", pSPI
Else
QuerySecurityPackageInfo "NTLM", pSPI
End If

CopyMemory SPI, ByVal pSPI, Len(SPI)
cbMaxToken = SPI.cbMaxToken

If g_NT4 Then
NT4FreeContextBuffer pSPI
Else
FreeContextBuffer pSPI
End If

' Allocate buffers for client and server messages
pClientBuf = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
cbMaxToken)
If pClientBuf = 0 Then
GoTo FreeResourcesAndExit
End If

pServerBuf = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
cbMaxToken)
If pServerBuf = 0 Then
GoTo FreeResourcesAndExit
End If

' Initialize auth identity structure
ai.Domain = Domain
ai.DomainLength = Len(Domain)
ai.User = User
ai.UserLength = Len(User)
ai.Password = Password
ai.PasswordLength = Len(Password)
ai.Flags = SEC_WINNT_AUTH_IDENTITY_ANSI

' Prepare client message (negotiate) .
cbOut = cbMaxToken
If Not GenClientContext(asClient, ai, 0, 0, pClientBuf, cbOut, _
fDone) Then
GoTo FreeResourcesAndExit
End If

' Prepare server message (challenge) .
cbIn = cbOut
cbOut = cbMaxToken
If Not GenServerContext(asServer, pClientBuf, cbIn, pServerBuf, _
cbOut, fDone) 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
' szUser and the guest account is enabled in the specified domain.
GoTo FreeResourcesAndExit
End If

' Prepare client message (authenticate) .
cbIn = cbOut
cbOut = cbMaxToken
If Not GenClientContext(asClient, ai, pServerBuf, cbIn, pClientBuf, _
cbOut, fDone) Then
GoTo FreeResourcesAndExit
End If

' Prepare server message (authentication) .
cbIn = cbOut
cbOut = cbMaxToken
If Not GenServerContext(asServer, pClientBuf, cbIn, pServerBuf, _
cbOut, fDone) Then
GoTo FreeResourcesAndExit
End If

SSPValidateUser = True

FreeResourcesAndExit:

' Clean up resources
If asClient.fHaveCtxtHandle Then
If g_NT4 Then
NT4DeleteSecurityContext asClient.hctxt
Else
DeleteSecurityContext asClient.hctxt
End If
End If

If asClient.fHaveCredHandle Then
If g_NT4 Then
NT4FreeCredentialsHandle asClient.hcred
Else
FreeCredentialsHandle asClient.hcred
End If
End If

If asServer.fHaveCtxtHandle Then
If g_NT4 Then
NT4DeleteSecurityContext asServer.hctxt
Else
DeleteSecurityContext asServer.hctxt
End If
End If

If asServer.fHaveCredHandle Then
If g_NT4 Then
NT4FreeCredentialsHandle asServer.hcred
Else
FreeCredentialsHandle asServer.hcred
End If
End If

If pClientBuf <> 0 Then
HeapFree GetProcessHeap(), 0, pClientBuf
End If

If pServerBuf <> 0 Then
HeapFree GetProcessHeap(), 0, pServerBuf
End If

End Function



分享到
  • 微信分享
  • 新浪微博
  • QQ好友
  • QQ空间
点击: