|

หน้าจอ GUI (Graphics User Interface) สามารถเปิดโฟลเดอร์ได้หลายๆโฟลเดอร์แบบ Manual และ Automatic

การทำ Registry เพื่อสั่งให้รันโปรแกรมตอนที่ Start Windows
Registry: Computer\HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run
โค้ดโปรแกรมชุดนี้มีจุดประสงค์ก็เพื่อต้องการให้ ทำการเปิดหลายๆโฟลเดอร์ได้ทั้งแบบ Manual (กดปุ่มเปิดเอาเอง) และการเปิดโฟลเดอร์แบบอัตโนมัติ ตอนที่สตาร์ทวินโดวส์เข้ามาทุกครั้ง ซึ่งจะอาศัยการกำหนดค่าใน Registry เอาไว้ โฟลเดอร์ที่ถูกเลือกจะถูกเก็บเอาไว้ใน Config.ini ซึ่งแอดมินจะใช้โค้ด Win32API ในการอ่านและเขียนค่าเข้าไปในไฟล์ INI ...
มาดูโค้ดฉบับเต็มกันเถอะ ... (frmOpenMultipleFolder.vb)
- Imports System.IO
- Imports System.Runtime.InteropServices
- Imports System.Text
- Imports Microsoft.Win32
- Public Class frmOpenMultipleFolder
- '// กำหนด Icon ให้กับ ListView
- Private imgList As New ImageList()
- '// ไฟล์ Config.ini จะเป็นไฟล์ที่เก็บตำแหน่งของโฟลเดอร์ต่างๆ
- Private iniPath As String = MyPath(Application.StartupPath) & "Config.ini"
- '// สร้าง CheckBox แบบ Run Time เพื่อกำหนดให้รันโปรแกรมตอน Start Windows
- Dim chkStartup As New CheckBox()
- '// การจัดเรียงใน ListView ด้วยการเก็บคอลัมน์ล่าสุดที่กดกับลำดับการเรียง
- Private SortColumn As Integer = -1
- Private SortOrder As SortOrder = SortOrder.None
- '// เพิ่มเติมข้อมูล
- '// Win32 API (Application Programming Interface) คือ ชุดฟังก์ชั่นพื้นฐานที่ Microsoft จัดเตรียมไว้สำหรับนักพัฒนาเพื่อโต้ตอบกับระบบปฏิบัติการ Windows โดยตรง เป็นการทำงานระดับต่ำ (Low-level Access) ดังนั้นมันจึงทำงานได้เร็ว และมีประสิทธิภาพสูง
- '// แปลเป็นไทยง่ายๆว่า การดึงพลังและขีดความสามารถของ Windows ออกมาใช้งานได้อย่างเต็มที่นั่นเอง
- #Region "INI API"
- '// --------------------------------------------------------------------------------------
- '// APIs for Read/Write INI File.
- <DllImport("kernel32", CharSet:=CharSet.Unicode)>
- Private Shared Function WritePrivateProfileString(lpAppName As String, lpKeyName As String, lpString As String, lpFileName As String) As Long
- End Function
- <DllImport("kernel32", CharSet:=CharSet.Unicode)>
- Private Shared Function GetPrivateProfileString(lpAppName As String, lpKeyName As String, lpDefault As String,
- lpReturnedString As StringBuilder, nSize As Integer, lpFileName As String) As Integer
- End Function
- Private Sub WriteIni(section As String, key As String, value As String, filePath As String)
- WritePrivateProfileString(section, key, value, filePath)
- End Sub
- Private Function ReadIni(section As String, key As String, defaultValue As String, filePath As String) As String
- Dim sb As New StringBuilder(1024)
- Dim count As Integer = GetPrivateProfileString(section, key, defaultValue, sb, sb.Capacity, filePath)
- If count > 0 Then
- Return sb.ToString().Trim
- Else
- Return ""
- End If
- End Function
- #End Region
- #Region "ICON API"
- '// ------------------------------------------------ APIs ดึงไอคอนมาใช้งาน ------------------------------------------------
- <DllImport("shell32.dll", CharSet:=CharSet.Auto)>
- Private Shared Function SHGetFileInfo(pszPath As String, dwFileAttributes As UInteger, ByRef psfi As SHFILEINFO,
- cbFileInfo As UInteger, uFlags As UInteger) As IntPtr
- End Function
- <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
- Private Structure SHFILEINFO
- Public hIcon As IntPtr
- Public iIcon As Integer
- Public dwAttributes As UInteger
- <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)>
- Public szDisplayName As String
- <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)>
- Public szTypeName As String
- End Structure
- Private Const SHGFI_ICON As UInteger = &H100
- Private Const SHGFI_SMALLICON As UInteger = &H1
- '// ดึงไอคอนโฟลเดอร์
- Private Function GetFolderIcon(path As String) As Icon
- Dim shinfo As New SHFILEINFO()
- SHGetFileInfo(path, 0, shinfo, CUInt(Marshal.SizeOf(shinfo)), SHGFI_ICON Or SHGFI_SMALLICON)
- Return Icon.FromHandle(shinfo.hIcon)
- End Function
- #End Region
- '// --------------------------------------------------------------------------------------
- '// S T A R T . . . H E R E
- '// --------------------------------------------------------------------------------------
- Private Sub frmOpenMultipleFolder_Load(sender As Object, e As EventArgs) Handles MyBase.Load
- '// ImageList สำหรับ Icon
- imgList.ImageSize = New Size(18, 22) '// จะมีผลต่อความสูงของแถวในตัว ListView
- imgList.ColorDepth = ColorDepth.Depth32Bit
- lvwFolder.SmallImageList = imgList
- '// ตั้งค่าให้กับ CheckBox เพื่อให้พื้นหลังกลมกลืนกับ ToolStrip
- chkStartup.Text = "Run on Windows Startup"
- chkStartup.Font = New Font("Tahoma", 10, FontStyle.Regular)
- chkStartup.BackColor = Color.Transparent
- Dim host As New ToolStripControlHost(chkStartup)
- ToolStrip1.Items.Add(host)
- '// Add Event Handler เพื่อกำหนดค่าการเปิดโฟลเดอร์อัตโนมัติ เมื่อ Start Windows
- AddHandler chkStartup.CheckedChanged, AddressOf chkStartup_CheckedChanged
- '// โค้ดที่เกี่ยวข้องจะอยู่ที่ Region "LISTVIEW"
- '// TIPS: ใช้เมื่อต้องการการแสดงผลที่พิเศษกว่าเดิม เช่น เปลี่ยนสีแต่ละแถวสลับกัน หรือใส่รูปภาพหรือไอคอนพิเศษ
- lvwFolder.OwnerDraw = True
- '// ตั้งค่าให้กับ ListView
- Call InitializeListView()
- '// โหลดรายการที่เก็บเอาไว้มาจากไฟล์ Config.ini
- Call LoadConfig()
- '// -------------------------------------------- IMPORTANT --------------------------------------------
- '// Computer\HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run
- '// ทดสอบการกำหนดให้ Run ตอน Start Windows
- If IsStartupEnabled() Then
- tsbOpenFolder.PerformClick() '// สั่งโปรแกรมให้เปิดโฟลเดอร์
- chkStartup.Checked = True
- Else
- chkStartup.Checked = False
- End If
- '// --------------------------------------------------------------
- End Sub
- '// --------------------------------------------------------------------------------------
- '// Add Event Handler เพื่อกำหนดให้โปรแกรมทำงานตอน Start Windows หรือไม่
- '// --------------------------------------------------------------------------------------
- Private Sub chkStartup_CheckedChanged(sender As System.Object, e As System.EventArgs)
- If chkStartUp.Checked Then
- '// Run on Windows Start
- Call SetStartup(True)
- Else
- Call SetStartup(False)
- End If
- End Sub
- '// ============= สร้างค่าใน Registry เพื่อให้รันตอน Startup =============
- '// หาก enable กำหนดเป็น True จะทำการ Registry เพื่อให้โปรแกรม Run ตอน Start Windows
- '// หาก enable กำหนดเป็น False จะทำการลบ Registry ออกไป
- '// Computer\HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run
- Private Sub SetStartup(enable As Boolean)
- Try
- Using key As RegistryKey = Registry.CurrentUser.OpenSubKey(
- "Software\Microsoft\Windows\CurrentVersion\Run", True)
- If key Is Nothing Then
- MessageBox.Show("ไม่สามารถเข้าถึง Registry ได้", "รายงานความผิดพลาด", MessageBoxButtons.OK, MessageBoxIcon.Error)
- Return
- End If
- If enable Then
- key.SetValue("OpenMultipleFolder", Application.ExecutablePath)
- Else
- '// ลบค่าออก ถ้าไม่ต้องการให้รันอัตโนมัติ
- If key.GetValue("OpenMultipleFolder") IsNot Nothing Then key.DeleteValue("OpenMultipleFolder")
- End If
- End Using
- Catch ex As Exception
- MessageBox.Show("เกิดข้อผิดพลาดในการตั้งค่า Startup: " & ex.Message, "รายงานความผิดพลาด", MessageBoxButtons.OK, MessageBoxIcon.Error)
- End Try
- End Sub
- '// ---------------------- ทดสอบค่า Run on Windows Start ----------------------
- Private Function IsStartupEnabled() As Boolean
- Try
- Using key As RegistryKey = Registry.CurrentUser.OpenSubKey(
- "Software\Microsoft\Windows\CurrentVersion\Run", False) '// อ่านอย่างเดียว (ReadOnly)
- If key Is Nothing Then Return False '// ไม่สามารถเปิด Registry ได้ (ถือว่าไม่ได้ตั้งค่า)
- '// ตรวจสอบว่ามีค่า "OpenMultipleFolder" หรือไม่
- Dim value As Object = key.GetValue("OpenMultipleFolder")
- If value IsNot Nothing Then
- '// ตรวจสอบว่าค่าที่เก็บเป็นพาธของโปรแกรมตัวเองหรือไม่
- Dim ProgramPath As String = Application.ExecutablePath
- Dim RegistryPath As String = value.ToString()
- '// เปรียบเทียบแบบไม่สนใจตัวพิมพ์ใหญ่/เล็ก และตัด quote ออกถ้ามี
- Dim CleanRegistryPath As String = RegistryPath.Replace("""", "")
- Return String.Equals(CleanRegistryPath, ProgramPath, StringComparison.OrdinalIgnoreCase)
- Else
- Return False
- End If
- End Using
- Catch ex As Exception
- '// ถ้าเกิดข้อผิดพลาด เช่น สิทธิ์ไม่พอ ถือว่าไม่ได้ตั้งค่า รีเทิร์นค่า False กลับไป
- 'MessageBox.Show("Error checking startup: " & ex.Message)
- Return False
- End Try
- End Function
- '// ---------------------- ตั้งค่าเริ่มต้นให้กับ ListView Control ----------------------
- Private Sub InitializeListView()
- With lvwFolder
- .View = View.Details
- .MultiSelect = False
- .HideSelection = False
- .FullRowSelect = True
- .GridLines = True
- .Columns.Clear()
- .Columns.Add("Folder Path", lvwFolder.Width - 5)
- End With
- End Sub
- '// ---------------------- ดับเบิลคลิกที่รายการ ListView เพื่อแก้ไขตำแหน่งเปิดโฟลเดอร์ ----------------------
- Private Sub lvwFolder_DoubleClick(sender As Object, e As EventArgs) Handles lvwFolder.DoubleClick
- '// เรียกไปยังเหตุการณ์คลิ๊กที่ปุ่ม ToolStrip
- tsbEditFolder.PerformClick()
- End Sub
- Private Sub frmOpenMultipleFolder_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
- Me.Dispose()
- GC.SuppressFinalize(Me)
- Application.Exit()
- End Sub
- #Region "TOOLBAR EVENTS"
- '// ทุกๆครั้งที่มีการเปลี่ยนแปลงแก้ไขรายการใน ListView จะทำการบันทึกลง Config.ini ทุกครั้ง (SaveConfig)
- '// การเพิ่ม Folder Full Path
- Private Sub tsbAddFolder_Click(sender As Object, e As EventArgs) Handles tsbAddFolder.Click
- Using fbd As New FolderBrowserDialog
- fbd.Description = "เลือกโฟลเดอร์ที่ต้องการ"
- If fbd.ShowDialog() = DialogResult.OK Then
- AddFolderToListView(fbd.SelectedPath)
- Call SaveConfig()
- End If
- End Using
- End Sub
- '// แก้ไขตำแหน่ง Folder Full Path
- Private Sub tsbEditFolder_Click(sender As Object, e As EventArgs) Handles tsbEditFolder.Click
- If lvwFolder.SelectedItems.Count = 0 Then
- MessageBox.Show("กรุณาเลือกรายการที่จะแก้ไข", "แก้ไขข้อมูล", MessageBoxButtons.OK, MessageBoxIcon.Information)
- Exit Sub
- End If
- Using fbd As New FolderBrowserDialog
- fbd.Description = "เลือกโฟลเดอร์ที่ต้องการ"
- fbd.SelectedPath = lvwFolder.SelectedItems(0).Text '// ตั้งค่าเริ่มต้นเป็นโฟลเดอร์เดิม
- If fbd.ShowDialog() = DialogResult.OK Then
- lvwFolder.SelectedItems(0).Text = fbd.SelectedPath
- Call SaveConfig()
- End If
- End Using
- End Sub
- '// ลบตำแหน่ง Folder Full Path
- Private Sub tsbRemoveFolder_Click(sender As Object, e As EventArgs) Handles tsbRemoveFolder.Click
- If lvwFolder.SelectedItems.Count = 0 Then
- MessageBox.Show("กรุณาเลือกรายการที่จะลบ", "ลบข้อมูล", MessageBoxButtons.OK, MessageBoxIcon.Information)
- Exit Sub
- End If
- If MessageBox.Show("คุณต้องการลบโฟลเดอร์ที่เลือกใช่หรือไม่?", "ยืนยันการลบ", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes Then
- lvwFolder.Items.Remove(lvwFolder.SelectedItems(0))
- Call SaveConfig()
- End If
- End Sub
- '// เปิดโฟลเดอร์ขึ้นมาตามรายการแถวใน ListView
- Private Sub tsbOpenFolder_Click(sender As Object, e As EventArgs) Handles tsbOpenFolder.Click
- If lvwFolder.Items.Count = 0 Then
- MessageBox.Show("ไม่มีรายการโฟลเดอร์ให้เปิด", "รายงานสถานะ", MessageBoxButtons.OK, MessageBoxIcon.Warning)
- Exit Sub
- End If
- For Each itm As ListViewItem In lvwFolder.Items
- If Directory.Exists(itm.Text) Then Process.Start("explorer.exe", itm.Text)
- Next
- End Sub
- Private Sub tsbExit_Click(sender As Object, e As EventArgs) Handles tsbExit.Click
- Me.Close()
- End Sub
- #End Region
- #Region "CONFIG"
- '// ------------------------------------ โหลดจาก Config.ini ------------------------------------
- Private Sub LoadConfig()
- lvwFolder.Items.Clear()
- imgList.Images.Clear()
- Dim idx As Integer = 1
- Do
- Dim folder As String = ReadIni("Folder", "Path" & idx, vbNullString, iniPath).Replace("""", "")
- If String.IsNullOrEmpty(folder) OrElse folder = "" Then Exit Do
- AddFolderToListView(folder)
- idx += 1
- Loop
- End Sub
- '// ------------------------------------ บันทึกลง Config.ini ------------------------------------
- Private Sub SaveConfig()
- '// ล้างค่าทั้ง Section [Folder] ของเดิมทิ้งออกไปก่อน
- WriteIni("Folder", Nothing, Nothing, iniPath)
- Dim idx As Integer = 1
- For Each item As ListViewItem In lvwFolder.Items
- WriteIni("Folder", "Path" & idx, item.Text, iniPath)
- idx += 1
- Next
- End Sub
- #End Region
- #Region "HELPER"
- '// เพิ่มรายการ Folder Full Path เข้าไปใน ListView
- Private Sub AddFolderToListView(folderPath As String)
- Dim key As String = AddIconToImageList(folderPath)
- Dim item As New ListViewItem(folderPath, key)
- lvwFolder.Items.Add(item)
- End Sub
- '// ใส่ไอคอนโฟลเดอร์ไว้ก่อนตำแหน่ง Path
- Private Function AddIconToImageList(folderPath As String) As String
- Dim key As String = folderPath.ToLower()
- If Not imgList.Images.ContainsKey(key) Then
- Try
- Dim ico As Icon = GetFolderIcon(folderPath)
- imgList.Images.Add(key, ico)
- Catch ex As Exception
- '// ถ้า error ให้ใส่ icon ว่าง
- imgList.Images.Add(key, SystemIcons.WinLogo)
- End Try
- End If
- Return key
- End Function
- #End Region
- #Region "LISTVIEW"
- '// เมื่อคลิ๊กส่วนหัว (Column) ของ ListView จะทำการจัดเรียงข้อมูลไอเทม ListView
- Private Sub lvwFolder_ColumnClick(sender As Object, e As ColumnClickEventArgs) Handles lvwFolder.ColumnClick
- '// ถ้ากดซ้ำที่คอลัมน์เดิมสลับ ASC/DESC การจัดเรียงจากน้อยไปมาก หรือ มากไปน้อย
- If e.Column = SortColumn Then
- If SortOrder = SortOrder.Ascending Then
- SortOrder = SortOrder.Descending
- Else
- SortOrder = SortOrder.Ascending
- End If
- Else
- SortColumn = e.Column
- SortOrder = SortOrder.Ascending
- End If
- '// เรียกไปยังคลาส ListViewItemComparer
- lvwFolder.ListViewItemSorter = New ListViewItemComparer(e.Column, SortOrder)
- lvwFolder.Sort()
- '// บันทึกข้อมูลลง INI
- Call SaveConfig()
- End Sub
- '// --------------------------------------------------------------------------------------
- '// TIPS: การปรับฟอนต์ในส่วนของ Column Header ของ ListView Control
- '// วาด Column Header
- '// --------------------------------------------------------------------------------------
- Private Sub lvwFolder_DrawColumnHeader(sender As Object, e As DrawListViewColumnHeaderEventArgs) Handles lvwFolder.DrawColumnHeader
- Using HeaderFont As New Font("Tahoma", 10, FontStyle.Bold)
- e.Graphics.FillRectangle(SystemBrushes.ControlDark, e.Bounds)
- TextRenderer.DrawText(e.Graphics, e.Header.Text, HeaderFont, e.Bounds, Color.White, TextFormatFlags.VerticalCenter Or TextFormatFlags.VerticalCenter)
- End Using
- End Sub
- '// วาด Item
- Private Sub lvwFolder_DrawItem(sender As Object, e As DrawListViewItemEventArgs) Handles lvwFolder.DrawItem
- e.DrawDefault = True
- End Sub
- '// วาด SubItem
- Private Sub lvwFolder_DrawSubItem(sender As Object, e As DrawListViewSubItemEventArgs) Handles lvwFolder.DrawSubItem
- e.DrawDefault = True
- End Sub
- #End Region
- #Region "FUNCTION"
- Function MyPath(ByVal AppPath As String) As String
- Dim p = AppPath.ToLower().Replace("\bin\debug", "").Replace("\bin\release", "").Replace("\bin\x86\debug", "").Replace("\bin\x86\release", "")
- '// Chr(92) คือ ASCII Code ของเครื่องหมาย Back Slash
- If Not p.EndsWith(Chr(92)) Then p &= Chr(92)
- Return p
- End Function
- #End Region
- End Class
คัดลอกไปที่คลิปบอร์ด
โค้ดโมดูลในการจัดเรียงตัวอักษรของ ListView Control ... (ListViewItemComparer.vb)
- '// คลาสสำหรับจัดเรียงข้อมูลจากการคลิ๊กเมาส์ที่ส่วนหัวหรือหลักของ ListView
- Public Class ListViewItemComparer
- Implements IComparer
- Private col As Integer
- Private order As SortOrder
- Public Sub New(column As Integer, sortOrder As SortOrder)
- col = column
- order = sortOrder
- End Sub
- Public Function Compare(x As Object, y As Object) As Integer Implements IComparer.Compare
- Dim lviX As ListViewItem = CType(x, ListViewItem)
- Dim lviY As ListViewItem = CType(y, ListViewItem)
- Dim result As Integer = String.Compare(lviX.SubItems(col).Text, lviY.SubItems(col).Text)
- If order = SortOrder.Descending Then result = -result
- Return result
- End Function
- End Class
คัดลอกไปที่คลิปบอร์ด
ดาวน์โหลดโค้ดฉบับเต็ม VB.NET (2010) + .Net Framework 4.0 ...
|
ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง
คุณจำเป็นต้อง ลงชื่อเข้าใช้ เพื่อดาวน์โหลดหรือดูไฟล์แนบนี้ คุณยังไม่มีบัญชีใช่ไหม? ลงทะเบียน
x
|