I'm trying to set the icon from a generated Windows Form Application, here's my code.
Private Sub CompileSourceCode()
Dim cProvider As CodeDomProvider = New VBCodeProvider
Dim cParams As New CompilerParameters
Dim cResult As CompilerResults
Dim sourceCode As String = generate_exe.final_winform
With cParams
.GenerateInMemory = False
.GenerateExecutable = True
.OutputAssembly = "test.exe"
.CompilerOptions = "/target:winexe /win32icon:eye.ico"
.ReferencedAssemblies.AddRange({"System.dll", "System.Windows.Forms.dll", "Microsoft.VisualBasic.dll"})
.MainClass = "MyNamespace.form1"
End With
cResult = cProvider.CompileAssemblyFromSource(cParams, sourceCode)
cProvider.Dispose()
If cResult.Errors.HasErrors Then
MsgBox(cResult.Errors(0).Line.ToString & ", " & cResult.Errors(0).ErrorText)
End If
End Sub
The problem:
The first time i run it, it creates the EXE with the icon i chose.
The second time, if i just change the icon i want to use but leave it as the same OutputAssembly name (test.exe) it creates the EXE but with the old icon, doesn't update.
Edit: Found a very good solution, Although It's been a long time since my question, I think it could help someone else with the same problem using SHChangeNotify. Add that to the top of the code:
Const SHCNE_ASSOCCHANGED As Integer = &H8000000
Const SHCNF_IDLIST As Integer = 0
Private Class NativeMethods
<DllImport("shell32")>
Public Shared Sub SHChangeNotify(ByVal wEventId As Integer, ByVal flags As Integer, ByVal item1 As IntPtr, ByVal item2 As IntPtr)
End Sub
End Class
Usage: (before or after your compile command)
NativeMethods.SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, Nothing, Nothing)
I have this program that shows files with its icons using a ListView and it works a little bit fine but there's a problem, some files(.exe, .docx etc...) don't show their right icon like this. how do I fix that?
This is how I call the Shell:
' declare the Win32 API function SHGetFileInfo'
Public 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
' declare some constants that SHGetFileInfo requires'
Public Const SHGFI_ICON As Integer = &H100
Public Const SHGFI_SMALLICON As Integer = &H1
' define the SHFILEINFO structure'
Structure SHFILEINFO
Public hIcon As IntPtr
Public iIcon As Integer
Public dwAttributes As Integer
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=260)> _
Public szDisplayName As String
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=80)> _
Public szTypeName As String
End Structure
Function RetrieveShellIcon(ByVal argPath As String) As Image
Dim mShellFileInfo As SHFILEINFO
Dim mSmallImage As IntPtr
Dim mIcon As System.Drawing.Icon
Dim mCompositeImage As Image
mShellFileInfo = New SHFILEINFO
mShellFileInfo.szDisplayName = New String(Chr(0), 260)
mShellFileInfo.szTypeName = New String(Chr(0), 80)
mSmallImage = SHGetFileInfo(argPath, 0, mShellFileInfo, System.Runtime.InteropServices.Marshal.SizeOf(mShellFileInfo), SHGFI_ICON Or SHGFI_SMALLICON)
' create the icon from the icon handle'
Try
mIcon = System.Drawing.Icon.FromHandle(mShellFileInfo.hIcon)
mCompositeImage = mIcon.ToBitmap
Catch ex As Exception
' create a blank black bitmap to return'
mCompositeImage = New Bitmap(16, 16)
End Try
' return the composited image'
Return mCompositeImage
End Function
Function GetIcon(ByVal argFilePath As String) As Image
Dim mFileExtension As String = System.IO.Path.GetExtension(argFilePath)
' add the image if it doesn't exist'
If cIcons.ContainsKey(mFileExtension) = False Then
cIcons.Add(mFileExtension, RetrieveShellIcon(argFilePath))
End If
' return the image'
Return cIcons(mFileExtension)
End Function
and this is how I show file icons in my `ListView.
Sub lv1items()
Dim lvi As ListViewItem
Dim di As New DirectoryInfo(Form2.TextBox1.Text)
Dim exts As New List(Of String)
ImageList1.Images.Clear()
If di.Exists = False Then
MessageBox.Show("Source path is not found", "Directory Not Found", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
For Each fi As FileInfo In di.EnumerateFiles("*.*")
lvi = New ListViewItem
lvi.Text = fi.Name
lvi.SubItems.Add(((fi.Length / 1024)).ToString("0.00"))
lvi.SubItems.Add(fi.CreationTime.ToShortDateString)
If exts.Contains(fi.Extension) = False Then
Dim mShellIconManager As New Form1
For Each mFilePath As String In My.Computer.FileSystem.GetFiles(Form2.TextBox1.Text)
ImageList1.Images.Add(fi.Extension, GetIcon(mFilePath))
exts.Add(fi.Extension)
Next
End If
lvi.ImageKey = fi.Extension
ListView1.Items.Add(lvi)
Next
End If
End Sub
That appears to be a weird limitation of the .net implication
its really just making a call to shell32.dll
You should call the function in shell32 directly
something like this should work
<DllImport("shell32.dll")>
Private Shared Function ExtractAssociatedIcon(hInst As IntPtr, lpIconPath As StringBuilder, ByRef lpiIcon As UShort) As IntPtr
End Function
_
Dim handle As IntPtr = SafeNativeMethods.ExtractAssociatedIcon(New HandleRef(Nothing, IntPtr.Zero), iconPath, index)
If handle <> IntPtr.Zero Then
Return Icon.FromHandle(handle)
End If
The syntax might not be exactly correct, also there is a good blog post about how to pull that information from the registry (which won't always give you the correct answer, but its faster)
Building a Better ExtractIcon (he uses the SHGetFileInfo API in shell32.dll if that blog ever dies it will give people a place to start looking)
I would like to detect hidden instances of SolidWorks.exe before connecting to the object in my application. The reason is that SolidWorks sometimes closes unexpectedly but is still open in background processes as indicated with task manager. So when my application starts I want to connect to a visible instance or create a new instance making sure that no hidden instances exist.
How can I kill the hidden instance?
Dim procs() As Process = Process.GetProcessesByName("SLDWORKS")
For Each proc As Process In procs
'.hidden is not a real property for proc, but for questioning only
if proc.hidden = true Then
proc.kill()
End If
Next
You can get the window state of the process and use that to determine whether or not it is currently visible to the user, as described in this StackOverflow question:
Get window state of another process
This will involve using P/Invoke (unmanaged code), just FYI.
For your convenience, here's the same code from that answer translated to VB:
Shared Sub Main(args() As String)
Dim procs() As Process = Process.GetProcesses()
For Each proc As Process In procs
If proc.ProcessName = "notepad" Then
Dim placement = GetPlacement(proc.MainWindowHandle)
MessageBox.Show(placement.showCmd.ToString())
End If
Next
End Sub
Private Shared Function GetPlacement(hwnd As IntPtr) As WINDOWPLACEMENT
Dim placement As WINDOWPLACEMENT = New WINDOWPLACEMENT()
placement.length = Marshal.SizeOf(placement)
GetWindowPlacement(hwnd, placement)
Return placement
End Function
<DllImport("user32.dll", SetLastError:=True)>
Friend Shared Function GetWindowPlacement(ByVal hWnd As IntPtr, ByRef lpwndpl As WINDOWPLACEMENT) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
<Serializable>
<StructLayout(LayoutKind.Sequential)>
Friend Structure WINDOWPLACEMENT
Public length As Integer
Public flags As Integer
Public showCmd As ShowWindowCommands
Public ptMinPosition As System.Drawing.Point
Public ptMaxPosition As System.Drawing.Point
Public rcNormalPosition As System.Drawing.Rectangle
End Structure
Friend Enum ShowWindowCommands As Integer
Hide = 0
Normal = 1
Minimized = 2
Maximized = 3
End Enum
If the window is indeed in a "Normal" window state, then perhaps its position is not one to which you have access. Try using this code to show the position of the window.
Dim procs() As Process = Process.GetProcesses()
For Each proc As Process In procs
If proc.ProcessName = "notepad" Then
Dim placement = GetPlacement(proc.MainWindowHandle)
MessageBox.Show(placement.showCmd.ToString())
Dim windowRect As Rectangle = New Rectangle()
GetWindowRect(proc.MainWindowHandle, windowRect)
MessageBox.Show(windowRect.Top.ToString() + " | " + windowRect.Left.ToString() + " | " + windowRect.Bottom.ToString() + " | " + windowRect.Right.ToString())
End If
Next
And here's the declaration for GetWindowRect
<DllImport("user32.dll", SetLastError:=True)> _
Friend Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef lprect As Rectangle) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
Since the window border is non-traditional, let's try this guy:
<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
Friend Shared Function IsWindowVisible(ByVal hWnd As IntPtr) As Boolean
End Function
Here is a solution that I ended up creating that works for our needs.
You can verify the results by using the task manager.
VB Version
Public Function ConnectToSolidWorks() As sldworks.SldWorks
Dim sw As sldworks.SldWorks = Nothing
Dim ProcessID As Integer = 0
'GetObject
'Will only attach to an active solidworks session in the (Apps)
'Will NOT attach to solidworks session in (Background processes)
Try
sw = GetObject(, "SldWorks.Application")
If sw IsNot Nothing Then
If sw.Visible = False Then sw.Visible = True
ProcessID = sw.GetProcessID
End If
Catch ex As Exception
End Try
'Kill any other session of solidworks other than the active session
'by comparing the ProcessID's
Dim procs() As Process = Process.GetProcessesByName("SLDWORKS")
For Each proc As Process In procs
If proc.Id <> ProcessID Then
proc.Kill()
End If
Next
'CreateObject
'If GetObject did not attach to an active session of solidworks then
'create a brand new instance of solidworks session
If sw Is Nothing Then
sw = CreateObject("SldWorks.Application")
If sw IsNot Nothing Then
If sw.Visible = False Then sw.Visible = True
End If
End If
Return sw
End Function
C# Version
public sldworks.SldWorks ConnectToSolidWorks()
{
sldworks.SldWorks sw = null;
int ProcessID = 0;
//GetObject
//Will only attach to an active solidworks session in the (Apps)
//Will NOT attach to solidworks session in (Background processes)
try {
sw = Interaction.GetObject(, "SldWorks.Application");
if (sw != null) {
if (sw.Visible == false)
sw.Visible = true;
ProcessID = sw.GetProcessID;
}
} catch (Exception ex) {
}
//Kill any other session of solidworks other than the active session
//by comparing the ProcessID's
Process[] procs = Process.GetProcessesByName("SLDWORKS");
foreach (Process proc in procs) {
if (proc.Id != ProcessID) {
proc.Kill();
}
}
//CreateObject
//If GetObject did not attach to an active session of solidworks then
//create a brand new instance of solidworks session
if (sw == null) {
sw = Interaction.CreateObject("SldWorks.Application");
if (sw != null) {
if (sw.Visible == false)
sw.Visible = true;
}
}
return sw;
}
how i can show textbox in FolderBrowserDialog like below image,
This is not directly possible, you have to fallback to using the shell function. Project + Add Reference, Browse tab, select c:\windows\system32\shell32.dll. An example of how to use it in a Winforms app:
Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
Dim options As Integer = &H40 + &H200 + &H20
options += &H10 '' Adds edit box
Dim shell = New Shell32.ShellClass
Dim root = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
Dim folder = CType(shell.BrowseForFolder(CInt(Me.Handle), _
"Select folder", options, root), Shell32.Folder2)
If folder IsNot Nothing Then
MsgBox("You selected " + folder.Self.Path)
End If
End Sub
Check this out : FolderBrowserDialogEx: A C# customization of FolderBrowserDialog
The code is in C#, Here is the VB Conversion
Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Diagnostics
Namespace DaveChambers.FolderBrowserDialogEx
Public Class FolderBrowserDialogEx
#Region "Fields that mimic the same-named fields in FolderBrowserDialog"
Public Property RootFolder() As Environment.SpecialFolder
Get
Return m_RootFolder
End Get
Set
m_RootFolder = Value
End Set
End Property
Private m_RootFolder As Environment.SpecialFolder
Public Property SelectedPath() As String
Get
Return m_SelectedPath
End Get
Set
m_SelectedPath = Value
End Set
End Property
Private m_SelectedPath As String
Public Property ShowNewFolderButton() As Boolean
Get
Return m_ShowNewFolderButton
End Get
Set
m_ShowNewFolderButton = Value
End Set
End Property
Private m_ShowNewFolderButton As Boolean
Public Property StartPosition() As FormStartPosition
Get
Return m_StartPosition
End Get
Set
m_StartPosition = Value
End Set
End Property
Private m_StartPosition As FormStartPosition
#End Region
' Fields specific to CustomFolderBrowserDialog
Public Property Title() As String
Get
Return m_Title
End Get
Set
m_Title = Value
End Set
End Property
Private m_Title As String
Public Property ShowEditbox() As Boolean
Get
Return m_ShowEditbox
End Get
Set
m_ShowEditbox = Value
End Set
End Property
Private m_ShowEditbox As Boolean
' These are the control IDs used in the dialog
Private Structure CtlIds
Public Const PATH_EDIT As Integer = &H3744
'public const int PATH_EDIT_LABEL = 0x3748; // Only when BIF_NEWDIALOGSTYLE
Public Const TITLE As Integer = &H3742
Public Const TREEVIEW As Integer = &H3741
Public Const NEW_FOLDER_BUTTON As Integer = &H3746
Public Const IDOK As Integer = 1
Public Const IDCANCEL As Integer = 2
End Structure
<StructLayout(LayoutKind.Sequential, CharSet := CharSet.Unicode)> _
Public Structure InitData
' Titles shouldn't too long, should they?
<MarshalAs(UnmanagedType.ByValTStr, SizeConst := 128)> _
Public Title As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst := Win32.MAX_PATH)> _
Public InitialPath As String
Public ShowEditbox As Boolean
Public ShowNewFolderButton As Boolean
Public StartPosition As FormStartPosition
Public hParent As IntPtr
Public Sub New(dlg As FolderBrowserDialogEx, hParent As IntPtr)
' We need to make copies of these values from the dialog.
' I tried passing the dlg obj itself in this struct, but Windows will barf after repeated invocations.
Me.Title = dlg.Title
Me.InitialPath = dlg.SelectedPath
Me.ShowNewFolderButton = dlg.ShowNewFolderButton
Me.ShowEditbox = dlg.ShowEditbox
Me.StartPosition = dlg.StartPosition
Me.hParent = hParent
End Sub
End Structure
Public Sub New()
Title = "Browse For Folder"
' Default to same caption as std dialog
RootFolder = Environment.SpecialFolder.Desktop
SelectedPath = "c:\"
ShowEditbox = False
ShowNewFolderButton = False
StartPosition = FormStartPosition.WindowsDefaultLocation
End Sub
Public Function ShowDialog(owner As IWin32Window) As DialogResult
Dim initdata As New InitData(Me, owner.Handle)
Dim bi As New Win32.BROWSEINFO()
bi.iImage = 0
bi.hwndOwner = owner.Handle
If 0 <> Win32.SHGetSpecialFolderLocation(owner.Handle, CInt(Me.RootFolder), bi.pidlRoot) Then
bi.pidlRoot = IntPtr.Zero
End If
bi.lpszTitle = ""
bi.ulFlags = Win32.BIF_RETURNONLYFSDIRS
' do NOT use BIF_NEWDIALOGSTYLE or BIF_STATUSTEXT
If Me.ShowEditbox Then
bi.ulFlags = bi.ulFlags Or Win32.BIF_EDITBOX
End If
If Not Me.ShowNewFolderButton Then
bi.ulFlags = bi.ulFlags Or Win32.BIF_NONEWFOLDERBUTTON
End If
bi.lpfn = New Win32.BrowseCallbackProc(_browseCallbackHandler)
' Initialization data, used in _browseCallbackHandler
Dim hInit As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(initdata))
Marshal.StructureToPtr(initdata, hInit, True)
bi.lParam = hInit
Dim pidlSelectedPath As IntPtr = IntPtr.Zero
Try
pidlSelectedPath = Win32.SHBrowseForFolder(bi)
Dim sb As New StringBuilder(256)
If Win32.SHGetPathFromIDList(pidlSelectedPath, sb) Then
SelectedPath = sb.ToString()
Return DialogResult.OK
End If
Finally
' Caller is responsible for freeing this memory.
Marshal.FreeCoTaskMem(pidlSelectedPath)
End Try
Return DialogResult.Cancel
End Function
Private Function _browseCallbackHandler(hDlg As IntPtr, msg As Integer, lParam As IntPtr, lpData As IntPtr) As Integer
Select Case msg
Case Win32.BFFM_INITIALIZED
' remove context help button from dialog caption
Dim lStyle As Integer = Win32.GetWindowLong(hDlg, Win32.GWL_STYLE)
lStyle = lStyle And Not Win32.DS_CONTEXTHELP
Win32.SetWindowLong(hDlg, Win32.GWL_STYLE, lStyle)
lStyle = Win32.GetWindowLong(hDlg, Win32.GWL_EXSTYLE)
lStyle = lStyle And Not Win32.WS_EX_CONTEXTHELP
Win32.SetWindowLong(hDlg, Win32.GWL_EXSTYLE, lStyle)
_adjustUi(hDlg, lpData)
Exit Select
Case Win32.BFFM_SELCHANGED
If True Then
Dim ok As Boolean = False
Dim sb As New StringBuilder(Win32.MAX_PATH)
If Win32.SHGetPathFromIDList(lParam, sb) Then
ok = True
Dim dir As String = sb.ToString()
Dim hEdit As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.PATH_EDIT)
Win32.SetWindowText(hEdit, dir)
#If UsingStatusText Then
' We're not using status text, but if we were, this is how you'd set it
Win32.SendMessage(hDlg, Win32.BFFM_SETSTATUSTEXTW, 0, dir)
#End If
#If SHBrowseForFolder_lists_links Then
' This check doesn't seem to be necessary - the SHBrowseForFolder dirtree doesn't seem to list links
Dim sfi As New Win32.SHFILEINFO()
Win32.SHGetFileInfo(lParam, 0, sfi, Marshal.SizeOf(sfi), Win32.SHGFI_PIDL Or Win32.SHGFI_ATTRIBUTES)
' fail if pidl is a link
If (sfi.dwAttributes And Win32.SFGAO_LINK) = Win32.SFGAO_LINK Then
ok = False
#End If
End If
End If
' if invalid selection, disable the OK button
If Not ok Then
Win32.EnableWindow(Win32.GetDlgItem(hDlg, CtlIds.IDOK), False)
End If
Exit Select
End If
End Select
Return 0
End Function
Private Sub _adjustUi(hDlg As IntPtr, lpData As IntPtr)
' Only do the adjustments if InitData was supplied
If lpData = IntPtr.Zero Then
Return
End If
Dim obj As Object = Marshal.PtrToStructure(lpData, GetType(InitData))
If obj Is Nothing Then
Return
End If
Dim initdata As InitData = DirectCast(obj, InitData)
' Only do the adjustments if we can find the dirtree control
Dim hTree As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.TREEVIEW)
If hTree = IntPtr.Zero Then
hTree = Win32.FindWindowEx(IntPtr.Zero, IntPtr.Zero, "SysTreeView32", IntPtr.Zero)
If hTree = IntPtr.Zero Then
' This usually means that BIF_NEWDIALOGSTYLE is enabled.
hTree = Win32.FindWindowEx(hDlg, IntPtr.Zero, "SHBrowseForFolder ShellNameSpace Control", IntPtr.Zero)
End If
End If
If hTree = IntPtr.Zero Then
Return
End If
' Prep the basic UI
Win32.SendMessage(hDlg, Win32.BFFM_SETSELECTIONW, 1, initdata.InitialPath)
Win32.SetWindowText(hDlg, initdata.Title)
If initdata.StartPosition = FormStartPosition.CenterParent Then
_centerTo(hDlg, initdata.hParent)
ElseIf initdata.StartPosition = FormStartPosition.CenterScreen Then
_centerTo(hDlg, Win32.GetDesktopWindow())
End If
' else we do nothing
' Prep the edit box
Dim rcEdit As New Win32.RECT()
Dim hEdit As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.PATH_EDIT)
If hEdit <> IntPtr.Zero Then
If initdata.ShowEditbox Then
Win32.GetWindowRect(hEdit, rcEdit)
Win32.ScreenToClient(hEdit, rcEdit)
Else
Win32.ShowWindow(hEdit, Win32.SW_HIDE)
End If
End If
' make the dialog larger
Dim rcDlg As Win32.RECT
Win32.GetWindowRect(hDlg, rcDlg)
rcDlg.Right += 40
rcDlg.Bottom += 30
If hEdit <> IntPtr.Zero Then
rcDlg.Bottom += (rcEdit.Height + 5)
End If
Win32.MoveWindow(hDlg, rcDlg, True)
Win32.GetClientRect(hDlg, rcDlg)
Dim vMargin As Integer = 10
' Accomodate the resizing handle's width
Dim hMargin As Integer = 10
' SystemInformation.VerticalScrollBarWidth;
' Move the Cancel button
Dim rcCancel As New Win32.RECT()
Dim hCancel As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.IDCANCEL)
If hCancel <> IntPtr.Zero Then
Win32.GetWindowRect(hCancel, rcCancel)
Win32.ScreenToClient(hDlg, rcCancel)
rcCancel = New Win32.RECT(rcDlg.Right - (rcCancel.Width + hMargin), rcDlg.Bottom - (rcCancel.Height + vMargin), rcCancel.Width, rcCancel.Height)
Win32.MoveWindow(hCancel, rcCancel, False)
End If
' Move the OK button
Dim rcOK As New Win32.RECT()
Dim hOK As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.IDOK)
If hOK <> IntPtr.Zero Then
Win32.GetWindowRect(hOK, rcOK)
Win32.ScreenToClient(hDlg, rcOK)
rcOK = New Win32.RECT(rcCancel.Left - (rcCancel.Width + hMargin), rcCancel.Top, rcOK.Width, rcOK.Height)
Win32.MoveWindow(hOK, rcOK, False)
End If
' Manage the "Make New Folder" button
Dim hBtn As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.NEW_FOLDER_BUTTON)
If Not initdata.ShowNewFolderButton Then
' Make sure this button is not visible
Win32.ShowWindow(hBtn, Win32.SW_HIDE)
ElseIf hBtn = IntPtr.Zero Then
' Create a button - button is only auto-created under BIF_NEWDIALOGSTYLE
' This is failing, and I don't know why!
hBtn = Win32.CreateWindowEx(&H50010000, "button", "&Make New Folder", &H4, hMargin, rcOK.Top, _
105, rcOK.Height, hDlg, New IntPtr(CtlIds.NEW_FOLDER_BUTTON), Process.GetCurrentProcess().Handle, IntPtr.Zero)
End If
' Position the path editbox and it's label
' We'll repurpose the Title (static) control as the editbox label
Dim treeTop As Integer = vMargin
If hEdit <> IntPtr.Zero Then
Dim xEdit As Integer = hMargin
Dim cxEdit As Integer = rcDlg.Width - (2 * hMargin)
Dim hLabel As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.TITLE)
If hLabel <> IntPtr.Zero Then
Dim labelText As String = "Folder: "
Win32.SetWindowText(hLabel, labelText)
' This code obtains the required size of the static control that serves as the label for the editbox.
' All this GDI code is a bit excessive, but I figured "what the hell".
Dim hdc As IntPtr = Win32.GetDC(hLabel)
Dim hFont As IntPtr = Win32.SendMessage(hLabel, Win32.WM_GETFONT, IntPtr.Zero, IntPtr.Zero)
Dim oldfnt As IntPtr = Win32.SelectObject(hdc, hFont)
Dim szLabel As Size = Size.Empty
Win32.GetTextExtentPoint32(hdc, labelText, labelText.Length, szLabel)
Win32.SelectObject(hdc, oldfnt)
Win32.ReleaseDC(hLabel, hdc)
Dim rcLabel As New Win32.RECT(hMargin, vMargin + ((rcEdit.Height - szLabel.Height) / 2), szLabel.Width, szLabel.Height)
Win32.MoveWindow(hLabel, rcLabel, False)
xEdit += rcLabel.Width
cxEdit -= rcLabel.Width
End If
' Expand the folder tree to fill the dialog
rcEdit = New Win32.RECT(xEdit, vMargin, cxEdit, rcEdit.Height)
Win32.MoveWindow(hEdit, rcEdit, False)
treeTop = rcEdit.Bottom + 5
End If
Dim rcTree As New Win32.RECT(hMargin, treeTop, rcDlg.Width - (2 * hMargin), rcDlg.Bottom - (treeTop + (2 * vMargin) + rcOK.Height))
Win32.MoveWindow(hTree, rcTree, False)
End Sub
Private Sub _centerTo(hDlg As IntPtr, hRef As IntPtr)
Dim rcDlg As Win32.RECT
Win32.GetWindowRect(hDlg, rcDlg)
Dim rcRef As Win32.RECT
Win32.GetWindowRect(hRef, rcRef)
Dim cx As Integer = (rcRef.Width - rcDlg.Width) / 2
Dim cy As Integer = (rcRef.Height - rcDlg.Height) / 2
Dim rcNew As New Win32.RECT(rcRef.Left + cx, rcRef.Top + cy, rcDlg.Width, rcDlg.Height)
Win32.MoveWindow(hDlg, rcNew, True)
End Sub
End Class
End Namespace
'=======================================================
'Service provided by Telerik (www.telerik.com)
'Conversion powered by NRefactory.
'Twitter: #telerik, #toddanglin
'Facebook: facebook.com/telerik
'=======================================================
I see two issues with the above dialogboxes (and any other dialog I've seen):
1: You cannot specify a custom start folder which will be preselected when the dialogbox opens, let's say "c:\temp"
2: When you type a path in the textbox and push TAB or ENTER this should NOT be seen as the final selected folder, but the treeview should instead move and expand to that path (just as if you did the same in Windows Explorer).
(sorry for putting this as an answer, cannot make a comment)
I am wanting to retrieve all the files in some directories. Here is my original code:
Private Function Search(path As String, Recursive As Boolean) As Boolean
Dim dirInfo As New IO.DirectoryInfo(path)
Dim fileObject As FileSystemInfo
If Recursive = True Then
For Each fileObject In dirInfo.GetFileSystemInfos()
If fileObject.Attributes = FileAttributes.Directory Then
Search(fileObject.FullName, Recursive)
Else
lstFiles.Items.Add(fileObject.FullName)
End If
Next
Else
For Each fileObject In dirInfo.GetFileSystemInfos()
lstFiles.Items.Add(fileObject.FullName)
Next
End If
Return True
End Function
This code works well, yet it returns some directories and I am wanting to only return files.
I tried this code:
Private Sub Search(ByVal path As String, ByVal Recursive As Boolean)
if not Directory.Exists(path) then Exit Sub
Dim initDirInfo As New DirectoryInfo(path)
For Each oFileInfo In initDirInfo.GetFiles
lstfiles.items.add(oFileInfo.Name)
Next
If Recursive Then
For Each oDirInfo In initDirInfo.GetDirectories
Search(oDirInfo.FullName, True)
Next
End If
End Sub
However, i get the following error:
Access to the path 'C:\Users\Simon\AppData\Local\Application Data\' is denied.
Can someone help me with my original code, or help me access these directories with my new code?
thanks
EDIT:
I have added this module to get it working:
Imports System.Security.Principal
Module VistaSecurity
'Declare API
Private Declare Ansi Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
Private Const BCM_FIRST As Int32 = &H1600
Private Const BCM_SETSHIELD As Int32 = (BCM_FIRST + &HC)
Public Function IsVistaOrHigher() As Boolean
Return Environment.OSVersion.Version.Major < 6
End Function
' Checks if the process is elevated
Public Function IsAdmin() As Boolean
Dim id As WindowsIdentity = WindowsIdentity.GetCurrent()
Dim p As WindowsPrincipal = New WindowsPrincipal(id)
Return p.IsInRole(WindowsBuiltInRole.Administrator)
End Function
' Add a shield icon to a button
Public Sub AddShieldToButton(ByRef b As Button)
b.FlatStyle = FlatStyle.System
SendMessage(b.Handle, BCM_SETSHIELD, 0, &HFFFFFFFF)
End Sub
' Restart the current process with administrator credentials
Public Sub RestartElevated()
Dim startInfo As ProcessStartInfo = New ProcessStartInfo()
startInfo.UseShellExecute = True
startInfo.WorkingDirectory = Environment.CurrentDirectory
startInfo.FileName = Application.ExecutablePath
startInfo.Verb = "runas"
Try
Dim p As Process = Process.Start(startInfo)
Catch ex As Exception
Return 'If cancelled, do nothing
End Try
Application.Exit()
End Sub
End Module
The access denied errors are occurring at Windows Libraries I think. I don't think there is any way to list the file in these libraries as they aren't actually folders.