Autenticação em domínio AD

[renatonavarro 0]

Fala Galera...Estou desenvolvendo uma aplicação em VB onde os usuários do sistema deverão ser autenticados (usuário,senha) em um domímio MS Windows (AD).Alguém já utilizou algo desse tipo???valeu!

[allan_pedroni 0]

:lol: amigo!se souber dissu, compartilhe a idea com a gente aqui no forum ou envie por favor para meu email allan.barros@gmail.com !!

[renato-navarro 0]

Poxa.. ninguém nunca usou este tipo de autenticação?Estou lendo algumas coisas sobre LDAP + como nunca utilizei estou apanhando um pouco... + assim que souber coloco aki para compartilhar!!!

[renato-navarro 0]

Galera!

 

Consegui o código.. segue abaixo a solução!

 

Private Const SEC_E_OK = 0Private Const HEAP_ZERO_MEMORY = &H8Private Const SEC_WINNT_AUTH_IDENTITY_ANSI = &H1Private Const SECBUFFER_TOKEN = &H2Private Const SECURITY_NATIVE_DREP = &H10Private Const SECPKG_CRED_INBOUND = &H1Private Const SECPKG_CRED_OUTBOUND = &H2Private Const SEC_I_CONTINUE_NEEDED = &H90312Private Const SEC_I_COMPLETE_NEEDED = &H90313Private Const SEC_I_COMPLETE_AND_CONTINUE = &H90314Private Const VER_PLATFORM_WIN32_NT = &H2Private Type SecPkgInfo   fCapabilities As Long   wVersion As Integer   wRPCID As Integer   cbMaxToken As Long   Name As Long   Comment As LongEnd TypePrivate Type SecHandle    dwLower As Long    dwUpper As LongEnd TypePrivate Type AUTH_SEQ   fInitialized As Boolean   fHaveCredHandle As Boolean   fHaveCtxtHandle As Boolean   hcred As SecHandle   hctxt As SecHandleEnd TypePrivate 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 LongEnd TypePrivate 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 LongEnd TypePrivate Type TimeStamp   LowPart As Long   HighPart As LongEnd TypePrivate Type SecBuffer   cbBuffer As Long   BufferType As Long   pvBuffer As LongEnd TypePrivate Type SecBufferDesc   ulVersion As Long   cBuffers As Long   pBuffers As LongEnd TypePrivate Type OSVERSIONINFO  OSVSize         As Long  dwVerMajor      As Long  dwVerMinor      As Long  dwBuildNumber   As Long  PlatformID      As Long  szCSDVersion    As String * 128End TypePrivate 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 LongPrivate Declare Function DeleteSecurityContext Lib "secur32" _  (ByRef phContext As SecHandle) As LongPrivate Declare Function FreeCredentialsHandle Lib "secur32" _  (ByRef phContext As SecHandle) As Long   Private Declare Function FreeContextBuffer Lib "secur32" _  (ByVal pvContextBuffer As Long) As LongPrivate Declare Function GetProcessHeap Lib "kernel32" () As LongPrivate Declare Function HeapAlloc Lib "kernel32" _  (ByVal hHeap As Long, _   ByVal dwFlags As Long, _   ByVal dwBytes As Long) As LongPrivate Declare Function HeapFree Lib "kernel32" _  (ByVal hHeap As Long, _   ByVal dwFlags As Long, _   ByVal lpMem As Long) As LongPrivate 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 LongPrivate 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 LongPrivate 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 LongPrivate 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 LongPrivate Sub Form_Load()   Label1.Caption = ""   Text1.Text = ""           'domain/workstation   Text2.Text = ""           'user name   Text3.Text = ""           'passwordEnd SubPrivate Sub Command1_Click()      Label1.Caption = AuthenticateUser(Text1.Text, _                                     Text2.Text, _                                     Text3.Text)End SubPrivate Sub Text3_KeyPress(KeyAscii As Integer)   If KeyAscii = vbKeyReturn Then      KeyAscii = 0      Command1.Value = True   End If   End SubPrivate 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.pBuffersEnd FunctionPrivate 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.pBuffersEnd FunctionPrivate 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 IfEnd FunctionPrivate 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 IfEnd FunctionPrivate Sub FreeMemory(memblock As Long)   If memblock <> 0 Then HeapFree GetProcessHeap(), 0, memblock   End Sub

 

Este código foi retirado do site: http://vbnet.mvps.org/index.html?code/netw...ritycontext.htm

 

Muito obrigado pela força!