System special folder

Option Strict On

Imports System.Runtime.InteropServices

Imports System.Threading

Public Class Form1

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

MyCode_put_in_This_module.Initialze()

End Sub

Private Sub Form1_Resize(sender As Object, e As EventArgs) Handles Me.Resize

MyCode_put_in_This_module.Form1Resize(CType(sender, Control))

End Sub

Dim Temp_Form1_Text As String

Protected Overrides Sub WndProc(ByRef m As Message)

Select Case m.Msg

Case WM_COMMAND

Dim ID As Int32 = m.WParam.ToInt32 And &HFFFF

Dim NotifyCode As Int32 = m.WParam.ToInt32 >> 16

Select Case NotifyCode

Case LBN_SELCHANGE

ListBox1_ChildClass.SelChange = ListBox1.SelectedIndex

m.Result = NULL : Exit Sub

Case LBN_DBLCLK

Dim sfi As SpecialFolderInfo = List_SpecialFolderInfo.Item(ListBox1.SelectedIndex)

ShowSelectedSpecialFolder(sfi)

m.Result = NULL : Exit Sub

End Select

Case ListBox1_SetFont

Me.Controls.Remove(ListBox1)

ListBox1.Dispose()

ListBox1 = New ListBox1_ChildClass(m.WParam.ToInt32)

Me.Controls.Add(ListBox1)

m.Result = NULL : Exit Sub

Case ListBox1_SelectedIndex

ListBox1.SelectedIndex = m.WParam.ToInt32

Me.Text = List_SpecialFolderInfo.Item(m.WParam.ToInt32).ShortName

m.Result = NULL : Exit Sub

Case Form1_Set_TopMost

Temp_Form1_Text = Me.Text

SetWindowPos(Me.Handle, HWND_TOPMOST,

Me.Location.X, Me.Location.Y,

Me.Size.Width, Me.Size.Height, SWP_SHOWWINDOW)

m.Result = NULL : Exit Sub

Case Form1_Set_NotTopMost

SetWindowPos(Me.Handle, HWND_NOTOPMOST,

Me.Location.X, Me.Location.Y,

Me.Size.Width, Me.Size.Height, SWP_SHOWWINDOW)

Me.Text = Temp_Form1_Text

EnumerateSpecialFolder = False

CancelEnumerate.Dispose()

m.Result = NULL : Exit Sub

Case WM_CLOSE

If EnumerateSpecialFolder Then

CancelEnumerate.Cancel()

Threading.Thread.Sleep(2000)

End If

End Select

MyBase.WndProc(m)

End Sub

Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing

Register_RunTime_data.Save_WindowPlacement(Me.Handle)

Register_RunTime_data.SaveFontSize()

For Each p As SpecialFolderInfo In List_SpecialFolderInfo

Try

If p.process IsNot Nothing Then p.process.Kill()

Catch ex As Exception

End Try

End Sub

End Class

Module MyCode_put_in_This_module

Public ListBox_addString As List(Of String)

Public List_SpecialFolderInfo As List(Of SpecialFolderInfo)

Public hEvent As IntPtr

Public Task_job As Task

Public hWnd_Form1 As IntPtr

Dim Button1 As NativeWindow_Button

Public ListBox1 As ListBox1_ChildClass

Public Register_Data As Register_RunTime_data

Public ReadOnly FontFamilyNames() As String = {

"宋体", "細明體", "Courier New", "Cascadia Mono"}

Public Font24 As System.Drawing.Font

Public Fonts(20) As System.Drawing.Font

Public FontSize() As Int32 = {14, 16, 18, 20, 22, 24, 26, 28, 32, 38,

42, 48, 52, 56, 70, 74, 78, 82, 86, 90, 96}

Public Const Button1_Height As Int32 = 30

Public Const edge As Int32 = 5

Public EnumerateSpecialFolder As Boolean = False

Public CancelEnumerate As CancellationTokenSource

Public Class ListBox1_ChildClass

Inherits ListBox

Public Shared font_index As Int32 = 2

Public Shared SelChange As Int32 = -1

Public Sub New()

MyClass.New(font_index)

End Sub

Public Sub New(font_size As Int32)

MyBase.New()

font_index = font_size

MyBase.Font = Fonts(font_size)

MultiColumn = False

SelectionMode = SelectionMode.One

Size = Form1.ClientSize - (New Drawing.Size(2 * edge, 3 * edge + Button1_Height))

Location = New Drawing.Point(edge, edge)

For Each item_string As String In ListBox_addString

MyBase.Items.Add(item_string)

If ListBox_addString.Count > 0 AndAlso SelChange >= 0 Then Me.SelectedIndex = SelChange

End Sub

Protected Overrides Sub WndProc(ByRef m As Message)

Select Case m.Msg

Case WM_MOUSEWHEEL

Dim Wheel As Int64 = m.WParam.ToInt64

Dim VirtualKey As UInt32 = CUInt(Wheel And &HFFFF)

If VirtualKey = MK_CONTROL Then

Dim _previous_font_index As Int32 = font_index

If (Wheel And &H10000000) = 0 Then

If font_index + 1 < Fonts.Count Then font_index += 1

Else

If font_index - 1 >= 0 Then font_index -= 1

End If

If _previous_font_index <> font_index Then

PostMessage(Form1.Handle, ListBox1_SetFont, New IntPtr(font_index), NULL)

End If

m.Result = NULL : Exit Sub

End If

Case WM_RBUTTONDBLCLK

If EnumerateSpecialFolder Then

CancelEnumerate.Cancel()

CancelEnumerate.Dispose()

m.Result = NULL : Exit Sub

End If

Case WM_CHAR

If m.WParam.ToInt32 = Keys.Return Then

Dim sfi As SpecialFolderInfo = List_SpecialFolderInfo.Item(ListBox1.SelectedIndex)

ShowSelectedSpecialFolder(sfi)

m.Result = NULL : Exit Sub

End If

Case WM_SETFOCUS

If ListBox1.SelectedIndex < 0 AndAlso ListBox1.Items.Count > 0 Then

ListBox1.SelectedIndex = 0

End If

End Select

MyBase.WndProc(m)

End Sub

End Class

Public Class NativeWindow_Button

Inherits NativeWindow

Implements IDisposable

Protected Overrides Sub WndProc(ByRef m As Message)

Select Case m.Msg

Case WM_LBUTTONDOWN

If Not EnumerateSpecialFolder Then

EnumerateSpecialFolder = True

CancelEnumerate = New CancellationTokenSource()

Task_For_OpenAllSpecialFolders(CancelEnumerate.Token)

End If

End Select

MyBase.WndProc(m)

End Sub

Public Sub New(Parent_hWnd As IntPtr)

Dim cp As New CreateParams With {

.Parent = Parent_hWnd,

.Caption = "Enumerate special folders",

.ClassName = "Button",

.Style = WS_CHILD Or WS_VISIBLE Or WS_TABSTOP,

.X = edge,

.Y = 2 * edge + ListBox1.Height,

.Width = Form1.ClientSize.Width - .X - edge,

.Height = Form1.ClientSize.Height - .Y - edge

}

CreateHandle(cp)

SendMessage(Me.Handle, WM_SETFONT, Font24.ToHfont, NULL)

End Sub

Private disposedValue As Boolean

Protected Overridable Sub Dispose(disposing As Boolean)

If Not disposedValue Then

If disposing Then

End If

DestroyHandle()

disposedValue = True

End If

End Sub

Public Sub Dispose() Implements IDisposable.Dispose

Dispose(disposing:=True)

GC.SuppressFinalize(Me)

End Sub

End Class

Sub Task_For_OpenAllSpecialFolders(cancellationToken As CancellationToken)

Task_job = New Task(New Action(Of Object)(

AddressOf OpenAllSpecialFolders), cancellationToken)

Task_job.Start()

End Sub

Sub OpenAllSpecialFolders(cancellationToken As Object)

Dim Token As CancellationToken = CType(cancellationToken, CancellationToken)

Try

SendMessage(hWnd_Form1, Form1_Set_TopMost, NULL, NULL)

For Each SpecialFolderInfo As SpecialFolderInfo In List_SpecialFolderInfo

SendMessage(hWnd_Form1, ListBox1_SelectedIndex,

New IntPtr(SpecialFolderInfo.Index), NULL)

ShowSelectedSpecialFolder(SpecialFolderInfo)

MessageBeep(0)

Threading.Thread.Sleep(2000)

SpecialFolderInfo.process.Kill()

SpecialFolderInfo.process = Nothing

If Token.IsCancellationRequested Then Exit Sub

Catch ex As Exception

Finally

SendMessage(hWnd_Form1, Form1_Set_NotTopMost, NULL, NULL)

End Try

End Sub

Class Create_MyProcess

Inherits Process

Public Exploer As String

Public process_name As String

Public Sub New()

MyBase.New()

Exploer =

IO.Path.Combine(Environment.GetEnvironmentVariable("SystemRoot"), "Explorer.exe")

EnableRaisingEvents = True

End Sub

Sub My_ProcessExited(sender As Object, e As EventArgs) Handles MyBase.Exited

SetEvent(hEvent)

End Sub

Sub Create(ByRef SpecialFolderInfo As SpecialFolderInfo)

Me.StartInfo.FileName = Exploer

Me.StartInfo.Arguments = SpecialFolderInfo.FolderPath

Me.StartInfo.WindowStyle = ProcessWindowStyle.Maximized

MyBase.Start()

process_name = Me.ProcessName

WaitForSingleObject(hEvent, 1000)

For LoopCount As Int32 = 0 To 500

Dim NewProcesses() As Process = Process.GetProcessesByName(process_name)

For Each p As Process In NewProcesses

If p.StartTime >= Me.StartTime AndAlso p.ProcessName = process_name Then

If Not String.IsNullOrEmpty(p.MainWindowTitle) Then

SpecialFolderInfo.process = p

SpecialFolderInfo.Title = p.MainWindowTitle

Exit Sub

End If

Next LoopCount

End Sub

End Class

Public WithEvents Process2 As New Create_MyProcess

Sub ShowSelectedSpecialFolder(SpecialFolderInfo As SpecialFolderInfo)

If SpecialFolderInfo.process Is Nothing Then

Process2.Create(SpecialFolderInfo)

ElseIf IsWindow(SpecialFolderInfo.process.MainWindowHandle) Then

ShowWindowAsync(SpecialFolderInfo.process.MainWindowHandle, SW_MAXIMIZE)

SetFocus_To_Specified_hWnd(SpecialFolderInfo.process.MainWindowHandle)

Else

SpecialFolderInfo.process = Nothing

Process2.Create(SpecialFolderInfo)

End If

End Sub

Sub Initialze()

hWnd_Form1 = Form1.Handle

Form1.Text = "Show special folders - " & Form1.Text

For Each name As String In FontFamilyNames

Try

Dim [FontFamily] As FontFamily

[FontFamily] = New System.Drawing.FontFamily(name)

If [FontFamily] IsNot Nothing Then

Font24 = New Drawing.Font([FontFamily], 24,

FontStyle.Regular, GraphicsUnit.World)

For Fi As Int32 = 0 To Fonts.GetUpperBound(0)

Fonts(Fi) = New Drawing.Font([FontFamily], FontSize(Fi),

FontStyle.Regular, GraphicsUnit.World)

Exit For

End If

Catch ex As Exception

End Try

AddHandler Application.Idle, AddressOf Application_Idle

hEvent = CreateEvent(NULL, False, False, NULL)

ListBox_addString = New List(Of String)

List_SpecialFolderInfo = New List(Of SpecialFolderInfo)

Register_RunTime_data.GetFontSize()

ListBox1 = New ListBox1_ChildClass(ListBox1_ChildClass.font_index)

Initialize_ListBox()

Form1.Controls.Add(ListBox1)

Button1 = New NativeWindow_Button(Form1.Handle)

End Sub

Sub Initialize_ListBox()

Dim SpecialFolders_name As String() = [Enum].GetNames(GetType(Environment.SpecialFolder))

Dim SpecialFolders_value As Array = [Enum].GetValues(GetType(Environment.SpecialFolder))

Dim Index_Of_Name As Int32 = -1

For Each SpecialFolder_value As ValueType In SpecialFolders_value

Index_Of_Name += 1

Dim SpecialFolder As Environment.SpecialFolder =

CType(SpecialFolder_value, Environment.SpecialFolder)

Dim FolderPath As String = Environment.GetFolderPath(SpecialFolder)

If String.IsNullOrEmpty(FolderPath) Then Continue For

Dim SpecialFolderInfo As New SpecialFolderInfo With {

.FolderPath = FolderPath,

.ShortName = SpecialFolders_name(Index_Of_Name)

}

List_SpecialFolderInfo.Add(SpecialFolderInfo)

List_SpecialFolderInfo.Sort()

ListBox1.BeginUpdate()

Dim index As Int32 = 0

For Each sfi As SpecialFolderInfo In List_SpecialFolderInfo

Dim ItemString As String = $"{sfi.ShortName,-25}{sfi.FolderPath}"

ListBox1.Items.Add(ItemString)

ListBox_addString.Add(ItemString)

sfi.Index = index

index += 1

ListBox1.EndUpdate()

End Sub

Sub Application_Idle(sender As Object, e As EventArgs)

RemoveHandler Application.Idle, AddressOf Application_Idle

Register_RunTime_data.Get_WindowPlacement(Form1.Handle)

End Sub

Class SpecialFolderInfo

Implements IComparable

Public FolderPath As String

Public ShortName As String

Public Index As Int32

Public process As Process

Public Title As String

Public Function CompareTo(obj As Object) As Integer Implements IComparable.CompareTo

Return String.Compare(FolderPath, CType(obj, SpecialFolderInfo).FolderPath)

End Function

End Class

#Region "===== Earlier code ======"

Class Register_RunTime_data

Public Const WinPL_Len As Int32 = &H2C

Public Shared Sub SaveFontSize()

Interaction.SaveSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,

"MyBlog_4", "FontSize", ListBox1_ChildClass.font_index.ToString)

End Sub

Public Shared Sub GetFontSize()

Dim FontSize As String =

Interaction.GetSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,

"MyBlog_4", "FontSize")

Int32.TryParse(FontSize, ListBox1_ChildClass.font_index)

End Sub

Public Shared Sub Get_WindowPlacement(hWnd As IntPtr)

SetMyWindowPlacement(hWnd)

End Sub

Public Shared Sub Save_WindowPlacement(hWnd As IntPtr)

SaveMyWindowPlacementToRegister(hWnd)

End Sub

Shared Sub SaveMyWindowPlacementToRegister(hWnd As IntPtr)

Dim ptr_winpl As IntPtr = Marshal.AllocHGlobal(1000)

Marshal.WriteInt32(ptr_winpl, WinPL_Len)

If GetWindowPlacement(hWnd, ptr_winpl) Then

Dim winPL_Bytes(WinPL_Len) As Byte

Marshal.Copy(ptr_winpl, winPL_Bytes, 0, WinPL_Len)

Interaction.SaveSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,

"MyBlog_4", "winPL", BitConverter.ToString(winPL_Bytes).Replace("-", ""))

End If

Marshal.FreeHGlobal(ptr_winpl)

End Sub

Shared Sub SetMyWindowPlacement(hWnd As IntPtr)

Try

Dim winPL_string As String =

Interaction.GetSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,

"MyBlog_4", "winPL")

Dim winPL_Bytes(WinPL_Len) As Byte

For index As Int32 = 0 To WinPL_Len - 1

winPL_Bytes(index) = Convert.ToByte(winPL_string.Substring(index * 2, 2), 16)

Dim ptr_winPL As IntPtr = Marshal.AllocHGlobal(1000)

Marshal.Copy(winPL_Bytes, 0, ptr_winPL, WinPL_Len)

If Not SetWindowPlacement(hWnd, ptr_winPL) Then

'MsgBox("SetWindowPlacement fault", Title:=My.User.Name)

End If

Marshal.FreeHGlobal(ptr_winPL)

Catch ex As Exception

End Try

End Sub

End Class

Sub Form1Resize(MyClient As Control)

If ListBox1 IsNot Nothing Then

Form1.Controls.Remove(ListBox1)

ListBox1.Dispose()

ListBox1 = New ListBox1_ChildClass()

Form1.Controls.Add(ListBox1)

End If

If Button1 IsNot Nothing Then

Button1.DestroyHandle()

Button1 = New NativeWindow_Button(Form1.Handle)

End If

End Sub

Sub SetFocus_To_Specified_hWnd(hWnd As IntPtr)

Dim Ptr_Int As IntPtr = Marshal.AllocHGlobal(64)

Marshal.WriteInt32(Ptr_Int, 0)

AttachThreadInput(0, GetWindowThreadProcessId(hWnd, Ptr_Int), True)

SetForegroundWindow(hWnd)

SetFocus(hWnd)

AttachThreadInput(0, GetWindowThreadProcessId(hWnd, Ptr_Int), False)

Marshal.FreeHGlobal(Ptr_Int)

End Sub

#End Region '"===== Earlier code ======"

Public ReadOnly NULL As IntPtr = IntPtr.Zero

Public Const WM_CLOSE As UInt32 = &H10

Public Const WM_COMMAND As UInt32 = &H111

Public Const WM_SETFONT As UInt32 = &H30

Public Const WM_MOUSEWHEEL As UInt32 = &H20A

Public Const WM_RBUTTONDBLCLK As UInt32 = &H206

Public Const WM_KEYDOWN As UInt32 = &H100

Public Const WM_CHAR As UInt32 = &H102

Public Const WM_LBUTTONDOWN As UInt32 = &H201

Public Const WM_USER As UInt32 = &H400

Public Const WM_APP As UInt32 = &H8000

Public Const WM_SETFOCUS As UInt32 = &H7

Public Const MK_CONTROL As UInt32 = &H8

Public Const WS_CHILD As Int32 = &H40000000

Public Const WS_VISIBLE As Int32 = &H10000000

Public Const WS_TABSTOP As UInt32 = &H10000L

Public Const ListBox1_SelectedIndex As UInt32 = WM_APP + 1

Public Const Form1_Set_TopMost As UInt32 = WM_APP + 2

Public Const Form1_Set_NotTopMost As UInt32 = WM_APP + 3

Public Const ListBox1_SetFont As UInt32 = WM_APP + 4

Public Const LBN_ERRSPACE As Int32 = (-2)

Public Const LBN_SELCHANGE As Int32 = 1

Public Const LBN_DBLCLK As Int32 = 2

Public Const LBN_SELCANCEL As Int32 = 3

Public Const LBN_SETFOCUS As Int32 = 4

Public Const LBN_KILLFOCUS As Int32 = 5

Public Const SW_HIDE As Int32 = 0

Public Const SW_SHOWNORMAL As Int32 = 1

Public Const SW_NORMAL As Int32 = 1

Public Const SW_SHOWMINIMIZED As Int32 = 2

Public Const SW_SHOWMAXIMIZED As Int32 = 3

Public Const SW_MAXIMIZE As Int32 = 3

Public Const SW_SHOWNOACTIVATE As Int32 = 4

Public Const SW_SHOW As Int32 = 5

Public Const SW_MINIMIZE As Int32 = 6

Public Const SW_SHOWMINNOACTIVE As Int32 = 7

Public Const SW_SHOWNA As Int32 = 8

Public Const SW_RESTORE As Int32 = 9

Public Const SW_SHOWDEFAULT As Int32 = 10

Public Const SW_FORCEMINIMIZE As Int32 = 11

Public Const SWP_NOSIZE As UInt32 = &H1

Public Const SWP_NOMOVE As UInt32 = &H2

Public Const SWP_NOZORDER As UInt32 = &H4

Public Const SWP_NOREDRAW As UInt32 = &H8

Public Const SWP_NOACTIVATE As UInt32 = &H10

Public Const SWP_FRAMECHANGED As UInt32 = &H20 '/* The frame changed: send WM_NCCALCSIZE */

Public Const SWP_SHOWWINDOW As UInt32 = &H40

Public Const SWP_HIDEWINDOW As UInt32 = &H80

Public Const SWP_NOCOPYBITS As UInt32 = &H100

Public Const SWP_NOOWNERZORDER As UInt32 = &H200 '/* Don't do owner Z ordering */

Public Const SWP_NOSENDCHANGING As UInt32 = &H400 '/* Don't send WM_WINDOWPOSCHANGING */

Public Const SWP_DEFERERASE As UInt32 = &H2000

Public Const SWP_ASYNCWINDOWPOS As UInt32 = &H4000

Public Const SWP_DRAWFRAME As UInt32 = SWP_FRAMECHANGED

Public Const SWP_NOREPOSITION As UInt32 = SWP_NOOWNERZORDER

Public HWND_TOP As IntPtr = IntPtr.Zero

Public HWND_BOTTOM As New IntPtr(1)

Public HWND_TOPMOST As New IntPtr(-1)

Public HWND_NOTOPMOST As New IntPtr(-2)

Declare Unicode Function SendMessage Lib "user32.dll" Alias "SendMessageW" (

_In__HWND_hWnd As IntPtr,

_In__UINT_Msg As UInt32,

_Pre_maybenull__Post_valid__WPARAM_wParam As IntPtr,

_Pre_maybenull___Post_valid__LPARAM_lParam As IntPtr) As IntPtr

Declare Unicode Function MessageBeep Lib "User32" (

_In_UINT_uType As UInt32) As Boolean

Declare Unicode Function GetProcessId Lib "Kernel32" (

_In_HANDLE_Process As IntPtr) As UInt32

Declare Unicode Function GetWindowThreadProcessId Lib "User32.dll" (

_In_HWND_hWnd As IntPtr,

_Out_opt_LPDWORD_lpdwProcessId As IntPtr) As UInt32

Declare Unicode Function GetWindowPlacement Lib "User32" (

_In_HWND_hWnd As IntPtr,

_Inout_WINDOWPLACEMENT_lpwndpl As IntPtr) As Boolean

Declare Unicode Function SetWindowPlacement Lib "User32" (

_In_HWND_hWnd As IntPtr,

_In_Const_WINDOWPLACEMENT_lpwndpl As IntPtr) As Boolean

Declare Unicode Function PostMessage Lib "user32.dll" Alias "PostMessageW" (

_In_opt_HWND_hWnd As IntPtr,

_In__UINT_Msg As UInt32,

_In_WPARAM_wParam As IntPtr,

_In_LPARAM_lParam As IntPtr) As Boolean

Declare Function IsWindow Lib "user32.dll" (

_In_opt_HWND_hWnd As IntPtr) As Boolean

Declare Unicode Function ShowWindowAsync Lib "User32.dll" (

ByVal hWnd As IntPtr, ByVal nCmdShow As Int32) As Boolean

Declare Unicode Function SetWindowPos Lib "User32" (

_In_HWND_hWnd As IntPtr,

_In_opt_HWND_hWndInsertAfter As IntPtr,

_In_int_X As Int32,

_In_int_Y As Int32,

_In_int_cx As Int32,

_In_int_cy As Int32,

_In_UINT_uFlags As UInt32) As Boolean

Declare Unicode Function CreateEvent Lib "kernel32.dll" Alias "CreateEventW" (

ByVal lpEventAttributes As IntPtr,

ByVal bManualReset As Boolean,

ByVal bInitialState As Boolean,

ByVal lpName As IntPtr) As IntPtr

Declare Unicode Function SetEvent Lib "kernel32.dll" (

ByVal hEvent As IntPtr) As Boolean

Declare Unicode Function WaitForSingleObject Lib "kernel32.dll" Alias "WaitForSingleObject" (

ByVal hHandle As IntPtr, ByVal dwMilliseconds As UInt32) As UInt32

Declare Unicode Function SetFocus Lib "User32.dll" (

_In_opt_HWND_hWnd As IntPtr) As IntPtr

Declare Unicode Function AttachThreadInput Lib "User32.dll" (

_In_DWORD_idAttach As UInt32,

_In_DWORD_idAttachTo As UInt32,

_In_BOOL_fAttach As Boolean) As Boolean

Declare Unicode Function SetForegroundWindow Lib "User32.dll" (

_In_HWND_hWnd As IntPtr) As Boolean

End Module

搜尋此網誌

Visual Stiodo Reader

System special folder

留言

張貼留言

這個網誌中的熱門文章

Marshalling

Calling a C# WPF library from C++

Marshalling II