<%


Class ReNameCls
    Private sTemplateName, sStartNum, sNumLen, sExName
    Private sFilePath
    Private Fso
    
    Private Sub Class_Initialize()
        ShowMsg "正在初始化数据......."
        ShowMsg "==========================================="
        Set Fso = CreateObject("Scripting.FileSystemObject")
        sStartNum = 0 
        sNumLen = 1
        sExName = ""
    End Sub
    
    Private Sub Class_Terminate()
        Set Fso = Nothing
        ShowMsg "文件批量改名完成，谢谢使用！！！！"
    End Sub
    '设置改后的文件名前N位
    Public Property Let TemplateName(ByVal strVar)
        If strVar = "" Then
            ShowMsg "TemplateName 不能为空，请重新设置。" : Response.End
        Else
            sTemplateName = strVar
        End if
        ShowMsg "改名后的文件名前几位为：<font color=blue>" & sTemplateName & "</font>"
    End Property
    '设置路径
    Public Property Let FilePath(ByVal strVar)
        sFilePath = strVar
        If strVar = "" Then
            ShowMsg "TemplateName 不能为空，请重新设置。" : Response.End
        Else
            If Right(sFilePath,1) <> "\" Then sFilePath = sFilePath & "\"
            If Not Fso.FolderExists(sFilePath) Then
                ShowMsg "FilePath 指定的路径不存在，请重新设置。" : Response.End
            End if
            ShowMsg "指定的路径：<font color=blue>" & sFilePath & "</font>"
        End if
    End Property
    '动态开始位置
    Public Property Let StartNum(ByVal strVar)
        If IsNumeric(strVar) Then
            sStartNum = strVar
        Else
            ShowMsg "StartNum 指定的值不是数值型数据，请重新设置。" : Response.End
        End if
        ShowMsg "动态文件名的开始：<font color=blue>" & sStartNum & "</font>"
    End Property
    '动态位数
    Public Property Let NumLen(ByVal strVar)
        If IsNumeric(strVar) Then
            If strVar = 0 then 
                sNumLen = 1 
            Else
                sNumLen = strVar
            End if
            ShowMsg "动态位数：<font color=blue>" & sNumLen & "</font> 位"
        Else
            ShowMsg "NumLen 指定的值不是数值型数据，请重新设置。" : Response.End
        End if
    End Property
    '设置要改的扩展名
    Public Property Let ExName(ByVal strVar)
        sExName = strVar
        ShowMsg "改扩展名为：<font color=blue>" & sExName & "</font>"
    End Property
    '开始批量改名
    Public Sub ReNameAllFile()
        Dim FileNameList, i,FileNum ,DotPoint ,OldFileName ,NewFileName, TempExName, ModNum
        ShowMsg "==========================================="
        ShowMsg "初始化数据完成。"
        ShowMsg "开始批量改名，请等待......."
        FileNameList = ShowFileList(sFilePath)
        FileNameList = Split(Left(FileNameList,Len(FileNameList)-1),"|",-1,1)
        ShowMsg "文件数目: " & (UBound(FileNameList)+1)
        ShowMsg "设置合法的文件数目: " & LegitNum()
        ShowMsg "<font color=blue>设置合法的文件数目必须大于等于文件数目" & UBound(FileNameList)+1 & "</font>"
        If LegitNum() < (UBound(FileNameList)+1) Then ShowMsg "NumLen 指定的值小于文件数目，请重新设置。" : Response.End 
        FileNum = sStartNum:ModNum = 1
        For i = 0 to UBound(FileNameList)
            DotPoint = CountInStr(FileNameList(i),".")
            TempExName = Right(FileNameList(i),Len(FileNameList(i)) - DotPoint)
            If sExName<>"" Then
                OldFileName = FileNameList(i)
                NewFileName = sTemplateName & FormatNum(FileNum) & "." & sExName
            Else
                OldFileName = FileNameList(i)
                NewFileName = sTemplateName & FormatNum(FileNum) & TempExName
            End if
            Call Fso.CopyFile(sFilePath & OldFileName,sFilePath & NewFileName,True)
            If OldFileName<> NewFileName Then Call Fso.DeleteFile(sFilePath & OldFileName)
            ShowMsg "<font color=red>" & OldFileName & " 改名为： " & NewFileName & "</font> 改名成功！"
            FileNum = FileNum + 1
        Next
    End Sub
    
    '显示消息
    Private Sub ShowMsg(msg)
        Response.Write msg & "<br>"
        Response.Flush
    End Sub
    
    '显示文件列表
    Function ShowFileList(folderspec)
        '//功能：目录存在时显示此目录下的所有文件
        '//形参：目录名
        '//返回值：成功为文件列表，失败为-1
        Dim f, f1, fc, s
        If Fso.FolderExists(folderspec) Then
            Set f = Fso.GetFolder(folderspec)
            Set fc = f.Files
            For Each f1 in fc
                s = s & f1.name 
                s = s &  "|"
            Next
            ShowFileList = s
        Else
            ShowFileList = -1
        End if
    End Function
    '字符在字符串的位置
    Private Function CountInStr(Str,Char)
        CountInStr = 0
        Dim i, CharLen
        CharLen = Len(Char)
        For i = 1 to Len(Str)
            If Mid(Str, i, CharLen) = Char Then CountInStr = CountInStr + 1
        Next
    End Function
    '初始化数字
    Private Function FormatNum(Num)
        If sNumLen = 0 Then
            FormatNum = Num
        Else
            If Len(CStr(Num))< sNumLen Then 
                FormatNum = Set0(sNumLen-Len(CStr(Num))) & Num
            Else
                FormatNum = Num
            End if
        End if
    End Function
    '生成N个0的字符串
    Private Function Set0(Num)
        For i = 1 to Num
            Set0 = Set0 & "0"
        Next
    End Function
    '合法的文件数目
    Private Function LegitNum()
        LegitNum = 1
        For i = 1 to sNumLen
            LegitNum = LegitNum * 10 
        Next
        LegitNum = LegitNum - sStartNum
    End Function
    
End Class

Dim ReNamePro
Set ReNamePro = New ReNameCls

ReNamePro.FilePath = "E:\cexoImage"                        '设置路径
ReNamePro.TemplateName = "Image"                        '设置改后的文件名前N位
ReNamePro.StartNum = 300                                '动态开始位置
ReNamePro.NumLen = 3                                    '动态位数
ReNamePro.ExName = "Jpg"                                '设置要改的扩展名
ReNamePro.ReNameAllFile()                                '开始批量改名

Set ReNamePro = Nothing
%>