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

最新推荐文章于 2025-04-12 22:00:53 发布
最新推荐文章于 2025-04-12 22:00:53 发布
阅读量2.7k 收藏 2
点赞数
分类专栏： 2.VB.Net 文章标签： vb.net integer string function object xml
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/linjimu/article/details/2106324
版权

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

    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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtClose.Click
        Application.Exit()
    End Sub

End Class

Public   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 IconSize
        Icon = SHGFI_ICON
        SmallIcon = SHGFI_SMALLICON
        LargeIcon = SHGFI_LARGEICON
    End Enum

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure 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 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(ByVal FileName As String) As System.Drawing.Icon
        Return GetIconApi(FileName, IconSize.Icon)
    End Function

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

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

    Private Shared 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

VB程序设计的简单代码设计
03-28
VB程序设计代码很健康明白你看见好看吗空间看吗， 了看见了昆明买了看了看、。玫琳凯，吗两年了， 离开了来开门了吗
VB.net源码
01-05
picturebox里的图片旋转
[VB.NET源码]1-你好程序
VB.NET学习网-VB.NET实例、VB.NET教程、VB.NET源码下载
12-01 1179
从入门到高手，让你21天成为VB.NET高手的源代码哦，我就不必把代码写出来了，你们自己去下载就可以了……不要忘了加我QQ群，收藏我的博客哦！下载地址：1-你好程序<!--google_ad_client = "pub-8333940862668978";/* 728x90, 创建于 08-11-30 */google_ad_slot = "4485230109";goog
微软最新VB.NET源码_示例100个
最新发布
gitblog_06713的博客
04-12 333
微软最新VB.NET源码_示例100个 【下载地址】微软最新VB.NET源码_示例100个 微软最新VB.NET源码集合，精选100个实用示例，涵盖界面设计、数据处理、网络通信等多样化编程场景，是学习和掌握VB.NET的绝佳资源。每个示例均配有详细注释，帮助开发者快速理解代码逻辑与实现方式。无论是初学者还是有经验的开发者...
VB.NET 中的2种集合
weixin_30824599的博客
09-26 259
//在 .NET种又2种集合 一种是 VB的 collection 集合 另一种是 .NET Framework 的泛型集合 ////VB的collection集合 和 .NET下的泛型集合 泛型集合限定了 键值对的类型 1. VB的collection集合 Module Module1 Sub Main() Dim col As...
VB.Net程序设计：调试与排错工作模式详解
在"调试与排错 - VB.NET程序设计基础"的学习中，我们首先了解了VB.NET作为一种面向对象的可视化程序设计语言，它支持事件驱动编程，以Windows应用程序为基础。VB.NET中的核心概念包括对象和类： 1. **工作模式**: ...
VB.Net程序设计：断点删除与状态查看方法
本资源主要讲解了VB.Net程序设计基础中的断点管理和应用程序状态查看方法，以及Visual Studio.NET环境下的开发工具和面向对象编程的概念。具体内容如下： 1. 断点的删除： - 删除断点有三种方式：一是直接单击代码...
VB.NET程序设计：数组初始化与引用解析
"这篇内容主要介绍了VB.Net程序设计的基础，特别是关于数组的初始化和引用，以及VB.Net编程环境和面向对象的基本概念。" 在VB.Net中，数组的初始化是创建和赋值数组元素的重要步骤。一维数组的初始化可以通过Dim...
VB.NET程序设计：对象属性设置与面向对象基础
"这篇内容主要介绍了VB.Net程序设计的基础知识，包括设置对象属性的两种方法以及面向对象编程的基本概念。" 在VB.Net中，设置对象属性有两种主要方式。第一种是在设计阶段，通过Visual Studio .NET的属性窗口来设置...
VB.Net程序设计:常用程序集合程序的vb.net源代码
02-19
常用程序集合，程序说明：http://blog.csdn.net/linjimu/archive/2008/02/19/2105387.aspx 用到的知识点： XML文件的读写操作。 文件的拖放操作。 ListView的应用、操作。 IconExtractor读取任何文件的图标。
VB.net 常用代码示例
10-12
学习示例，供参考，希望大家学习交流之用。
vb语言程序设计(ppt附带全部代码共10章60多个例子）
12-07
第一章 认识Visual Basic  3学时 第二章 程序设计基础 4学时 第三章 赋值与输入输出 5学时 第四章 选择结构设计 4学时 第五章 循环结构设计 5学时 第六章 数组 6学时 期中考试 2学时 第七章 过程 6学时 第八章 数据文件  4学时 第九章 程序调试与错误处理 3学时 第十章 其他常用的语句及控件 5学时
VB.NET源代码实例集.
01-14
vb.net 程序设计教程。由清华大学的教师做的测试，例子是非常棒的。 可能性供大家学习，和进步的一些好源码。 一步一步走让你的，编程道路，对初学者帮助由其最大
vb.net源码分享
04-15
vb.net源码分享 计算机机房管理系统
VB代码VB程序设计代码
07-12
VB小程序VB程序设计代码VB程序设计代码VB程序设计代码VB程序设计代码
vb.net语言之集合练习
weixin_30908707的博客
07-24 155
到今天为址,vb.net语言的基础知识终于被我拿下了 ,以下是今天所做练习的源码:Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim x As New Collection Dim i As Integer...
VB.net 经典小程序
07-26
VB语言写的一些经典小程序，比如登录窗口（实现三次错误输入后禁止登录），多项式就和，判断一个字符串是否是回文串，判断一个数是否是素数，抽奖程序等。
Visual Basic.NET程序员代码库
qq_42914801的博客
01-31 437
微软公司新推出的VB.NET是自从Visual Basic程序设计语言问世以来功能完善的一个版本，该版本中引入了新的程序设计方法和新的工作环境。本书各章节中讨论的程序设计方法和代码案例都是针对各种应用提供的实用案例，其范围不仅包括*常用的文件管理、数据库格式转换、XML Web服务设计等，而且还涉及到C#语言和Visual Basic.NET混合编程的方法和技巧。我们相信，在本书的帮助下，读者将可...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值