My New Domain

One of the things I sometimes need is to run code with elevated privileges. This class allows your code to impersonate another user with the necessary privileges. It is written as a COM class so that I can reference it in VBA.


Option Strict Off
Option Explicit On

#Region “AliasAccount Class”

”’
”’ COM class to enable impersonation of another user account
”’
”’
”’ Code found on the NET
”’ http://weblogs.asp.net/ralfw/archive/2003/11/24/39479.aspx
”’ Modified slightly to be a COM class
”’
_
Public Class AliasAccount

#Region “COM GUIDs”
‘ These GUIDs provide the COM identity for this class
‘ and its COM interfaces. If you change them, existing
‘ clients will no longer be able to access the class.
Public Const ClassId As String = “39b4e646-a308-47eb-8f39-bd8dc16e07a6″
Public Const InterfaceId As String = “4a0d67f3-8935-4840-93ad-fb28ecd4bf0f”
Public Const EventsId As String = “fff5562b-6ab1-4d01-b678-022c39c00510″
#End Region

#Region “Constructor”

‘ A creatable COM class must have a Public Sub New()
‘ with no parameters, otherwise, the class will not be
‘ registered in the COM registry and cannot be created
‘ via CreateObject.
Public Sub New()
MyBase.New()
End Sub

#End Region

#Region “Declarations”

Private _DomainName As String
Private _UserName As String
Private _Password As String

Private _tokenHandle As New IntPtr(0)
Private _dupeTokenHandle As New IntPtr(0)
Private _impersonatedUser As System.Security.Principal.WindowsImpersonationContext

#End Region

#Region “Properties”

Public Property DomainName() As String
Get
Return _DomainName
End Get
Set(ByVal value As String)
_DomainName = value
End Set
End Property

Public Property UserName() As String
Get
Return _UserName
End Get
Set(ByVal value As String)
_UserName = value
End Set
End Property

Public Property Password() As String
Get
Return _Password
End Get
Set(ByVal value As String)
_Password = value
End Set
End Property

#End Region

#Region “Public Methods”

”’
”’ runs code under the user account details set
”’
”’
Public Sub BeginImpersonation()
Const LOGON32_PROVIDER_DEFAULT As Integer = 0
Const LOGON32_LOGON_INTERACTIVE As Integer = 2
Const SecurityImpersonation As Integer = 2

Dim win32ErrorNumber As Integer

_tokenHandle = IntPtr.Zero
_dupeTokenHandle = IntPtr.Zero

If Not LogonUser(_UserName, _DomainName, _Password, LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, _tokenHandle) Then
win32ErrorNumber = System.Runtime.InteropServices.Marshal.GetLastWin32Error()
Throw New ImpersonationException(win32ErrorNumber, GetErrorMessage(win32ErrorNumber), _UserName, _DomainName)
End If

If Not DuplicateToken(_tokenHandle, SecurityImpersonation, _dupeTokenHandle) Then
win32ErrorNumber = System.Runtime.InteropServices.Marshal.GetLastWin32Error()

CloseHandle(_tokenHandle)
Throw New ImpersonationException(win32ErrorNumber, “Unable to duplicate token!”, _UserName, _DomainName)
End If

Dim newId As New System.Security.Principal.WindowsIdentity(_dupeTokenHandle)
_impersonatedUser = newId.Impersonate()
End Sub

Public Sub EndImpersonation()
If Not _impersonatedUser Is Nothing Then
_impersonatedUser.Undo()
_impersonatedUser = Nothing

If Not System.IntPtr.op_Equality(_tokenHandle, IntPtr.Zero) Then
CloseHandle(_tokenHandle)
End If
If Not System.IntPtr.op_Equality(_dupeTokenHandle, IntPtr.Zero) Then
CloseHandle(_dupeTokenHandle)
End If
End If
End Sub

#End Region

#Region “Exception Class”

Public Class ImpersonationException
Inherits System.Exception

Public ReadOnly win32ErrorNumber As Integer

Public Sub New(ByVal win32ErrorNumber As Integer, ByVal msg As String, ByVal username As String, ByVal domainname As String)
MyBase.New(String.Format(“Impersonation of {1}\{0} failed! [{2}] {3}”, username, domainname, win32ErrorNumber, msg))
Me.win32ErrorNumber = win32ErrorNumber
End Sub
End Class

#End Region

#Region “External Declarations and Helpers”

Private Declare Auto Function LogonUser Lib “advapi32.dll” (ByVal lpszUsername As [String], _
ByVal lpszDomain As [String], ByVal lpszPassword As [String], _
ByVal dwLogonType As Integer, ByVal dwLogonProvider As Integer, _
ByRef phToken As IntPtr) As Boolean

Private Declare Auto Function DuplicateToken Lib “advapi32.dll” (ByVal ExistingTokenHandle As IntPtr, _
ByVal SECURITY_IMPERSONATION_LEVEL As Integer, _
ByRef DuplicateTokenHandle As IntPtr) As Boolean

Private Declare Auto Function CloseHandle Lib “kernel32.dll” (ByVal handle As IntPtr) As Boolean

_
Private Shared Function FormatMessage(ByVal dwFlags As Integer, ByRef lpSource As IntPtr, _
ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, ByRef lpBuffer As [String], _
ByVal nSize As Integer, ByRef Arguments As IntPtr) As Integer
End Function

Private Function GetErrorMessage(ByVal errorCode As Integer) As String
Dim FORMAT_MESSAGE_ALLOCATE_BUFFER As Integer = &H100
Dim FORMAT_MESSAGE_IGNORE_INSERTS As Integer = &H200
Dim FORMAT_MESSAGE_FROM_SYSTEM As Integer = &H1000

Dim messageSize As Integer = 255
Dim lpMsgBuf As String
Dim dwFlags As Integer = FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS

Dim ptrlpSource As IntPtr = IntPtr.Zero
Dim prtArguments As IntPtr = IntPtr.Zero

Dim retVal As Integer = FormatMessage(dwFlags, ptrlpSource, errorCode, 0, lpMsgBuf, messageSize, prtArguments)
If 0 = retVal Then
Throw New System.Exception(“Failed to format message for error code ” + errorCode.ToString() + “. “)
End If

Return lpMsgBuf
End Function

#End Region

End Class

#End Region

To use it one simply does this: (in my case I am using it to overwrite a protected file but it could be anything)


Dim oAA As New AliasAccount()

‘impersonate user DocRootAdmin
oAA.DomainName = My.Settings.DocRootDomain
oAA.UserName = My.Settings.DocRootAdmin
oAA.Password = My.Settings.DocRootPassword
oAA.BeginImpersonation()

‘move the file
My.Computer.FileSystem.MoveFile(oldFile, newFile, overwrite)

‘end impersonation
oAA.EndImpersonation()