产品图片很多而且图片的名称都是按货号命名的。有时候要通过图片来获取货号名称,想怎么快速获取几百个图片文件的名称呢。于是就写了这个程序。
功能:选择某一个文件夹,想获取里面的文件的名称,或者只获取里面的文件夹名称,直接用这个程序。
VB.Net 2005,程序界面如:
这里用到一个控件,用起来超级爽。都不用自己写什么就可以浏览电脑资源了。整个dll文件才88K。只有用的人才知道:好用啊,做什么资源管理程序,管理器都可以用这个控件了。ExpTree控件参考:
http://www.codeproject.com/KB/cpp/VbNetExpTree.aspx
快速获取文件夹/文件名称程序代码:
- Imports System.IO
- Imports System.Text
- Imports System.Resources
- Imports System.Reflection
- Imports ExpTreeLib
- Imports ExpTreeLib.CShItem
- Imports ExpTreeLib.SystemImageListManager
- 'ExpTree控件参考:
- 'http://www.codeproject.com/KB/cpp/VbNetExpTree.aspx
- Public Class FrmMain
- Dim i As Integer
- Dim CurPath As String
- Public Sub New()
- ' 此调用是 Windows 窗体设计器所必需的。
- InitializeComponent()
- ' 在 InitializeComponent() 调用之后添加任何初始化。
- SystemImageListManager.SetListViewImageList(lv1, True, False)
- SystemImageListManager.SetListViewImageList(lv1, False, False)
- End Sub
- Private Sub ShowMsg(ByVal Msg As String, Optional ByVal mType As MsgType = MsgType.Ok)
- If mType = MsgType.Ok Then
- Me.LB.ForeColor = Color.Black
- Me.LB.Text = Msg
- Else
- Me.LB.ForeColor = Color.Red
- Me.LB.Text = "出错:" & Msg
- End If
- Me.LB.Refresh()
- End Sub
- Private Sub SetDirInfo(ByVal info As String)
- Me.LBDirInfo.Text = info
- Me.LBDirInfo.Refresh()
- End Sub
- Private Sub lv1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles lv1.DoubleClick
- ExeLv1Selection()
- End Sub
- Private Sub lv1_DragEnter(ByVal sender As System.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 System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles lv1.DragDrop
- If e.Data.GetDataPresent(DataFormats.FileDrop) Then
- Dim MyFiles() As String
- Dim item As CShItem
- Dim sb As New StringBuilder
- MyFiles = e.Data.GetData(DataFormats.FileDrop)
- Me.TxtBoxMain.Clear()
- For i = 0 To MyFiles.Length - 1
- item = New CShItem(MyFiles(i))
- '如果拖放的是硬盘,隐藏文件,快捷方式,系统文件,网络硬盘,可移动硬盘就不添加到lv1中。
- If (item.IsDisk = False And item.IsLink = False And item.IsSystem = False And item.IsNetworkDrive = False And item.IsRemovable = False) Then
- Dim lvi As New ListViewItem(item.DisplayName)
- With lvi
- .ImageIndex = SystemImageListManager.GetIconIndex(item, False)
- .Tag = item
- End With
- lv1.Items.Add(lvi)
- End If
- Next
- 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
- ExeLv1Selection()
- ElseIf e.KeyCode = Keys.Delete Then
- If Me.lv1.SelectedItems.Count > 0 Then
- Me.lv1.Items.RemoveAt(Me.lv1.SelectedIndices(0))
- End If
- End If
- End Sub
- Private Sub ExeLv1Selection()
- If IsNothing(lv1.SelectedItems) OrElse lv1.SelectedItems.Count < 1 Then Exit Sub
- Dim item As CShItem = lv1.SelectedItems(0).Tag
- If item.IsFolder Then
- ExpTree1.ExpandANode(item)
- Else
- Try
- System.Diagnostics.Process.Start(item.Path)
- Catch ex As Exception
- Throw New Exception(ex.Message)
- End Try
- End If
- End Sub
- #Region " lv1_MouseUp 单击打开文件夹"
- 'Private Sub lv1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles lv1.MouseUp
- 'Dim lvi As ListViewItem = lv1.GetItemAt(e.X, e.Y)
- 'If IsNothing(lvi) Then Exit Sub
- 'If IsNothing(lv1.SelectedItems) OrElse lv1.SelectedItems.Count < 1 Then Exit Sub
- 'Dim item As CShItem = lv1.SelectedItems(0).Tag
- 'If item.IsFolder Then
- ' If e.Button = Windows.Forms.MouseButtons.Left Then
- ' ExpTree1.ExpandANode(item)
- ' End If
- 'End If
- 'End Sub
- #End Region
- Private Sub BtClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtClose.Click
- Me.Close()
- Application.Exit()
- End Sub
- Private Sub BtCopyText_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtCopyText.Click
- If Me.TxtBoxMain.Text > String.Empty Then
- System.Windows.Forms.Clipboard.Clear()
- System.Windows.Forms.Clipboard.SetText(Me.TxtBoxMain.Text)
- ShowMsg("文本内容已经复制在系统粘贴板中")
- End If
- End Sub
- Private Sub BtCopyList2TxtBox_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtCopyList2TxtBox.Click
- GetLvToTxt()
- ShowMsg("共 " & Me.TxtBoxMain.Lines.Length & " 行")
- End Sub
- Private Sub GetLvToTxt()
- Me.TxtBoxMain.Clear()
- Dim sb As StringBuilder
- Dim csi As CShItem
- Dim fln As String
- If Me.lv1.Items.Count > 0 Then
- sb = New StringBuilder
- If Me.ChkBoxIsNeedExt.Checked = True Then
- For i = 0 To lv1.Items.Count - 1
- csi = CType(Me.lv1.Items(i).Tag, CShItem)
- If csi.IsFolder Then
- sb.Append(csi.DisplayName)
- sb.AppendLine()
- Else
- fln = csi.GetFileName
- If Me.TxtExtStr.Text > "" Then
- If Me.RdBtExtAll.Checked = True Then
- sb.Append(fln)
- sb.AppendLine()
- End If
- If Me.RdBtExtFliter.Checked = True Then
- If fln.IndexOf(Me.TxtExtStr.Text) = -1 Then
- sb.Append(fln)
- sb.AppendLine()
- End If
- End If
- If Me.RdBtExtOnlyGet.Checked = True Then
- If fln.IndexOf(Me.TxtExtStr.Text) > -1 Then
- sb.Append(fln)
- sb.AppendLine()
- End If
- End If
- Else
- sb.Append(fln)
- sb.AppendLine()
- End If
- End If
- Next
- Else
- For i = 0 To lv1.Items.Count - 1
- sb.Append(lv1.Items(i).Text)
- sb.AppendLine()
- Next
- End If
- Me.TxtBoxMain.Text = sb.ToString
- '减去最后一个空白行。
- Me.TxtBoxMain.Text = Mid(Me.TxtBoxMain.Text, 1, Me.TxtBoxMain.TextLength - 2)
- End If
- End Sub
- Private Sub TxtBoxMain_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TxtBoxMain.KeyDown
- If e.Control = True Then
- If e.KeyCode = Keys.A Then
- Me.TxtBoxMain.SelectAll()
- ElseIf e.KeyCode = Keys.C Then
- Me.TxtBoxMain.Copy()
- End If
- End If
- End Sub
- Private Sub BtComBiTxtMain_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtComBiTxtMain.Click
- If Me.TxtBoxMain.Text > "" Then
- Me.TxtBoxMain.Text = Replace(Me.TxtBoxMain.Text, Environment.NewLine, ",")
- ShowMsg("共 " & Me.TxtBoxMain.Lines.Length & " 行")
- End If
- End Sub
- Private Sub BtSplitTxtMain_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtSplitTxtMain.Click
- If Me.TxtBoxMain.Text > "" Then
- Me.TxtBoxMain.Text = Replace(Me.TxtBoxMain.Text, ",", Environment.NewLine)
- ShowMsg("共 " & Me.TxtBoxMain.Lines.Length & " 行")
- End If
- End Sub
- Private Sub LoadPathInfo(ByVal SelPath As String, ByVal CSI As ExpTreeLib.CShItem, ByVal AllFF As ShowFFType)
- Dim dirList As New ArrayList()
- Dim fileList As New ArrayList()
- Dim TotalItems As Integer
- If CSI.DisplayName.Equals(CShItem.strMyComputer) Then
- 'avoid re-query since only has dirs
- dirList = CSI.GetDirectories
- Else
- If AllFF = ShowFFType.All Then
- dirList = CSI.GetDirectories
- fileList = CSI.GetFiles
- ElseIf AllFF = ShowFFType.Folder Then
- dirList = CSI.GetDirectories
- ElseIf AllFF = ShowFFType.File Then
- fileList = CSI.GetFiles
- End If
- End If
- 'CSI.Path 如果是系统对象。就放回以::开头的GUID
- Me.TxtFFPath.Text = SelPath
- CurPath = SelPath
- TotalItems = dirList.Count + fileList.Count
- If TotalItems > 0 Then
- Dim item As CShItem
- dirList.Sort()
- fileList.Sort()
- SetDirInfo("共: " & dirList.Count & " 目录 " & fileList.Count & " 文件")
- Dim combList As New ArrayList(TotalItems)
- combList.AddRange(dirList)
- combList.AddRange(fileList)
- 'Build the ListViewItems & add to lv1
- lv1.BeginUpdate()
- lv1.Items.Clear()
- lv1.Refresh()
- For Each item In combList
- Dim lvi As New ListViewItem(item.DisplayName)
- With lvi
- 'SubItem formatting and adding to lvi omitted from (从...删除去)article text
- 'Set ListViewItem's IconIndex (and add Icon to lists if necessary)
- .ImageIndex = SystemImageListManager.GetIconIndex(item, False)
- .Tag = item
- End With
- lv1.Items.Add(lvi)
- Next
- lv1.EndUpdate()
- Else
- lv1.Items.Clear()
- SetDirInfo("0个对象")
- End If
- End Sub
- Private Sub BtOpenFolder_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtOpenFolder.Click
- If CurPath > "" Then
- System.Diagnostics.Process.Start(CurPath)
- End If
- End Sub
- Private Sub BtClearnListView_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtClearnListView.Click
- Me.lv1.Items.Clear()
- Me.lv1.Refresh()
- End Sub
- Private Sub RdBtShowFF_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RdBtShowAllFF.CheckedChanged, RdBtShowFile.CheckedChanged, RdBtShowFolder.CheckedChanged
- If CurPath > String.Empty Then
- SetDirInfo(String.Empty)
- Try
- Dim cshi As New CShItem(CurPath)
- LoadPathInfo(CurPath, cshi, GetShowFFType)
- Catch ex As Exception
- SetDirInfo("系统对象,无法过滤")
- End Try
- End If
- End Sub
- Private Function GetShowFFType() As ShowFFType
- If Me.RdBtShowAllFF.Checked Then Return ShowFFType.All
- If Me.RdBtShowFolder.Checked Then Return ShowFFType.Folder
- If Me.RdBtShowFile.Checked Then Return ShowFFType.File
- Return ShowFFType.All
- End Function
- Private Sub ExpTree1_ExpTreeNodeSelected(ByVal SelPath As System.String, ByVal Item As ExpTreeLib.CShItem) Handles ExpTree1.ExpTreeNodeSelected
- UnCheckFFType()
- LoadPathInfo(SelPath, Item, ShowFFType.All)
- End Sub
- Private Sub UnCheckFFType()
- Me.RdBtShowAllFF.Checked = True
- Me.RdBtShowFolder.Checked = False
- Me.RdBtShowFile.Checked = False
- End Sub
- Private Sub ChkBoxIsNeedExt_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ChkBoxIsNeedExt.CheckedChanged
- If Me.ChkBoxIsNeedExt.CheckState <> CheckState.Checked Then
- Me.RdBtExtAll.Checked = False
- Me.RdBtExtFliter.Checked = False
- Me.RdBtExtOnlyGet.Checked = False
- Me.TxtExtStr.Text = ""
- ElseIf Me.ChkBoxIsNeedExt.CheckState = CheckState.Checked Then
- Me.RdBtExtAll.Checked = True
- Me.TxtExtStr.Text = ""
- End If
- End Sub
- Private Sub BtRefrechFFList_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtRefrechFFList.Click
- ExpTree1.RefreshTree()
- End Sub
- Private Sub RdBtExtAll_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RdBtExtAll.CheckedChanged
- If Me.RdBtExtAll.Checked = True Then
- Me.TxtExtStr.Text = ""
- End If
- End Sub
- Private Sub BtClearTxtMain_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtClearTxtMain.Click
- Me.TxtBoxMain.Clear()
- End Sub
- End Class