Cannot connect to Server as Administrator with Impersonate - vb.net

I have to impersonate as administrator to view some network folders, but it doesn't work beacause the application recognizes the current logged account. This is the class that i used that I found on the internet :
Public Class Impersonator
Private _username As String
Private _password As String
Private _domainname As String
Private _tokenHandle As New IntPtr(0)
Private _dupeTokenHandle As New IntPtr(0)
Private _impersonatedUser As System.Security.Principal.WindowsImpersonationContext
Public Sub New(ByVal username As String, _
ByVal password As String)
Dim nameparts() As String = username.Split(Convert.ToChar("\"))
If nameparts.Length > 1 Then
_domainname = nameparts(0)
_username = nameparts(1)
Else
_username = username
End If
_password = password
End Sub
Public Sub New(ByVal username As String, _
ByVal password As String, _
ByVal domainname As String)
_username = username
_password = password
_domainname = domainname
End Sub
Public ReadOnly Property username() As String
Get
Return _username
End Get
End Property
Public ReadOnly Property domainname() As String
Get
Return _domainname
End Get
End Property
Public ReadOnly Property currentWindowsUsername() As String
Get
Return System.Security.Principal.WindowsIdentity.GetCurrent().Name
End Get
End Property
Public Sub BeginImpersonation()
'Const LOGON32_PROVIDER_DEFAULT As Integer = 0
'Const LOGON32_LOGON_INTERACTIVE As Integer = 2
Const LOGON32_LOGON_NEW_CREDENTIALS As Integer = 9
Const LOGON32_PROVIDER_WINNT50 As Integer = 3
Const SecurityImpersonation As Integer = 2
Dim win32ErrorNumber As Integer
_tokenHandle = IntPtr.Zero
_dupeTokenHandle = IntPtr.Zero
If Not LogonUser(_username, _domainname, _password, LOGON32_LOGON_NEW_CREDENTIALS, LOGON32_PROVIDER_WINNT50, _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
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
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
<System.Runtime.InteropServices.DllImport("kernel32.dll")> _
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 Class
End Class

Did you actually try to acces the network resource or did you only determine it was not working with the: WindowsIdentity.GetCurrent.Name result ?
The way it works:
Interactive login with default provider works only properly if the user can actually connect to the server. In older Windows version, this was not enforced and could be used instead of the ones below.
Logon_New_Credential (with Winnt50 provider) will impersonate the user for remote connections but will use the original user locally
Logon_Network (with Winnt50 provier) will impersonate you as the desired user locally but the token will fails if you try to initiate a connection remotely.
Therefore, Logon_New_Credential will return your original user if you try WindowsIdentity.GetCurrent.Name in your impersonation loop but will use the impersonated user when accessing the network resource.
See below

Thank you so much Sage Pourpre , it work if i use the first option :
LOGON32_PROVIDER_DEFAULT | LOGON32_LOGON_INTERACTIVE
Currently i use this type of login, but i will documet because i would like understand the differences.

Related

An error while trying to retrieve and decrypt login in Firefox

I'm working on programm on VB.net to retrieve data from Firefox browser. I have an error while trying to use "PK11SDR_Decrypt" method from nss3.lib. "PK11SDR_Decrypt" returns -1. I don't have master password. I think that the problem in Ctypes/marshalling/base64 decoding. This is the code of function.
Public Function DecryptFF(ByVal str As String)
On Error Resume Next
Dim tSecDec As New TSECItem
Dim e As Integer
Dim sb As New System.Text.StringBuilder(str)
Dim hi2 As Integer = NSSBase64_DecodeBuffer(IntPtr.Zero, IntPtr.Zero, sb, sb.Length)
Dim item As TSECItem = DirectCast(Marshal.PtrToStructure(New IntPtr(hi2), GetType(TSECItem)), TSECItem)
e = PK11SDR_Decrypt(item, tSecDec, 0)
If e = 0 Then
If tSecDec.SECItemLen <> 0 Then
Dim mozDecryptedData = New Byte(tSecDec.SECItemLen - 1) {}
Marshal.Copy(New IntPtr(tSecDec.SECItemData), mozDecryptedData, 0, tSecDec.SECItemLen)
Return Encoding.UTF8.GetString(mozDecryptedData)
End If
End If
Return String.Empty
End Function
And other code part.
Public NSS3 As IntPtr
Public hModuleList As New List(Of IntPtr)
<StructLayout(LayoutKind.Sequential)>
Public Structure TSECItem
Public SECItemType As Integer
Public SECItemData As Integer
Public SECItemLen As Integer
End Structure
Public Function NSS_Init(ByVal configdir As String) As Long
Dim PathM = FindFirefoxInstallationPath()
hModuleList.Add(LoadLibrary(PathM & "\msvcp140.dll"))
hModuleList.Add(LoadLibrary(PathM & "\mozglue.dll"))
hModuleList.Add(LoadLibrary(PathM & "\mozavutils.dll"))
NSS3 = LoadLibrary(PathM & "\nss3.dll")
hModuleList.Add(NSS3)
Return CreateAPI(Of DLLFunctionDelegate)(NSS3, "NSS_Init")(configdir)
End Function
Public Function CreateAPI(Of T)(ByVal hModule As IntPtr, ByVal method As String) As T 'Simple overload to avoid loading the same library every time
Return DirectCast(DirectCast(Marshal.GetDelegateForFunctionPointer(GetProcAddress(hModule, method), GetType(T)), Object), T)
End Function
Public Function NSSBase64_DecodeBuffer(ByVal arenaOpt As IntPtr, ByVal outItemOpt As IntPtr, ByVal inStr As System.Text.StringBuilder, ByVal inLen As Integer) As Integer
Dim pProc As IntPtr = GetProcAddress(NSS3, "NSSBase64_DecodeBuffer")
Dim dll As DLLFunctionDelegate4 = DirectCast(Runtime.InteropServices.Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate4)), DLLFunctionDelegate4)
Return dll(arenaOpt, outItemOpt, inStr, inLen)
End Function
Public Function PK11SDR_Decrypt(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
Dim pProc As IntPtr = GetProcAddress(NSS3, "PK11SDR_Decrypt")
Dim dll As DLLFunctionDelegate5 = DirectCast(Marshal.GetDelegateForFunctionPointer(pProc, GetType(DLLFunctionDelegate5)), DLLFunctionDelegate5)
Return dll(data, result, cx)
End Function
<UnmanagedFunctionPointer(CallingConvention.Cdecl)>
Public Delegate Function DLLFunctionDelegate5(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
<UnmanagedFunctionPointer(CallingConvention.Cdecl)>
Public Delegate Function DLLFunctionDelegate6() As Long
Public Function NSS_Shutdown() As Long
Return CreateAPI(Of DLLFunctionDelegate6)(NSS3, "NSS_Shutdown")()
End Function
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Public Shared Function LoadLibrary(ByVal dllFilePath As String) As IntPtr
End Function
<DllImport("kernel32.dll", SetLastError:=True, EntryPoint:="FreeLibrary")>
Public Shared Function FreeLibrary(ByVal hModule As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Ansi, ExactSpelling:=True)>
Public Shared Function GetProcAddress(ByVal hModule As IntPtr, ByVal procName As String) As IntPtr
End Function
DecryptFF get as argument the encrypted login fron logins.json file. Here is the part of code
Dim JSONRegex As New Regex("\""(hostname|encryptedPassword|encryptedUsername)"":""(.*?)""")
Dim mozMC = JSONRegex.Matches(Logins)
For I = 0 To mozMC.Count - 1 Step 3
Dim host = mozMC(I).Groups(2).Value
Dim usr = mozMC(I + 1).Groups(2).Value
Dim pas = mozMC(I + 2).Groups(2).Value
Account = (DecryptFF(usr))
Thank you for your help!

Win32 handle that was passed to Icon is not valid or is the wrong type

I have the following issue with my code.
Win32 handle that was passed to Icon is not valid or is the wrong type
The line of codes are as follow:
SHFILEINFO Declaration
Private Structure SHFILEINFO
Public hIcon As IntPtr ' : iconc
Public iIcon As Integer ' : icondex
Public dwAttributes As Integer ' : SFGAO_ flags
_
Public szDisplayName As String
_
Public szTypeName As String
End Structure
SHGetFileInfo Declaration
Private Declare Auto Function SHGetFileInfo Lib "shell32.dll" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Integer, _
ByRef psfi As SHFILEINFO, _
ByVal cbFileInfo As Integer, _
ByVal uFlags As Integer) As IntPtr
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SMALLICON = &H1
Private Const SHGFI_LARGEICON = &H0 ' Large icon
Private Const MAX_PATH = 260
SHGetFileInfo Usage
Private Sub AddImageToImageListBox(ByVal strFileName As String)
On Error GoTo errHandler
Dim shInfo As SHFILEINFO
shInfo = New SHFILEINFO()
shInfo.szDisplayName = New String(vbNullChar, MAX_PATH)
shInfo.szTypeName = New String(vbNullChar, 80)
Dim hIcon As IntPtr
hIcon = SHGetFileInfo(strFileName, 0, shInfo, Marshal.SizeOf(shInfo), SHGFI_ICON Or SHGFI_SMALLICON)
Dim MyIcon As Drawing.Bitmap
MyIcon = Drawing.Icon.FromHandle(shInfo.hIcon).ToBitmap
imgAttachment.AddImage(MyIcon)
ilstAttachments.Items.Add(strFileName.ToString(), imgAttachment.Images.Count - 1)
Exit Sub
errHandler:
ErrMsg("AddImageToImageListBox (errHandler)")
End Sub
Runtime
Here are the values that being passed into SHGetFileInfo.
strFileName = "Copy (223) of Uncollected Card - Multiple Pages.TIF"
shInfo.dwAttributes = 0
shInfo.hIcon = 0
shInfo.iIcon = 0
shInfo.szDisplayName = ""
shInfo.szTypeName = ""
Error
When the stated values above are being passed to SHGetFileInfo, it returns 0 value thus making hIcon = 0.
When it reaches
MyIcon = Drawing.Icon.FromHandle(shInfo.hIcon).ToBitmap
The following error occurred
Win32 handle that was passed to Icon is not valid or is the wrong type
Can you guys help me to identify what is the issue?
Thank you
Try changing SHFILEINFO and SHGetFileInfo to this
Private Structure SHFILEINFO
Public hIcon As IntPtr ' : iconc
Public iIcon As Integer ' : icondex
Public dwAttributes As Integer ' : SFGAO_ flags
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)> _
Public szDisplayName As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)>
Public szTypeName As String
End Structure
Private Declare Ansi Function SHGetFileInfo Lib "shell32.dll" (ByVal pszPath As String, _
ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, _
ByVal uFlags As Integer) As IntPtr
Also, I would lose the On Error Goto and use a Try/Catch.

Log in to remote computer

I am trying to log into a remote computer to pull some file information. I know how to do it in batch, but am not sure in VB.net.
Set /P pinghost=Enter server IP address:
net use \\%pinghost% /user:domain\username password
That is how I do it in batch, but no clue where to start in VB.net
End goal is log into the remote computer. Run a search in a program, and get the results pasted to vb.net textbox
Remotely connecting like this is quite a task, luckily there is a class available (see end of the answer for the code), that can be used by:
Dim Impersonator As New Impersonator("domain\user", "password")
Impersonator.BeginImpersonation()
File.Copy(SourcePath, DestPath, True)
Impersonator.EndImpersonation()
You can use File.GetCreationTime to verify that it is the file which is wanted, and the following to list the files and folders in a directory, how you display is up to you:
For Each Dir As String In Directory.GetDirectories("c:\Program Files")
The Impersonator class appears to cleverly mimic the environment of the application so it has access to the filesystem of the remote computer, therefore you might be able to use a simple FileOpenDialog.
The below is from here, I copied it here as I find Experts-Exchange often removes questions you actually need and want. Please respect the copyright of the code, which is FamousMortimer, 2014-02-07 at 09:43:26.
Public Class Impersonator
Private _username As String
Private _password As String
Private _domainname As String
Private _tokenHandle As New IntPtr(0)
Private _dupeTokenHandle As New IntPtr(0)
Private _impersonatedUser As System.Security.Principal.WindowsImpersonationContext
#Region "Constructor"
Public Sub New(ByVal username As String, _
ByVal password As String)
Dim nameparts() As String = username.Split(Convert.ToChar("\"))
If nameparts.Length > 1 Then
_domainname = nameparts(0)
_username = nameparts(1)
Else
_username = username
End If
_password = password
End Sub
Public Sub New(ByVal username As String, _
ByVal password As String, _
ByVal domainname As String)
_username = username
_password = password
_domainname = domainname
End Sub
#End Region
#Region "Properties"
Public ReadOnly Property username() As String
Get
Return _username
End Get
End Property
Public ReadOnly Property domainname() As String
Get
Return _domainname
End Get
End Property
Public ReadOnly Property currentWindowsUsername() As String
Get
Return System.Security.Principal.WindowsIdentity.GetCurrent().Name
End Get
End Property
#End Region
#Region "Impersonation"
Public Sub BeginImpersonation()
'Const LOGON32_PROVIDER_DEFAULT As Integer = 0
'Const LOGON32_LOGON_INTERACTIVE As Integer = 2
Const LOGON32_LOGON_NEW_CREDENTIALS As Integer = 9
Const LOGON32_PROVIDER_WINNT50 As Integer = 3
Const SecurityImpersonation As Integer = 2
Dim win32ErrorNumber As Integer
_tokenHandle = IntPtr.Zero
_dupeTokenHandle = IntPtr.Zero
If Not LogonUser(_username, _domainname, _password, LOGON32_LOGON_NEW_CREDENTIALS, LOGON32_PROVIDER_WINNT50, _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
<System.Runtime.InteropServices.DllImport("kernel32.dll")> _
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

GetTokenInformation returns invalid SID?

While following this i ran into a problem.
<DllImport("advapi32.dll", SetLastError:=True)> _
Private Shared Function OpenProcessToken(ByVal ProcessHandle As IntPtr, ByVal DesiredAccess As Integer, ByRef TokenHandle As IntPtr) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Private Shared Function GetTokenInformation(TokenHandle As IntPtr, TokenInformationClass As TOKEN_INFORMATION_CLASS, TokenInformation As IntPtr, TokenInformationLength As UInteger, ByRef ReturnLength As UInteger) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)> _
Private Shared Function IsValidSid(SID As Byte()) As Boolean
End Function
For Each p As Process In Process.GetProcesses
Dim processHandle As IntPtr = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, p.Id)
If Not processHandle = Nothing Then
Dim tokenhandle As IntPtr = Nothing
Dim bool As Boolean = OpenProcessToken(processHandle, TOKEN_READ, tokenhandle)
If bool = False Then
Dim win32error As String = New Win32Exception(Marshal.GetLastWin32Error).Message
MessageBox.Show(win32error)
Else
Dim sidlength As UInteger = Nothing
Dim SIDbyte As Byte() = Nothing
Dim somebool As Boolean = GetTokenInformation(tokenhandle, TOKEN_INFORMATION_CLASS.TokenUser, Nothing, 0, sidlength)
If Not somebool Then
Dim win32error As String = New Win32Exception(Marshal.GetLastWin32Error).Message
MessageBox.Show(win32error)
''RETURNS "The data area passed to a system call is too small" error.
End If
ReDim SIDbyte(35) '' I hardcoded '35' because it's what i'm getting with sidlength.
somebool = GetTokenInformation(tokenhandle, TOKEN_INFORMATION_CLASS.TokenUser, SIDbyte, SIDbyte.Length, sidlength)
''RETURNS TRUE THE SECOND TIME.
If Not somebool Then
Dim win32error As String = New Win32Exception(Marshal.GetLastWin32Error).Message
MessageBox.Show(win32error)
End If
If IsValidSid(SIDbyte) Then
MessageBox.Show("Valid")
Else
MessageBox.Show("Not Valid")
End If
''RETURNS INVALID SID. (FAILS)
The first call to GetTokenInformation fails as it's supposed to i guess... returning "sidlength" with value of 36.
Second call succeeds and SID Byte() gets populated, but the call to "IsValidSID" Returns false... and i can't figure out why, if the SIDbytes are populated successfully, what's the problem?

Open remote shared folder with credentials

I need to open a folder on a remote server with different credentials in a window (explorer.exe).
I managed to do it with no credentials (my credentials), but when I do it with another username and another password than mine, it opens a prompt to enter a username and a password, and it says "access denied".
In the access log on the remote desktop, it says that I tried to connect with my own username, and not the other username I entered. So, the process obviously did not work.
But, I can't figure out why. My code is as follows:
Dim domain, username, passwordStr, remoteServerName As String
Dim password As New Security.SecureString
Dim command As New Process
domain = "domain.com"
username = "username"
passwordStr = "password"
remoteServerName = "serverName"
For Each c As Char In passwordStr.ToCharArray
password.AppendChar(c)
Next
command.StartInfo.FileName = "explorer.exe"
command.StartInfo.Arguments = "\\" & serverName & "\admin$\Temp"
command.StartInfo.UserName = username
command.StartInfo.Password = password
command.StartInfo.Domain = domain
command.StartInfo.Verb = "open"
command.StartInfo.UseShellExecute = False
command.Start()
I ran into this same problem at work and was able to solve it with impersonation. just add a new class with the following:
'*****************************************************************************************
'*****************************************************************************************
' Contents: AliasAccount Class
'
' This Class is a template class that provides all the functionality to impersonate a user
' over a designated instance.
'*****************************************************************************************
'*****************************************************************************************
Public Class AliasAccount
Private _username, _password, _domainname As String
Private _tokenHandle As New IntPtr(0)
Private _dupeTokenHandle As New IntPtr(0)
Private _impersonatedUser As System.Security.Principal.WindowsImpersonationContext
Public Sub New(ByVal username As String, ByVal password As String)
Dim nameparts() As String = username.Split("\")
If nameparts.Length > 1 Then
_domainname = nameparts(0)
_username = nameparts(1)
Else
_username = username
End If
_password = password
End Sub
Public Sub New(ByVal username As String, ByVal password As String, ByVal domainname As String)
_username = username
_password = password
_domainname = domainname
End Sub
Public Sub BeginImpersonation()
'Const LOGON32_PROVIDER_DEFAULT As Integer = 0
'Const LOGON32_LOGON_INTERACTIVE As Integer = 2
Const LOGON32_LOGON_NEW_CREDENTIALS As Integer = 9
Const LOGON32_PROVIDER_WINNT50 As Integer = 3
Const SecurityImpersonation As Integer = 2
Dim win32ErrorNumber As Integer
_tokenHandle = IntPtr.Zero
_dupeTokenHandle = IntPtr.Zero
If Not LogonUser(_username, _domainname, _password, LOGON32_LOGON_NEW_CREDENTIALS, LOGON32_PROVIDER_WINNT50, _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
Public ReadOnly Property username() As String
Get
Return _username
End Get
End Property
Public ReadOnly Property domainname() As String
Get
Return _domainname
End Get
End Property
Public ReadOnly Property currentWindowsUsername() As String
Get
Return System.Security.Principal.WindowsIdentity.GetCurrent().Name
End Get
End Property
#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
<System.Runtime.InteropServices.DllImport("kernel32.dll")> _
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
This will allow you to impersonate a designated user for a session. so you would than change your code to:
Dim domain, username, passwordStr, remoteServerName As String
Dim password As New Security.SecureString
Dim command As New Process
domain = "domain.com"
username = "username"
passwordStr = "password"
remoteServerName = "serverName"
Dim impersonator As New AliasAccount(username, password)
For Each c As Char In passwordStr.ToCharArray
password.AppendChar(c)
Next
command.StartInfo.FileName = "explorer.exe"
command.StartInfo.Arguments = "\\" & serverName & "\admin$\Temp"
command.StartInfo.UserName = username
command.StartInfo.Password = password
command.StartInfo.Domain = domain
command.StartInfo.Verb = "open"
command.StartInfo.UseShellExecute = False
impersonator.BeginImpersonation()
command.Start()
impersonator.EndImpersonation()
The answer given is a very long-winded solution that is unnecessary. I know the answer is from 2011, but all you need to do is the following:
Public Sub Open_Remote_Connection(ByVal strComputer As String, ByVal strUsername As String, ByVal strPassword As String)
Try
Dim procInfo As New ProcessStartInfo
procInfo.FileName = "net"
procInfo.Arguments = "use \\" & strComputer & "\c$ /USER:" & strUsername & " " & strPassword
procInfo.WindowStyle = ProcessWindowStyle.Hidden
procInfo.CreateNoWindow = True
Dim proc As New Process
proc.StartInfo = procInfo
proc.Start()
proc.WaitForExit(15000)
Catch ex As Exception
MsgBox("Open_Remote_Connection" & vbCrLf & vbCrLf & ex.Message, 4096, "Error")
End Try
End Sub
and then this function to actually open the C$ share:
Private Sub OpenCDriveofPC(ByVal compName As String)
Try
If isPingable(compName) Then
Open_Remote_Connection(compName, strUserName, strPassword)
Process.Start("explorer.exe", "\\" & compName & "\c$")
End If
Catch ex As Exception
MsgBox("OpenCDriveofPC" & vbCrLf & vbCrLf & ex.message, 4096, "Error")
Finally
Close_Remote_Connection("net use \\" & compName & "\c$ /delete /yes")
End Try
And here is the 'Close_Remote_Connection' sub, which needs to be called so that you don't make your net use list get crazy huge. Even if you call this sub, you will still have full admin rights to the c$ you open:
Public Sub Close_Remote_Connection(ByVal device As String)
Shell("cmd.exe /c " & device, vbHidden)
End Sub
I looked all over the Internet for how to do this and no one came even close to this simplicity. It does exactly what you want and is crazy simple and not long-winded with all sorts of crazy functions/classes that just are not needed to do this simple thing.
Hope it helps others like it helped me! :)
LilD