VB.Net程序设计:常用程序集合（代码）

VB.Net:常用程序集合 （代码）

用到的知识点：
XML文件的读写操作。
文件的拖放操作。
ListView的应用、操作。
IconExtractor读取任何文件的图标。 

 

 

程序下载地址：http://download.csdn.net/source/356865

代码：

Imports  System.IO
Imports  System.Diagnostics
Imports  System.Xml
Imports  System.Text
Imports  System.Drawing
Imports  System.Runtime.InteropServices

Public   Class MainFrm Class MainFrm

    Dim ComAppPath As String
    Dim XMLFilePath As String
    Dim XmlDoc As XmlDocument
    Dim Root, Node As XmlNode
    Dim Element As XmlElement
    Dim NodeList As XmlNodeList
    Dim LtItem As ListViewItem
    Dim PrgName, PrgPath As String
    Dim SmFrmHeight As Integer = 405
    Dim LgFrmHeight As Integer

    Private Sub MainFrm_Load()Sub MainFrm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        LgFrmHeight = Me.Height
        Me.Height = SmFrmHeight
        ComAppPath = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData)
        XMLFilePath = Path.Combine(ComAppPath, "MyIMAppList.xml")
        If File.Exists(XMLFilePath) Then
            LoadXml2List(XMLFilePath)
        End If
    End Sub

    Private Sub LoadXml2List()Sub LoadXml2List(ByVal XmlFilePath As String)
        Dim iconIndex As Integer = 0
        XmlDoc = New XmlDocument
        XmlDoc.Load(XmlFilePath)
        Root = XmlDoc.SelectSingleNode("AppList")
        NodeList = Root.ChildNodes
        Me.Lv1.Items.Clear()
        Me.ImgLstLg.Images.Clear()
        If NodeList.Count > 0 Then
            For Each Node In NodeList
                PrgName = Node.FirstChild.InnerText
                PrgPath = Node.LastChild.InnerText
                LtItem = New ListViewItem
                LtItem.Text = PrgName
                LtItem.SubItems.Add(PrgPath)
                LtItem.ImageIndex = iconIndex
                Me.ImgLstLg.Images.Add(IconExtractor.GetLargeIcon(PrgPath))
                Me.Lv1.Items.Add(LtItem)
                iconIndex += 1
            Next
        End If
    End Sub

    Private Sub SaveXMLFile()Sub SaveXMLFile(ByVal XmlFilePath As String)
        Dim NewXML As New XmlTextWriter(XmlFilePath, Encoding.UTF8)
        NewXML.WriteStartDocument()
        NewXML.Formatting = Formatting.Indented
        NewXML.WriteStartElement("AppList")
        NewXML.WriteAttributeString("Name", "常用程序列表")
        For i As Integer = 0 To Me.Lv1.Items.Count - 1
            LtItem = Me.Lv1.Items(i)
            NewXML.WriteStartElement("App")
            NewXML.WriteElementString("Name", LtItem.Text)
            NewXML.WriteElementString("Path", LtItem.SubItems.Item(1).Text)
            NewXML.WriteEndElement()
        Next
        NewXML.WriteEndElement()
        NewXML.WriteEndDocument()
        NewXML.Close()
    End Sub

    Private Sub Lv1_DragEnter()Sub Lv1_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Lv1.DragEnter
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            e.Effect = DragDropEffects.All
        End If
    End Sub

    Private Sub Lv1_DragDrop()Sub Lv1_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Lv1.DragDrop
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            Dim MyFiles() As String
            Dim i As Integer
            MyFiles = e.Data.GetData(DataFormats.FileDrop)
            For i = 0 To MyFiles.Length - 1
                PrgName = Path.GetFileNameWithoutExtension(MyFiles(i))
                PrgPath = MyFiles(i)
                LtItem = New ListViewItem
                LtItem.Text = PrgName
                LtItem.SubItems.Add(PrgPath)
                LtItem.ImageIndex = Me.ImgLstLg.Images.Count
                Me.ImgLstLg.Images.Add(IconExtractor.GetLargeIcon(PrgPath))
                Me.Lv1.Items.Add(LtItem)
            Next
        End If
    End Sub

    Private Sub Lv1_DoubleClick()Sub Lv1_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Lv1.DoubleClick
        If Me.Lv1.SelectedItems.Count > 0 Then
            Dim AppPathStr As String = Me.Lv1.SelectedItems(0).SubItems.Item(1).Text
            If File.Exists(AppPathStr) Then
                System.Diagnostics.Process.Start(AppPathStr)
            End If
        End If
    End Sub

    Private Sub Lv1_SelectedIndexChanged()Sub Lv1_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Lv1.SelectedIndexChanged
        If Me.Lv1.SelectedItems.Count > 0 Then
            LtItem = Me.Lv1.SelectedItems(0)
            Me.TBoxPName.Text = LtItem.Text '=LtItem.SubItems.Item(0).Text
            Me.TBoxPPaths.Text = LtItem.SubItems.Item(1).Text '为第二项
        End If
    End Sub

    Private Sub Lv1_KeyDown()Sub Lv1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Lv1.KeyDown
        If e.KeyCode = Keys.Enter Then
            If Me.Lv1.SelectedItems.Count > 0 Then
                Dim AppPathStr As String = Me.Lv1.SelectedItems(0).SubItems.Item(1).Text
                If File.Exists(AppPathStr) Then
                    System.Diagnostics.Process.Start(AppPathStr)
                End If
            End If
        ElseIf e.KeyCode = Keys.Delete Then
            If Me.Lv1.SelectedItems.Count > -1 Then
                Me.Lv1.Items.RemoveAt(Me.Lv1.SelectedIndices(0))
            End If
        End If
    End Sub

    Private Sub BtClearList_Click()Sub BtClearList_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtClearList.Click
        If MsgBox("是否清空列表里面是所有数据,清空后要保存列表才生效！", MsgBoxStyle.YesNo, "清空列表") = MsgBoxResult.Yes Then
            Me.Lv1.Items.Clear()
        End If
    End Sub

    Private Sub BtExportList_Click()Sub BtExportList_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtExportList.Click
        If File.Exists(XMLFilePath) Then
            Dim SaveFD As New SaveFileDialog
            Dim DlogRs As DialogResult
            With SaveFD
                .Filter = "XML文件(*.xml)|*.xml"
                .Title = "导出常用程序列表"
                .DefaultExt = ".xml"
                .InitialDirectory = System.Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
                .FileName = "常用程序列表"
                DlogRs = .ShowDialog()
            End With
            If DlogRs = Windows.Forms.DialogResult.OK Then
                File.Copy(XMLFilePath, SaveFD.FileName, True)
                MsgBox("列表内容已经导出！", , "导出成功")
            End If
        End If
    End Sub

    Private Sub BtImportList_Click()Sub BtImportList_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtImportList.Click
        Dim OpenFD As New OpenFileDialog
        Dim DlogRs As DialogResult
        Dim NewFPath As String = ""
        Dim IsMyFile As Boolean = False
        With OpenFD
            .Filter = "XML文件(*.xml)|*.xml"
            .Title = "选择导入常用程序列表的XML文件"
            .DefaultExt = ".xml"
            .InitialDirectory = System.Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
            .FileName = "常用程序列表"
            DlogRs = .ShowDialog()
        End With
        If DlogRs = Windows.Forms.DialogResult.OK Then
            NewFPath = OpenFD.FileName
            '1.判断文件内容是否有效----读取方法一
            'Dim xReader As XmlReader
            'Dim Xx As String
            'xReader = XmlReader.Create(NewFPath)
            'xReader.ReadToFollowing("AppList")
            'If xReader.HasAttributes Then
            '    xReader.MoveToFirstAttribute()
            '    Xx = xReader.Value
            '    xReader.MoveToElement()
            '    If Xx = "常用程序列表" Then
            '        MsgBox("1有效")
            '    End If
            'End If
            '1.判断文件内容是否有效----读取方法二
            Dim IXmlDoc As New XmlDocument
            Dim IRoot As XmlNode
            Dim INodeList As XmlNodeList
            Dim INode As XmlNode
            IXmlDoc.Load(NewFPath)
            IRoot = IXmlDoc.SelectSingleNode("AppList")
            If IRoot.Attributes("Name").Value.ToString = "常用程序列表" Then
                IsMyFile = True
            Else
                IsMyFile = False
            End If
            '2.追加或重新加载xml文件数据到列表中
            '这里选择追加.
            If IsMyFile Then
                If Me.Lv1.Items.Count > 0 Then
                    Dim IconIndex As Integer = Me.Lv1.Items.Count
                    INodeList = IRoot.ChildNodes
                    If NodeList.Count > 0 Then
                        For Each INode In INodeList
                            LtItem = New ListViewItem
                            LtItem.Text = INode.FirstChild.InnerText
                            LtItem.SubItems.Add(INode.LastChild.InnerText)
                            LtItem.ImageIndex = IconIndex
                            Me.ImgLstLg.Images.Add(IconExtractor.GetLargeIcon(INode.LastChild.InnerText))
                            Me.Lv1.Items.Add(LtItem)
                            IconIndex += 1
                        Next
                    End If
                Else
                    File.Copy(NewFPath, XMLFilePath, True)
                    LoadXml2List(XMLFilePath)
                End If
            End If
        End If
    End Sub

    Private Sub BtAdd_Click()Sub BtAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtAdd.Click
        Me.TBoxPName.Text = ""
        Me.TBoxPPaths.Text = ""
        Me.TBoxPName.Focus()
    End Sub

    Private Sub BtSave_Click()Sub BtSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtSave.Click
        If Me.TBoxPName.Text > "" And Me.TBoxPPaths.Text > "" Then
            If File.Exists(Me.TBoxPPaths.Text) Then
                PrgName = Me.TBoxPName.Text
                PrgPath = Me.TBoxPPaths.Text
                LtItem = New ListViewItem
                LtItem.Text = PrgName
                LtItem.SubItems.Add(PrgPath)
                LtItem.ImageIndex = Me.ImgLstLg.Images.Count
                Me.ImgLstLg.Images.Add(IconExtractor.GetLargeIcon(PrgPath))
                Me.Lv1.Items.Add(LtItem)
            End If
        End If
    End Sub

    Private Sub BtSaveList2Xml_Click()Sub BtSaveList2Xml_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtSaveList2Xml.Click
        If Me.Lv1.Items.Count > 0 Then
            SaveXMLFile(XMLFilePath)
            MsgBox("保存成功！", , "保存列表")
        Else
            If File.Exists(XMLFilePath) Then
                File.Delete(XMLFilePath)
                MsgBox("保存成功！", , "保存列表")
            End If
        End If
    End Sub

    Private Sub BtDelete_Click()Sub BtDelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtDelete.Click
        If Me.Lv1.SelectedItems.Count > 0 Then
            Me.Lv1.Items.RemoveAt(Me.Lv1.SelectedIndices(0))
        End If
    End Sub

    Private Sub BtStartApp_Click()Sub BtStartApp_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtStartApp.Click
        If Me.TBoxPPaths.Text > "" Then
            Dim AppPathStr As String = Me.TBoxPPaths.Text
            If File.Exists(AppPathStr) Then
                System.Diagnostics.Process.Start(AppPathStr)
            End If
        End If
    End Sub

    Private Sub BtShowInfo_Click()Sub BtShowInfo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtShowInfo.Click
        Me.BtShowInfo.Text = IIf(Me.BtShowInfo.Text = "说明>>", "说明<<", "说明>>")
        Me.Height = IIf(Me.Height = SmFrmHeight, LgFrmHeight, SmFrmHeight)
    End Sub

    Private Sub BtClose_Click()Sub BtClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtClose.Click
        Application.Exit()
    End Sub

End Class

Public   Class IconExtractor Class IconExtractor

    Private Const SHGFI_SMALLICON = &H1
    Private Const SHGFI_LARGEICON = &H0
    Private Const SHGFI_ICON = &H100
    Private Const SHGFI_USEFILEATTRIBUTES = &H10
    Private Const MAX_SIZE = 260

    Public Enum IconSizeEnum IconSize
        Icon = SHGFI_ICON
        SmallIcon = SHGFI_SMALLICON
        LargeIcon = SHGFI_LARGEICON
    End Enum

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure SHFILEINFOStructure SHFILEINFO
        'pointer to icon  handle       
        Public hIcon As IntPtr
        'icon index       
        Public iIcon As Integer
        'not used in this example       
        Public dwAttributes As Integer
        'file pathname--marshal this as an unmanaged LPSTR of MAX_SIZE=260
        <MarshalAs(UnmanagedType.LPStr, SizeConst:=260)> _
        Public szDisplayName As String
        'file type--marshal as unmanaged LPSTR of 80 chars       
        <MarshalAs(UnmanagedType.LPStr, SizeConst:=80)> _
        Public szTypeName As String
    End Structure

    Private Declare Auto Function SHGetFileInfo()Function SHGetFileInfo Lib "shell32" (ByVal pszPath As String, ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, _
    ByVal cbFileInfo As Integer, ByVal uFlags As Integer) As Integer

    Public Shared Function GetIcon()Function GetIcon(ByVal FileName As String) As System.Drawing.Icon
        Return GetIconApi(FileName, IconSize.Icon)
    End Function

    Public Shared Function GetSmallIcon()Function GetSmallIcon(ByVal fn As String) As System.Drawing.Icon
        Return GetIconApi(fn, SHGFI_SMALLICON)
    End Function

    Public Shared Function GetLargeIcon()Function GetLargeIcon(ByVal fn As String) As System.Drawing.Icon
        Return GetIconApi(fn, SHGFI_LARGEICON)
    End Function

    Private Shared Function GetIconApi()Function GetIconApi(ByVal fn As String, ByVal anIconSize As Integer) As System.Drawing.Icon
        Dim aSHFileInfo As New SHFILEINFO()
        Dim cbFileInfo As Integer = Marshal.SizeOf(aSHFileInfo)
        Dim uflags As Integer = SHGFI_ICON Or SHGFI_USEFILEATTRIBUTES Or anIconSize
        Try
            SHGetFileInfo(fn, 0, aSHFileInfo, cbFileInfo, uflags)
            Return Icon.FromHandle(aSHFileInfo.hIcon)
        Catch ex As Exception
            Return Nothing
        End Try
    End Function
End Class