Using Impersonation for VB.NET WinForm Application, Can Save File, Can't Open File - vb.net

I'm working on adding a document upload function to an application I've written. I want the user to be able to upload, open, and delete a document on a network drive that they cannot access normally. With this in mind, I stumbled upon Impersonation, where the user can impersonate a user account that has full rights to the drive, then dispose of that after the code has been executed.
I've never used impersonation before, so during my research I found this thread:
Impersonate a Windows or Active Directory user from a different, untrusted domain
I created and copied the class that user Max Vernon had posted as follows:
Option Explicit On
Option Infer Off
Imports System
Imports System.Runtime.InteropServices ' DLL Import
Imports System.Security.Principal ' WindowsImpersonationContext
Imports System.ComponentModel
Public Class Impersonation
'Group Type Enum
Enum SECURITY_IMPERSONATION_LEVEL As Int32
SecurityAnonymous = 0
SecurityIdentification = 1
SecurityImpersonation = 2
SecurityDelegation = 3
End Enum
Public Enum LogonType As Integer
'This logon type is intended for users who will be interactively using the computer, such as a user being logged on
'by a terminal server, remote shell, or similar process.
'This logon type has the additional expense of caching logon information for disconnected operations,
'therefore, it is inappropriate for some client/server applications, such as a mail server.
LOGON32_LOGON_INTERACTIVE = 2
'This logon type is intended for high performance servers to authenticate plaintext passwords.
'The LogonUser function does not cache credentials for this logon type.
LOGON32_LOGON_NETWORK = 3
'This logon type is intended for batch servers, where processes may be executing on behalf of a user without
'their direct intervention. This type is also for higher performance servers that process many plaintext
'authentication attempts at a time, such as mail or Web servers.
'The LogonUser function does not cache credentials for this logon type.
LOGON32_LOGON_BATCH = 4
'Indicates a service-type logon. The account provided must have the service privilege enabled.
LOGON32_LOGON_SERVICE = 5
'This logon type is for GINA DLLs that log on users who will be interactively using the computer.
'This logon type can generate a unique audit record that shows when the workstation was unlocked.
LOGON32_LOGON_UNLOCK = 7
'This logon type preserves the name and password in the authentication package, which allows the server to make
'connections to other network servers while impersonating the client. A server can accept plaintext credentials
'from a client, call LogonUser, verify that the user can access the system across the network, and still
'communicate with other servers.
'NOTE: Windows NT: This value is not supported.
LOGON32_LOGON_NETWORK_CLEARTEXT = 8
'This logon type allows the caller to clone its current token and specify new credentials for outbound connections.
'The new logon session has the same local identifier but uses different credentials for other network connections.
'NOTE: This logon type is supported only by the LOGON32_PROVIDER_WINNT50 logon provider.
'NOTE: Windows NT: This value is not supported.
LOGON32_LOGON_NEW_CREDENTIALS = 9
End Enum
Public Enum LogonProvider As Integer
'Use the standard logon provider for the system.
'The default security provider is negotiate, unless you pass NULL for the domain name and the user name
'is not in UPN format. In this case, the default provider is NTLM.
'NOTE: Windows 2000/NT: The default security provider is NTLM.
LOGON32_PROVIDER_DEFAULT = 0
LOGON32_PROVIDER_WINNT35 = 1
LOGON32_PROVIDER_WINNT40 = 2
LOGON32_PROVIDER_WINNT50 = 3
End Enum
'Obtains user token.
Declare Auto Function LogonUser Lib "advapi32.dll" (ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As LogonType, ByVal dwLogonProvider As LogonProvider, ByRef phToken As IntPtr) As Integer
'Closes open handles returned by LogonUser.
Declare Function CloseHandle Lib "kernel32.dll" (ByVal handle As IntPtr) As Boolean
'Creates duplicate token handle.
Declare Auto Function DuplicateToken Lib "advapi32.dll" (ExistingTokenHandle As IntPtr, SECURITY_IMPERSONATION_LEVEL As Int16, ByRef DuplicateTokenHandle As IntPtr) As Boolean
'WindowsImpersonationContext newUser.
Private newUser As WindowsImpersonationContext
'Attempts to impersonate a user. If successful, returns
'a WindowsImpersonationContext of the new user's identity.
'
'Username that you want to impersonate.
'Logon domain.
'User's password to logon with.
Public Sub Impersonator(ByVal sDomain As String, ByVal sUsername As String, ByVal sPassword As String)
'Initialize tokens
Dim pExistingTokenHandle As New IntPtr(0)
Dim pDuplicateTokenHandle As New IntPtr(0)
If sDomain = "" Then
sDomain = System.Environment.MachineName
End If
Try
Const LOGON32_PROVIDER_DEFAULT As Int32 = 0
Const LOGON32_LOGON_NEW_CREDENTIALS = 9
Dim bImpersonated As Boolean = LogonUser(sUsername, sDomain, sPassword, LOGON32_LOGON_NEW_CREDENTIALS, LOGON32_PROVIDER_DEFAULT, pExistingTokenHandle)
If bImpersonated = False Then
Dim nErrorCode As Int32 = Marshal.GetLastWin32Error()
Throw New ApplicationException("LogonUser() failed with error code: " & nErrorCode.ToString)
End If
Dim bRetVal As Boolean = DuplicateToken(pExistingTokenHandle, SECURITY_IMPERSONATION_LEVEL.SecurityImpersonation, pDuplicateTokenHandle)
If bRetVal = False Then
Dim nErrorCode As Int32 = Marshal.GetLastWin32Error
CloseHandle(pExistingTokenHandle)
Throw New ApplicationException("DuplicateToken() failed with error code: " & nErrorCode)
Else
Dim newId As New WindowsIdentity(pDuplicateTokenHandle)
Dim impersonatedUser As WindowsImpersonationContext = newId.Impersonate
newUser = impersonatedUser
End If
Catch ex As Exception
MessageBox.Show("An error has occurred. Please contact Technical Support. " & vbCrLf & ex.Message, "Application Title", MessageBoxButtons.OK, MessageBoxIcon.Error)
Finally
If pExistingTokenHandle <> IntPtr.Zero Then
CloseHandle(pExistingTokenHandle)
End If
If pDuplicateTokenHandle <> IntPtr.Zero Then
CloseHandle(pDuplicateTokenHandle)
End If
End Try
End Sub
Public Sub Undo()
newUser.Undo()
End Sub
End Class
The impersonation works great for "uploading" (actually just copying a file over from the users local files to the network drive, creating a specific file path if it doesn't exist) but doesn't seem to work when trying to open the file back up, or delete said file.
I get an access denied error like this:
Error Message When Trying to Open File
The Open File Click Event and Class Call Looks Like This:
Private Sub btnOpenDoc_Click(sender As Object, e As EventArgs) Handles btnOpenDoc.Click
Dim Impersonator As New Impersonation
Dim sUser As String = "UserNameGoesHere"
Dim sPass As String = "PasswordGoesHere"
Dim sDomain As String = "DomainGoesHere"
Try
If sActionID <> "" And iDocument = 1 Then
'Starts impersonation
Impersonator.Impersonator(sDomain, sUser, sPass)
Process.Start(RetrieveFilePath())
'Ends Impersonation
Impersonator.Undo()
End If
Catch ex As Exception
MessageBox.Show("An error has occurred. Please contact Technical Support. " & vbCrLf & ex.Message, "Application Title", MessageBoxButtons.OK, MessageBoxIcon.Error)
modGlobal.WriteToErrorLog(ex.Message, "frmActionEntry", modGlobal.GetExceptionInfo(ex), "frmActionEntry->btnOpenDoc_Click", currentUser.getEmployeeName())
End Try
End Sub
Here's Document Delete Function:
Private Function DeleteFile() As Boolean
Dim Impersonator As New Impersonation
Dim sUser As String = "UsernameGoesHere"
Dim sPass As String = "PasswordGoesHere"
Dim sDomain As String = "DomainGoesHere"
Try
'Starts impersonation
Impersonator.Impersonator(sDomain, sUser, sPass)
File.Delete(RetrieveFilePath())
Return True
'Ends Impersonation
Impersonator.Undo()
Catch ex As Exception
MessageBox.Show("An error has occurred. Please contact Technical Support. " & vbCrLf & ex.Message, "Application Title", MessageBoxButtons.OK, MessageBoxIcon.Error)
modGlobal.WriteToErrorLog(ex.Message, "frmActionEntry", modGlobal.GetExceptionInfo(ex), "frmActionEntry->DeleteFile", currentUser.getEmployeeName())
Return False
End Try
End Function
It's used in basically the same way in the FileSave function. Like I said I'm new to impersonation, and feel like I've hit a wall, having researched and tried various things all morning. Any advice is much appreciated!
-Levi

So after much research and trial and error I have an answer to this.
The short answer:
There is not a clean, elegant way to use impersonation to open a file on a network drive because you either butt heads with Windows Security or run into problems with Windows Shell. I decided to go another route.
The long answer:
I believe I was correct in that the Access was Denied error was due to trying to open a file as the impersonated user on the local user's computer. To get around this I decided to try and use ProcessStartInfo() to pass in the correct credentials (while also using impersonation to access the drive) like this:
'Opens the document associated with this action
Private Sub btnOpenDoc_Click(sender As Object, e As EventArgs) Handles btnOpenDoc.Click
'Initializes an impersonation object
Dim Impersonator As New Impersonation
'Strings with login credentials
Dim sUser As String = "UsernameGoesHere"
Dim sPass As String = "PasswordGoesHere"
Dim sDomain As String = "DomainGoesHere"
'Used to load file path in from RetrieveFilePath()
Dim sPath As String = ""
Try
If sActionID <> "" And iDocument = 1 Then
'Starts impersonation
Impersonator.Impersonator(sDomain, sUser, sPass)
'Initializes a ProcessStartInfo Object to use with impersonation
'as Process.Start class always inherits the security context of
'the parent process i.e. the local user
Dim startInfo As New ProcessStartInfo()
'Creates a secure string as the startInfo.Password parameter only accepts SecureStrings
Dim securePass As New Security.SecureString()
'You can't put a full string into a SecureString, so appending char by char
For Each c As Char In sPass
securePass.AppendChar(c)
Next
'Grab the file path
sPath = RetrieveFilePath()
'Load in the parameters for startInfo
startInfo.FileName = sPath
startInfo.UserName = sUser
startInfo.Password = securePass
startInfo.Domain = sDomain
startInfo.UseShellExecute = False
startInfo.WorkingDirectory = "\\Directory\Goes Here"
If File.Exists(sPath) Then
'Execute the process using startInfo
Process.Start(startInfo)
Else
MsgBox("File Not Found!")
End If
'Dispose of securePass
securePass.Dispose()
'Ends Impersonation
Impersonator.Undo()
End If
Catch ex As Exception
MessageBox.Show("An error has occurred. Please contact Technical Support. " & vbCrLf & ex.Message, "Application Title", MessageBoxButtons.OK, MessageBoxIcon.Error)
modGlobal.WriteToErrorLog(ex.Message, "frmActionEntry", modGlobal.GetExceptionInfo(ex), "frmActionEntry->btnOpenDoc_Click", currentUser.getEmployeeName())
End Try
End Sub
There are some interesting aspects to note here. You have to use a SecureString for the password when using ProcessStartInfo, and can only be assigned per character, and more importantly, I had to set UseShellExecute property to False.
I was hopeful that this would work, but after some iterations I got stuck on this error message:
Error Message Example
I figured out that this was due to being unable to access Windows Shell to find the default program to open the corresponding file type with, so it just expected an executable. After more research I was unable to find a clean way to get around this so I've decided to go about addressing this file upload a different way.

I know this is an old question, but maybe it can help someone else, I had the same problem and finally, realized that it's not enough to grant access to the impersonate user to read and write on the folder but also modify, if you don't, the user can not delete the file.

Related

Startup Folder Permissions in VB.NET

I am building an app which installs all the company's bespoke software at the click of a button. Included in the list is an asset tracker/reporting tool which must run at startup for everyone. Our standard build (I have no control over this whatsoever) is Windows 10, and we also have some legacy Windows 7 machines around, but in each case the startup registry keys are locked down so I started to create shortcuts in C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup.
If the startup folder doesn't exist, then it creates the folder. Logged on as local admin, I can create the startup folder manually without UAC popping up, take ownership of the folder and assign Everyone to have modify access, creating a shortcut in there. When I log off/on, the software runs. However when I code this, I get permissions errors.
Here's the code:
Sub DetectFolders()
Dim sFolder1 As String = "C:\My Apps\"
Dim sFolder2 As String = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup\"
Dim sFolder3 As String = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\"
If Not Directory.Exists(sFolder1) Then
Directory.CreateDirectory(sFolder1)
End If
If Not Directory.Exists(sFolder2) Then
Try
' create folder
TakeOwnership(sFolder3)
Application.DoEvents()
AddDirectorySecurity(sFolder3, "MyDomain\" & Environment.UserName, FileSystemRights.FullControl, AccessControlType.Allow)
Application.DoEvents()
Directory.CreateDirectory(sFolder2)
Application.DoEvents()
TakeOwnership(sFolder2)
' everyone has modify access // TEST
AddDirectorySecurity(sFolder2, "Everyone", FileSystemRights.Modify, AccessControlType.Allow)
Catch ex As Exception
MessageBox.Show(ex.Message, "Config", MessageBoxButtons.OK, MessageBoxIcon.Error)
Me.Close()
End Try
End If
End Sub
Sub TakeOwnership(ByVal sfolder As String)
' take ownership
Try
Dim ds As System.Security.AccessControl.DirectorySecurity
Dim account As System.Security.Principal.NTAccount
ds = System.IO.Directory.GetAccessControl(sfolder, System.Security.AccessControl.AccessControlSections.Owner)
account = New System.Security.Principal.NTAccount(System.Security.Principal.WindowsIdentity.GetCurrent.Name)
ds.SetOwner(account)
System.IO.Directory.SetAccessControl(sfolder, ds)
Application.DoEvents()
Catch ex As Exception
MessageBox.Show("" & ex.Message & "", "Take Ownership", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
Sub AddDirectorySecurity(ByVal FileName As String, ByVal Account As String, ByVal Rights As FileSystemRights, ByVal ControlType As AccessControlType)
Try
' Create a new DirectoryInfoobject.
Dim dInfo As New DirectoryInfo(FileName)
' Get a DirectorySecurity object that represents the
' current security settings.
Dim dSecurity As DirectorySecurity = dInfo.GetAccessControl()
' Add the FileSystemAccessRule to the security settings.
dSecurity.AddAccessRule(New FileSystemAccessRule(Account, Rights, ControlType))
' Set the new access settings.
dInfo.SetAccessControl(dSecurity)
Catch ex As Exception
MessageBox.Show("" & ex.Message & "", "Add Security", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
The first two Errors that appear is: Attempted to perform an unauthorized Operation, generated from the first time that AddDirectorySecurity and TakeOwnership are called.
I then get an error which states:
Access to the path 'C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup' is denied.
This is generated from the directory.createdirectory line in DetectFolders sub
I'm rapidly beginning to run out of ideas to get this working. Is it something in my code? Am I missing something, or does windows 10 not work in this way. Any constructive help will be gratefully received.

VB.NET adding a user to distribution list. An operations error occurred

So this is what I've got -
Public Shared Function GetDirectoryEntry() As DirectoryEntry
Try
Dim entryRoot As New DirectoryEntry("LDAP://RootDSE")
Dim Domain As String = DirectCast(entryRoot.Properties("defaultNamingContext")(0), String)
Dim de As New DirectoryEntry()
de.Path = "LDAP://" & Domain
de.AuthenticationType = AuthenticationTypes.Secure
Return de
Catch
Return Nothing
End Try
End Function
Protected Sub rbAddUser_Click(sender As Object, e As EventArgs) Handles rbAddUser.Click
AddMemberToGroup("LDAP://DOMAIN.local/CN=" & !DISTRIBUTIONNAME! & ",CN=Users,DC=DOMAIN,DC=local", "/CN=" & !SELECTEDUSER! & ",CN=Users,DC=DOMAIN,DC=local")
End Sub
Private Sub AddMemberToGroup(ByVal bindString As String, ByVal newMember As String)
Dim ent As DirectoryEntry = GetDirectoryEntry()
ent.Properties("member").Add(newMember)
ent.CommitChanges()
End Sub
I hope this is easy enough for people to read, anyway the group and user are selected by the users in a table and when they click the add button I want the selected users to be adding to the selected distribution list.
when it gets to the CommitChanges() I get this error
An exception of type 'System.DirectoryServices.DirectoryServicesCOMException' occurred in System.DirectoryServices.dll but was not handled in user code Additional information: An operations error occurred.Error -2147016672
This is a common issue with the Process Model application pool configuration, from the official documentation:
By using the <processModel> element, you can configure many of the security, performance, health, and reliability features of application pools on IIS 7 and later.
This issue exists as CommitChanges() requires elevated privileges, and can be fixed by setting your web-application to run under NetworkManager; this can be done in two ways:
Directly in your code, place the problem code inside this Using statement:
Using HostingEnvironment.Impersonate()
'Problem code goes here.
End Using
Via IIS Manager:
Navigate to your website's application pool;
Navigate to Advanced Settings;
Scroll down to the Process Model group;
Change Identity to NetworkService
I solved the error by passing through my user credentials
Private Sub AddMemberToGroup(ByVal bindString As String, ByVal newMember As String)
Dim ent As New GetDirectoryEntry(bindString)
ent.Properties("member").Add(newMember)
ent.Username = "DOMAIN\USERNAME"
ent.Password = "PASSWORD"
ent.CommitChanges()
End Sub
However my code still doesn't work, I just get no errors.

Impersonate a Windows or Active Directory user from a different, untrusted domain

I need to authenticate against a remote SQL Server using Windows Authentication. The remote SQL Server is running in another domain that does not have a trust relationship with the domain I'm currently logged into via Windows. I cannot use SQL Server authentication since the SQL Server is configured to only trust domain authentication.
Windows itself allows this type of impersonation through the user interface:
I've used WindowsImpersonationContext class from System.Security.Principal before, but that appears to rely upon the desired username belonging to a trusted domain.
I'm using Visual Studio 2012, and can use up to Microsoft.Net 4.5, with preferably VB, but I can easily convert code from C# if necessary.
For the benefit of future visitors, I'm posting some VB.Net code that allows a process to use NETONLY impersonation to authenticate against a remote server that resides in an untrusted domain:
Option Explicit On
Option Infer Off
Imports System
Imports System.Runtime.InteropServices ' DllImport
Imports System.Security.Principal ' WindowsImpersonationContext
Public Class clsAuthenticator
' group type enum
Enum SECURITY_IMPERSONATION_LEVEL As Int32
SecurityAnonymous = 0
SecurityIdentification = 1
SecurityImpersonation = 2
SecurityDelegation = 3
End Enum
Public Enum LogonType As Integer
'This logon type is intended for users who will be interactively using the computer, such as a user being logged on
'by a terminal server, remote shell, or similar process.
'This logon type has the additional expense of caching logon information for disconnected operations;
'therefore, it is inappropriate for some client/server applications,
'such as a mail server.
LOGON32_LOGON_INTERACTIVE = 2
'This logon type is intended for high performance servers to authenticate plaintext passwords.
'The LogonUser function does not cache credentials for this logon type.
LOGON32_LOGON_NETWORK = 3
'This logon type is intended for batch servers, where processes may be executing on behalf of a user without
'their direct intervention. This type is also for higher performance servers that process many plaintext
'authentication attempts at a time, such as mail or Web servers.
'The LogonUser function does not cache credentials for this logon type.
LOGON32_LOGON_BATCH = 4
'Indicates a service-type logon. The account provided must have the service privilege enabled.
LOGON32_LOGON_SERVICE = 5
'This logon type is for GINA DLLs that log on users who will be interactively using the computer.
'This logon type can generate a unique audit record that shows when the workstation was unlocked.
LOGON32_LOGON_UNLOCK = 7
'This logon type preserves the name and password in the authentication package, which allows the server to make
'connections to other network servers while impersonating the client. A server can accept plaintext credentials
'from a client, call LogonUser, verify that the user can access the system across the network, and still
'communicate with other servers.
'NOTE: Windows NT: This value is not supported.
LOGON32_LOGON_NETWORK_CLEARTEXT = 8
'This logon type allows the caller to clone its current token and specify new credentials for outbound connections.
'The new logon session has the same local identifier but uses different credentials for other network connections.
'NOTE: This logon type is supported only by the LOGON32_PROVIDER_WINNT50 logon provider.
'NOTE: Windows NT: This value is not supported.
LOGON32_LOGON_NEW_CREDENTIALS = 9
End Enum
Public Enum LogonProvider As Integer
'Use the standard logon provider for the system.
'The default security provider is negotiate, unless you pass NULL for the domain name and the user name
'is not in UPN format. In this case, the default provider is NTLM.
'NOTE: Windows 2000/NT: The default security provider is NTLM.
LOGON32_PROVIDER_DEFAULT = 0
LOGON32_PROVIDER_WINNT35 = 1
LOGON32_PROVIDER_WINNT40 = 2
LOGON32_PROVIDER_WINNT50 = 3
End Enum
' obtains user token
Declare Auto Function LogonUser Lib "advapi32.dll" (ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As LogonType, ByVal dwLogonProvider As LogonProvider, ByRef phToken As IntPtr) As Integer
' closes open handles returned by LogonUser
Declare Function CloseHandle Lib "kernel32.dll" (ByVal handle As IntPtr) As Boolean
' creates duplicate token handle
Declare Auto Function DuplicateToken Lib "advapi32.dll" (ExistingTokenHandle As IntPtr, SECURITY_IMPERSONATION_LEVEL As Int16, ByRef DuplicateTokenHandle As IntPtr) As Boolean
'WindowsImpersonationContext newUser;
Private newUser As WindowsImpersonationContext
'
' Attempts to impersonate a user. If successful, returns
' a WindowsImpersonationContext of the new user's identity.
'
' Username you want to impersonate
' Logon domain
' User's password to logon with
'
Public Sub Impersonator(ByVal sDomain As String, ByVal sUsername As String, ByVal sPassword As String)
' initialize tokens
Dim pExistingTokenHandle As New IntPtr(0)
Dim pDuplicateTokenHandle As New IntPtr(0)
If sDomain = "" Then
sDomain = System.Environment.MachineName
End If
Try
Const LOGON32_PROVIDER_DEFAULT As Int32 = 0
Const LOGON32_LOGON_NEW_CREDENTIALS = 9
Dim bImpersonated As Boolean = LogonUser(sUsername, sDomain, sPassword, LOGON32_LOGON_NEW_CREDENTIALS, LOGON32_PROVIDER_DEFAULT, pExistingTokenHandle)
If bImpersonated = False Then
Dim nErrorCode As Int32 = Marshal.GetLastWin32Error()
Throw New ApplicationException("LogonUser() failed with error code: " & nErrorCode.ToString)
End If
Dim bRetVal As Boolean = DuplicateToken(pExistingTokenHandle, SECURITY_IMPERSONATION_LEVEL.SecurityImpersonation, pDuplicateTokenHandle)
If bRetVal = False Then
Dim nErrorCode As Int32 = Marshal.GetLastWin32Error
CloseHandle(pExistingTokenHandle)
Throw New ApplicationException("DuplicateToken() failed with error code: " & nErrorCode)
Else
Dim newId As New WindowsIdentity(pDuplicateTokenHandle)
Dim impersonatedUser As WindowsImpersonationContext = newId.Impersonate
newUser = impersonatedUser
End If
Catch ex As Exception
Finally
If pExistingTokenHandle <> IntPtr.Zero Then
CloseHandle(pExistingTokenHandle)
End If
If pDuplicateTokenHandle <> IntPtr.Zero Then
CloseHandle(pDuplicateTokenHandle)
End If
End Try
End Sub
Public Sub Undo()
newUser.Undo()
End Sub
End Class
This can be called from another piece of code like so:
Dim Impersonator As New clsAuthenticator
Dim sDomain as string = "SomeDomain"
Dim sUser as string = "SomeUserName"
Dim sPass as string = "SomePassword"
Impersonator.Impersonator(sDomain, sUser, sPass)
' Run whatever code needs to run against the remote server
Impersonator.Undo
The standard warning of not actually embedding passwords in code certainly applies here. In the real world my app obtains the password from an encrypted column in a database.

VBA: Login using Windows Authentication

I have a an Access App that requires the user to enter their Windows domain user and password to enter. I have used the following VBA code to accomplish this:
Function WindowsLogin(ByVal strUserName As String, ByVal strpassword As String, ByVal strDomain As String) As Boolean
'Authenticates user and password entered with Active Directory.
On Error GoTo IncorrectPassword
Dim oADsObject, oADsNamespace As Object
Dim strADsPath As String
strADsPath = "WinNT://" & strDomain
Set oADsObject = GetObject(strADsPath)
Set oADsNamespace = GetObject("WinNT:")
Set oADsObject = oADsNamespace.OpenDSObject(strADsPath, strDomain & "\" & strUserName, strpassword, 0)
WindowsLogin = True 'ACCESS GRANTED
ExitSub:
Exit Function
IncorrectPassword:
WindowsLogin = False 'ACCESS DENIED
Resume ExitSub
End Function
I notice that sometimes when the information is entered correctly, access is denied. I tried to debug once and it gave the error: "The network path was not found.
" on the Set oADsObject = oADsNamespace.OpenDSObject) line.
Not sure why this occurs sometimes. Is it better to convert to LDAP instead? I have tried but can't construct the LDAP URL correctly.
If the user is already authenticated via their Windows login, why make them enter the details again?
If you need to know which user is logged in, you can get the username very easily by the following function:
Declare Function IGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal sBuffer As String, lSize As Long) As Long
Function GetUserName() As String
On Error Resume Next
Dim sBuffer As String
Dim lSize As Long
Dim x As Long
sBuffer = Space$(32)
lSize = Len(sBuffer)
x = IGetUserName(sBuffer, lSize)
GetUserName = left$(sBuffer, lSize - 1)
End Function
In GxP environment it is additionally needed to enter at least password. It doesn't matter if You are logged to Windows, You need to confirm it again.

Is it possible to authenticate an Active Directory User with an Expired password?

I have a web form that uses AD to authenticate users. I want to be able to authenticate users with expired password, and redirect them to the password change page after authentication.
if for instance, a site admin reset a users password, I use the method below, to make the user reset their password on next logon.
Public Shared Sub ForceUserToResetPassword(ByVal LDAP_URI As String, ByVal UserName As String, ByVal Auth_UserName As String, ByVal Auth_Password As String)
Dim LDAPEntry As DirectoryEntry = Nothing
Try
LDAPEntry = New DirectoryEntry(LDAP_URI, Auth_UserName, Auth_Password, AuthenticationTypes.Secure)
Dim LDAPSearch As New DirectorySearcher()
LDAPSearch.SearchRoot = LDAPEntry
LDAPSearch.Filter = "(&(objectClass=user)(sAMAccountName=" & UserName & "))"
LDAPSearch.SearchScope = SearchScope.Subtree
Dim results As SearchResult = LDAPSearch.FindOne()
If Not (results Is Nothing) Then
LDAPEntry = New DirectoryEntry(results.Path, Auth_UserName, Auth_Password, AuthenticationTypes.Secure)
End If
LDAPAccess.SetProperty(LDAPEntry, "pwdLastSet", 0)
LDAPEntry.CommitChanges()
Catch ex As Exception
End Try
End Sub
Doing this makes the user's password expire. If the user try to logon with their new password the authentication fails with "Logon failure: unknown username or bad password".
This is my auth. method:
Public Shared Function AuthADuser(ByVal LDAP_URI As String, ByVal UserName As String, ByVal password As String, ByVal Auth_UserName As String, ByVal Auth_Password As String) As Boolean
Dim IsAuth As Boolean = False
Dim LDAPEntry As DirectoryEntry = Nothing
Try
LDAPEntry = New DirectoryEntry(LDAP_URI, UserName, password, AuthenticationTypes.Secure)
Dim tmp As [Object] = LDAPEntry.NativeObject
IsAuth = True
Catch ex As Exception
LDAPEntry.Dispose()
If ex.Message.StartsWith("The server is not operational") Then
IsAuth = False
ElseIf ex.Message.StartsWith("Logon failure:") Then
Throw New ApplicationException("The Username and password combination are not valid to enter the system.")
End If
Finally
LDAPEntry.Close()
End Try
Return IsAuth
End Function
Is there a way around this?
Thanks for your help.
In my understanding, if a user is required to Change his Password at Next Logon (User's password has expired) Active-Directory will not allow us to use LDAP to determine if his password is invalid or not. This is due to the fact that a user must change password. I found here the following solution :
To determine if password is expired, you may call Win32:LogonUser(), and check the windows error code for the following 2 constants:
ERROR_PASSWORD_MUST_CHANGE = 1907
ERROR_PASSWORD_EXPIRED = 1330
I have a non official answer. As administrator you put pwdLastSet to -1 for the user where pwdLastSet is set to 0. The effect of this is to make Active-Directory believe that the password has just been changed. Then, you check the password with your AuthADuser method. Then you put back pwdLastSet to 0. I do not test it, but just imagine it, it's not so clean on the security point of view (in France we call that "bricolage").
Just tell me if it works ?
I hope it helps;
JP