Open remote shared folder with credentials - vb.net

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

Related

Cannot connect to Server as Administrator with Impersonate

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.

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

Implementing D3DCompileFromFile in VB.NET gives me a "has unbalanced the stack." error

I have taken parts of the code from Shazzam Shader Editor (http://shazzam.codeplex.com/) and modified the code to use the Compile From file instead of memory
(https://msdn.microsoft.com/en-us/library/windows/desktop/hh446872(v=vs.85).aspx)
<Guid("8BA5FB08-5195-40e2-AC58-0D989C3A0102"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Private Interface ID3DBlob
<PreserveSig> _
Function GetBufferPointer() As IntPtr
<PreserveSig> _
Function GetBufferSize() As Integer
End Interface
<PreserveSig> _
<DllImport("d3dcompiler_47.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.Cdecl)> _
Private Function D3DCompileFromFile(<MarshalAs(UnmanagedType.LPTStr)> pFilename As String,
pDefines As IntPtr,
pInclude As IntPtr,
<MarshalAs(UnmanagedType.LPTStr)> pEntrypoint As String,
<MarshalAs(UnmanagedType.LPTStr)> pTarget As String,
flags1 As Integer,
flags2 As Integer,
ByRef ppCode As ID3DBlob,
ByRef ppErrorMsgs As ID3DBlob) As Integer
End Function
Public Sub Compile(ByVal File As HLSLFileHelperClass)
Dim pFilename As String = File.GetSourceFileFullName ' C:\MyPSFiles\GaussianFilter.fx
Dim pDefines As IntPtr = IntPtr.Zero
Dim pInclude As IntPtr = IntPtr.Zero
Dim pEntrypoint As String = File.HLSLEntryPoint ' main
Dim pTarget As String = File.ShaderCompilerVersion.ToString ' ps_3_0
Dim flags1 As Integer = 0
Dim flags2 As Integer = 0
Dim ppCode As ID3DBlob
Dim ppErrorMsgs As ID3DBlob
Dim CompileResult As Integer = 0
CompileResult = D3DCompileFromFile(pFilename,
pDefines,
pInclude,
pEntrypoint,
pTarget,
flags1,
flags2,
ppCode,
ppErrorMsgs)
If CompileResult <> 0 Then
Dim errors As IntPtr = ppErrorMsgs.GetBufferPointer()
Dim size As Integer = ppErrorMsgs.GetBufferSize()
ErrorText = Marshal.PtrToStringAnsi(errors)
IsCompiled = False
Else
ErrorText = ""
IsCompiled = True
Dim psPath = File.GetCompiledFileFullName
Dim pCompiledPs As IntPtr = ppCode.GetBufferPointer()
Dim compiledPsSize As Integer = ppCode.GetBufferSize()
Dim compiledPs = New Byte(compiledPsSize - 1) {}
Marshal.Copy(pCompiledPs, compiledPs, 0, compiledPs.Length)
Using psFile = IO.File.Open(psPath, FileMode.Create, FileAccess.Write)
psFile.Write(compiledPs, 0, compiledPs.Length)
End Using
End If
If ppCode IsNot Nothing Then
Marshal.ReleaseComObject(ppCode)
End If
ppCode = Nothing
If ppErrorMsgs IsNot Nothing Then
Marshal.ReleaseComObject(ppErrorMsgs)
End If
ppErrorMsgs = Nothing
End Sub
The code as it is now gives me the error:
A call to PInvoke function '::D3DCompileFromFile' has
unbalanced the stack. This is likely because the managed PInvoke
signature does not match the unmanaged target signature. Check that
the calling convention and parameters of the PInvoke signature match
the target unmanaged signature.
If I remove the line:
CallingConvention:=CallingConvention.Cdecl
The compiler seems to run, but now I get the error message:
X3506 unrecognized compiler target 'p'
It seems to just read the first char in the string? So, what am I doing wrong here?
Got it working and I did two things:
First I moved it all into a Module:
Module Extend
<Guid("8BA5FB08-5195-40e2-AC58-0D989C3A0102"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface ID3DBlob
<PreserveSig> _
Function GetBufferPointer() As IntPtr
<PreserveSig> _
Function GetBufferSize() As Integer
End Interface
<PreserveSig> _
<DllImport("d3dcompiler_47.dll", CharSet:=CharSet.Auto)> _
Public Function D3DCompileFromFile(<MarshalAs(UnmanagedType.LPTStr)> pFilename As String,
pDefines As IntPtr,
pInclude As IntPtr,
<MarshalAs(UnmanagedType.LPStr)> pEntrypoint As String,
<MarshalAs(UnmanagedType.LPStr)> pTarget As String,
flags1 As Integer,
flags2 As Integer,
ByRef ppCode As ID3DBlob,
ByRef ppErrorMsgs As ID3DBlob) As Integer
End Function
End Module
Secondly I changed the:
<MarshalAs(UnmanagedType.LPTStr)>
to
<MarshalAs(UnmanagedType.LPStr)>
Seems I got a bit frustrated and changed things that worked too :S

Get url from all open tabs in Google Chrome using VB .Net and UI Automation

Hello I have this code working to get current url on Chrome, but only get active tab url. I need to get url from all open tabs using UI Automation.
My working code:
Function GetChromeUrl(ByVal proc As Process) As String
If proc.MainWindowHandle = IntPtr.Zero Then
Return Nothing
End If
Dim element As System.Windows.Automation.AutomationElement = AutomationElement.FromHandle(proc.MainWindowHandle)
If element Is Nothing Then
Return Nothing
End If
Dim edit As System.Windows.Automation.AutomationElement = element.FindFirst(TreeScope.Children, New PropertyCondition(AutomationElement.ControlTypeProperty, ControlType.Edit))
Return (edit.GetCurrentPattern(ValuePattern.Pattern)).Current.Value.ToString
End Function
and call it using this code in Form Load event:
For Each proc As Process In Process.GetProcessesByName("chrome")
MsgBox(proc.MainWindowTitle + " " + GetChromeUrl(proc))
Next
you better try this way
Imports NDde.Client 'import the NDde library for firefox
Imports System.Runtime.InteropServices
'For Chrome
Private Const WM_GETTEXTLENGTH As Integer = &He
Private Const WM_GETTEXT As Integer = &Hd
<DllImport("user32.dll")> _
Private Shared Function SendMessage(hWnd As IntPtr, Msg As UInteger, wParam As Integer, lParam As Integer) As Integer
End Function
<DllImport("user32.dll")> _
Private Shared Function SendMessage(hWnd As IntPtr, Msg As UInteger, wParam As Integer, lParam As StringBuilder) As Integer
End Function
<DllImport("user32.dll", SetLastError := True)> _
Private Shared Function FindWindowEx(parentHandle As IntPtr, childAfter As IntPtr, className As String, windowTitle As String) As IntPtr
End Function
Public Shared Function getChromeUrl(winHandle As IntPtr) As String
Dim browserUrl As String = Nothing
Dim urlHandle As IntPtr = FindWindowEx(winHandle, IntPtr.Zero, "Chrome_AutocompleteEditView", Nothing)
Const nChars As Integer = 256
Dim Buff As New StringBuilder(nChars)
Dim length As Integer = SendMessage(urlHandle, WM_GETTEXTLENGTH, 0, 0)
If length > 0 Then
SendMessage(urlHandle, WM_GETTEXT, nChars, Buff)
browserUrl = Buff.ToString()
Return browserUrl
Else
Return browserUrl
End If
End Function
Public shared Function GetChromeHandle() As Intptr
Dim ChromeHandle As IntPtr = Nothing
Dim Allpro() As Process = Process.GetProcesses();
For Each pro As Process in Allpro
if pro.ProcessName = "chrome"
ChromeHandle = pro.MainWindowHandle
Exit For
End if
Next
Return ChromeHandle
End Function
'USAGE FOR CHROME
Dim CHandle As IntPtr = GetChromeHandle()
If Not CHandle,Equals(Intptr.Zero)
Dim url As String = getChromeUrl(CHandle)
End If
Source and read more
EDIT :
i found my own way and it worked for me
Dim appAs String = "chrome"
Dim proc As System.Diagnostics.Process = GetBrowser(app)
...
Private Function GetBrowser(ByVal appName) As System.Diagnostics.Process
Dim pList() As System.Diagnostics.Process =
System.Diagnostics.Process.GetProcessesByName(app)
For Each proc As System.Diagnostics.Process In pList
If proc.ProcessName = appThen
Return proc
End If
Next
Return Nothing
End Function
usage :
If proc IsNot Nothing Then
Dim browserName as string = "Google Chrome"
Dim className as String = "Edit"
Dim s As String =
GetCurrentUrl(proc.MainWindowHandle, browserName, className, ComboBox1)
If s <> "" Then
Msgbox.show(s)
ComboBox1.SelectedIndex = 0 'Window list
Else
End If
Else
Label1.Text = browserName & " is not available"
end If
hope it helps :))))

VB.net 1.1 TCPIP Printer Port creation with CreateProcessWithLogon API

A few months back I wrote a VB.net console application to migrate a group of about 100+ printers and the 1800+ users that use them from some old HP print appliances to a mixed Print Server and Direct to IP Printing solutions. The application uses a database to compare installed printers and remove old/invalid shares and remap to the new Win2K3 based print server OR create a TCPIP printer port and install the driver for direct to IP printing.
It worked really well, but users needed power user rights to create the TCPIP printer port. For the main campus this wasn't an issue, but the smaller remote sites need a solution that allows the app to be run by users without power user rights.
My solution was to take the "CreatePrinterIPPort" function and put it into it's own wrapper app and then call it as needed from the main app using a hard coded local admin account for the purpose, but I'm running into issues when spawning the createport app. If I run the app standalone it creates the port with no issue, but when I run it in my test app to spawn the createport using the CreateProcessWithLogon API the port creation fails with an "access denied" error. I'm limited to using .net 1.1 as 2.0 isn't in our environment throughly and I was told it wouldn't be pushed just for this app.
Any thoughts?
Source listed below.
Spawning app:
Imports System.Runtime.InteropServices
Module Module1
Region "API Structures"
<StructLayout(LayoutKind.Sequential)> _
Public Structure PROCESS_INFORMATION
Dim hProcess As System.IntPtr
Dim hThread As System.IntPtr
Dim dwProcessId As Integer
Dim dwThreadId As Integer
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure STARTUPINFO
Dim cb As Integer
Dim lpReserved As System.IntPtr
Dim lpDesktop As System.IntPtr
Dim lpTitle As System.IntPtr
Dim dwX As Integer
Dim dwY As Integer
Dim dwXSize As Integer
Dim dwYSize As Integer
Dim dwXCountChars As Integer
Dim dwYCountChars As Integer
Dim dwFillAttribute As Integer
Dim dwFlags As Integer
Dim wShowWindow As Short
Dim cbReserved2 As Short
Dim lpReserved2 As System.IntPtr
Dim hStdInput As System.IntPtr
Dim hStdOutput As System.IntPtr
Dim hStdError As System.IntPtr
End Structure
End Region
Region "API Constants"
Private Const LOGON_NETCREDENTIALS_ONLY As Integer = &H2
Private Const NORMAL_PRIORITY_CLASS As Integer = &H20
Private Const CREATE_DEFAULT_ERROR_MODE As Integer = &H4000000
Private Const CREATE_NEW_CONSOLE As Integer = &H10
Private Const CREATE_NEW_PROCESS_GROUP As Integer = &H200
Private Const LOGON_WITH_PROFILE As Integer = &H1
End Region
Region "API Functions"
Private Declare Unicode Function CreateProcessWithLogon Lib "Advapi32" Alias "CreateProcessWithLogonW" _
(ByVal lpUsername As String, _
ByVal lpDomain As String, _
ByVal lpPassword As String, _
ByVal dwLogonFlags As Integer, _
ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
ByVal dwCreationFlags As Integer, _
ByVal lpEnvironment As System.IntPtr, _
ByVal lpCurrentDirectory As System.IntPtr, _
ByRef lpStartupInfo As STARTUPINFO, _
ByRef lpProcessInfo As PROCESS_INFORMATION) As Integer
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As System.IntPtr) As Integer
End Region
Public Sub RunProgram(ByVal UserName As String, ByVal Password As String, ByVal Domain As String, ByVal Application As String, ByVal CommandLine As String)
Dim siStartup As STARTUPINFO
Dim piProcess As PROCESS_INFORMATION
Dim intReturn As Integer
If CommandLine Is Nothing OrElse CommandLine = "" Then CommandLine = String.Empty
siStartup.cb = Marshal.SizeOf(siStartup)
siStartup.dwFlags = 0
intReturn = CreateProcessWithLogon(UserName, Domain, Password, LOGON_WITH_PROFILE, Application, CommandLine, _
NORMAL_PRIORITY_CLASS Or CREATE_DEFAULT_ERROR_MODE Or CREATE_NEW_CONSOLE Or CREATE_NEW_PROCESS_GROUP, _
IntPtr.Zero, IntPtr.Zero, siStartup, piProcess)
If intReturn = 0 Then
Throw New System.ComponentModel.Win32Exception(Marshal.GetLastWin32Error())
End If
CloseHandle(piProcess.hProcess)
CloseHandle(piProcess.hThread)
End Sub
Overloads Sub Main(ByVal args() As String)
Dim command As String = "C:\Program Files\Printer Server Update Utility\CreatePrinterPort.exe"
Dim arguments As String = Chr(34) & "C:\Program Files\Printer Server Update Utility\CreatePrinterPort.exe" & Chr(34) & " /I:138.90.1.3"
Dim user As String = "PrintAdmin"
Dim domain As String = System.Environment.MachineName
Dim password As String = "Pa$$word" '<---- No not really
Dim currentDirectory As String = System.IO.Directory.GetCurrentDirectory()
RunProgram(user, password, domain, command, arguments)
System.Console.WriteLine("Please press the ENTER key to close window.")
System.Console.WriteLine("")
System.Console.Read()
End Sub
End Module
Function in TCPIP port creation app that does the work and fails when spawned in app above.
Function CreatePrinterIPPort(ByVal strPrinterIPAddress As String, Optional ByVal Protocol As Short = 1, Optional ByVal QueueName As String = "Dummy", _
Optional ByVal ByteCount As Boolean = False) As Boolean
' Protocal 1 = RAW (Default) 2 = LPR
System.Console.WriteLine("Attempting to create port at IP Address: " & strPrinterIPAddress)
Dim options As New ConnectionOptions
options.Impersonation = ImpersonationLevel.Impersonate
Dim mpBasePath As New ManagementPath("\.\ROOT\CIMV2")
Dim mpTCPIPPort As New ManagementPath("Win32_TCPIPPrinterPort")
Dim msLocalMachine As New ManagementScope(mpBasePath, options)
msLocalMachine.Connect()
Dim mcNetworkPorts As New ManagementClass(msLocalMachine, mpTCPIPPort, New ObjectGetOptions)
Dim moNewPort As ManagementObject = mcNetworkPorts.CreateInstance()
moNewPort.Properties("Name").Value = "IP_" & strPrinterIPAddress
moNewPort.Properties("Protocol").Value = Protocol
moNewPort.Properties("HostAddress").Value = strPrinterIPAddress
If Protocol = 1 Then
moNewPort.Properties("PortNumber").Value = "9100"
ElseIf Protocol = 2 Then
moNewPort.Properties("ByteCount").Value = ByteCount
moNewPort.Properties("Queue").Value = QueueName
End If
Try
moNewPort.Put()
Catch ex As Exception
System.Console.WriteLine("Port creation failed.")
System.Console.WriteLine(ex.Message.ToString)
Return False
End Try
System.Console.WriteLine("Created port at IP Address: " & strPrinterIPAddress)
Return True
End Function
Seem that WMI does not allow write access to an impersonated account, so I've moved on to using the prnadmin.dll to create ports. This requires me to check that the dll is registered and register if it isn't, but seems this is the only way I can find (and keep my sanity) to get this done.