vbs 实现文件夹拷贝--采用堆栈不递归

时间:2022-07-26
本文章向大家介绍vbs 实现文件夹拷贝--采用堆栈不递归,主要内容包括其使用实例、应用技巧、基本知识点总结和需要注意事项,具有一定的参考价值,需要的朋友可以参考一下。
' 将 c 文件夹 复制到B目录下的某日期的文件夹下 如 b2016-7-25c
FolderLoopCopy "C:UserscaoyaDesktoptest1","C:UserscaoyaDesktoptest2"

Const srcSplit = ""
Sub FolderLoopCopy(srcF,desF)
    WScript.Echo " Ready Copy Folder: "  + srcF
    Dim oFso,oFolder,oSubFolders,oFiles,n
    Dim countSize,nowSize
    n = 0 ' 操作次数
    Set oFso = CreateObject("Scripting.FileSystemObject")    
    Set oFolder = oFso.GetFolder(srcF)
    countSize = oFolder.size+1
    nowSize = 1
    '生成日期文件夹
    nowTime = year(Now)&"-"&Month(Now)&"-"&day(Now)&"-"&Hour(Now)&"-"&Minute(Now)&"-"&Second(Now)
    exFolderName = desF + srcSplit + nowTime
    Call MyCreateFolder(oFso,exFolderName)
    WScript.Echo " "&n&" create folder: " + exFolderName
    n = n + 1
    exFolderName = exFolderName + srcSplit

    Dim srcFolder
    Set srcFolder = new MyFolder
    srcFolder.Path = oFolder.Path
    srcFolder.Name = oFolder.Name
    srcFolder.exPath = exFolderName
    '建立一个堆栈对象
    Dim fStack,exFolderName
    Set fStack = new MyStack
    fStack.push srcFolder

    '准备遍历堆栈
    Do While fStack.Count > 0
        '获取栈顶文件夹
        set tempF = fStack.Pop
        'WScript.Echo tempF.Path
        '获取栈顶文件夹路径对象
        set oFolder = oFso.GetFolder(tempF.Path)
        '创建相对应文件夹
        tempFolderPath = tempF.makeCopyFolderPath()
        WScript.Echo " "&n&" create folder: "  + tempFolderPath
        n = n + 1
        Call MyCreateFolder(oFso,tempFolderPath)

        '获取子文件和子文件夹
        set oSubFolders = oFolder.SubFolders
        set oFiles = oFolder.Files 
        For Each oFile In oFiles    
            tempFileName =tempFolderPath + srcSplit + oFile.Name
            nowSize = nowSize + oFile.size
            WScript.Echo " "&n&" "&nowSize/countSize*100&"% create file: " + tempFileName
            n = n + 1
            oFile.Copy(tempFileName)
        Next

        For Each oSubFolder In oSubFolders
            Dim tempFolder
            set tempFolder = new MyFolder      
            tempFolder.Path = oSubFolder.Path
            tempFolder.Name = oSubFolder.Name
            tempFolder.exPath = tempFolderPath + srcSplit
            fStack.push tempFolder
        Next
    Loop 
    Set oFolder = Nothing    
    Set oSubFolders = Nothing    
    Set oFso = Nothing
    Set tempF = Nothing
    WScript.Echo "Copy Folder: "  + srcF + " done "
End Sub

'---------------------方便创建和复制-------------------------------
Sub MyCreateFolder(fso,folderName)
    if not fso.FolderExists(folderName) Then
    fso.CreateFolder(folderName)    
    End If
End Sub

Sub MyCopyFolder(fso,srcF,desF)
    if fso.FolderExists(desF) Then
    fso.CopyFolder srcF,desF    
    End If
End Sub

'------------------------------文件夹类-------------------------------------
Class MyFolder
    Private Str_Path
    Private Str_Name
    Private Str_exPath  '复制的路径前缀
    
    'Property Get语句,获取属性值或对象引用,Default只与Public一起使用,表示该属性为类的默认属性
    Public Property Get Path   ' 完全路径
        Path = Str_Path
    End Property  
 
    Public Property Get Name ' 文件夹的名字
        Name = Str_Name
    End Property

    Public Property Get exPath ' 文件夹的名字
        exPath = Str_exPath
    End Property
 
    'Property Let语句,设置属性值
    Public Property Let Path(New_Path)
        Str_Path = New_Path
    End Property   
 
    Public Property Let Name(New_Name)
        Str_Name = New_Name
    End Property 
 
    Public Property Let exPath(New_exPath)
        Str_exPath = New_exPath
    End Property 

    Public Sub ToString()
        WScript.Echo  "Path:"+Path+" Name: "+Name
    End Sub

    Public Function makeCopyFolderPath()
        makeCopyFolderPath = exPath + Name
    End Function

    Public Function makeCopyFilePath(fileName)
        makeCopyFilePath = exPath + Name + srcSplit + fileName
    End Function
End Class
'------------------------------文件夹类-------------------------------------

'----------------------------堆栈-------------------------------------
Const MAX_STACK = 1024
Class MyStack
    Public top  '声明变量top
    Public bottom  '声明变量now
    Public stack(1024)  '声明堆数组
    
    '类方法
    Public Sub push(temp)
        if top < MAX_STACK Then
            SET stack(top) = temp
            top = top + 1
        Else
            WScript.Echo "push(temp):stack gone max......"
        End if
    End Sub
    
    Public Function pop()
        if top > bottom Then
            SET pop = stack(top-1)
            top = top - 1
        Else
            pop = 0
            WScript.Echo "pop():stack gone bug......"
        End if
    End Function

    Public Function Count()
        Count = top - bottom
    End Function
End Class
'----------------------------堆栈-------------------------------------