renamefile.frm

文件名修改功能 ,vb的。希望对 学习者能有 帮助

VERSION 5.00
Begin VB.Form ReNameFile 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "文件名修改器"
   ClientHeight    =   5760
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9945
   Icon            =   "ReNameFile.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   5760
   ScaleWidth      =   9945
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox Text2 
      Height          =   300
      Left            =   5350
      TabIndex        =   0
      Top             =   350
      Width           =   660
   End
   Begin VB.TextBox Text1 
      Height          =   300
      Left            =   7210
      TabIndex        =   1
      Top             =   350
      Width           =   420
   End
   Begin VB.FileListBox File1 
      Height          =   3870
      Left            =   4440
      Pattern         =   "*"
      TabIndex        =   5
      Top             =   750
      Width           =   5200
   End
   Begin VB.TextBox ConditonTxt 
      Height          =   300
      Left            =   9195
      TabIndex        =   2
      Top             =   350
      Width           =   420
   End
   Begin VB.DirListBox Dir1 
      Height          =   3870
      Left            =   240
      TabIndex        =   4
      Top             =   750
      Width           =   3855
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   240
      TabIndex        =   3
      Top             =   360
      Width           =   3855
   End
   Begin VB.CommandButton StartRenameCmd 
      Caption         =   "开始修改"
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3600
      TabIndex        =   6
      Top             =   4920
      Width           =   1455
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "主文件名长度："
      Height          =   180
      Left            =   7935
      TabIndex        =   9
      Top             =   405
      Width           =   1260
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "开始位置："
      Height          =   180
      Left            =   6310
      TabIndex        =   8
      Top             =   410
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "文件类型："
      Height          =   180
      Left            =   4440
      TabIndex        =   7
      Top             =   410
      Width           =   900
   End
End
Attribute VB_Name = "ReNameFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Drive1_Change()
Dir1.path = Drive1.Drive
End Sub

Private Sub Dir1_Change()
File1.path = Dir1.path
End Sub

Private Sub File1_PathChange()
File1.FileName = "*"
End Sub

Private Sub StartRenameCmd_Click()
Dim File_Name As String
Dim New_File_Name As String
'打开此目录(含子目录)下的所有文件
Dim oCols As New Collection
Dim varFileName As Variant
FindFile Dir1.path & "\", Text2.Text, oCols
For Each varFileName In oCols
  File_Count = File_Count + 1
  File_Name = Right(varFileName, Len(varFileName) - InStrRev(varFileName, "\"))
  New_File_Name = Mid(File_Name, Text1.Text, ConditonTxt.Text) & "." & Text2.Text
  Shell "cmd /c rename """ & varFileName & """ """ & New_File_Name & """"
Next varFileName
MsgBox "已修改" & oCols.Count & "个文件！"
File1.Refresh
End Sub

'找出该目录下的文件
Public Function FindFile(ByVal sTmp As String, ByVal extendName As String, Lst As Collection)
Dim myPath, myName      As String
Dim CurName             As String
Dim CurExtend           As String
myPath = sTmp
myName = Dir(myPath, vbDirectory)
While Len(myName) > 0
    If myName <> "." And myName <> ".." Then
        If (GetAttr(myPath & myName) And vbDirectory) <> vbDirectory Then
           CurName = Left(myName, InStrRev(myName, ".") - 1)
           CurExtend = Right(myName, Len(myName) - InStrRev(myName, "."))
           If UCase(CurExtend) = UCase(extendName) Then
              Lst.Add (myPath & myName)
           End If
        End If
   End If
   myName = Dir
Wend
End Function