VBS植物大战僵尸无尽版记录备份工具

' VB Script Document
'植物大战僵尸泳池无尽记录备份工具v1.0
'本程序在windows7上测试通过
'《植物大战僵尸》存档位置：
'xp用户
'默认在 plants vs zombies游戏目录 userdata
'vista操作系统以上用户
'默认在 C:ProgramData/PopCap Games/PlantsVsZombie/userdata
'******************************************
'*                                        *
'*       作者：zy3364432@qq.com           *
'*                                        *
'******************************************
Set ws= WScript.CreateObject("WScript.Shell")
Dim Path,WS,SaveDataName,BackupDataName,BackupFolderName,fso,Choice
Path="C:/ProgramData/PopCap Games/PlantsVsZombies/userdata/"
BackupFolderName="泳池无尽版记录备份"
BackupDataPath=Path & BackupFolderName & "/"
SaveDataName="game1_13.dat"
BackupDataName="game1_13" & year(Date) & "年" & month(Date) & "月" & day(Date) & "日" & hour(Time) & "时" & minute(Time) & "分" & second(Time) & "秒" & ".dat"

Choice=inputbox("请输入要进行的操作:" & vbcrlf & vbcrlf & _
"[1].备份当前记录" & vbcrlf & _
"[2].还原已备份记录点" & vbcrlf & _
"[3].删除记录点" & vbcrlf & _
"[4].查看记录点" & vbcrlf & _
"[5].打开记录点文件夹"_
,"操作选择",1)

    If Choice<>"" Then
        Select Case Choice
            case 1:Backup()
            case 2:RestoreFile()
            case 3:Remove()
            case 4:msgbox ShowFiles(ReturnAllFiles(BackupDataPath)),,"共" & UBound(ReturnAllFiles(BackupDataPath))+1 & "条记录"
            case 5:WS.run "explorer " & BackupDataPath
            case else:msgbox "作者:zy3364432@qq.com",vbExclamation
        End Select
    End if
'**********************************************************************************************************************************************************
    Sub Backup()'备份子程序段
        If CheckFile(Path,SaveDataName) and CheckFolder(Path,BackupFolderName) Then
            CopyFile Path,BackupDataPath,SaveDataName,BackupDataName
            If CheckFile(BackupDataPath,BackupDataName) Then
                msgbox "记录备份成功！" & vbcrlf & BackupDataName,,"成功"
            Else
                msgbox "记录备份失败！",,"失败"
            End if
        End if
    End Sub
'**********************************************************************************************************************************************************
 Function CopyFile(FromPath,ToPath,SourceFileName,SaveFileName)'复制文件子程序
   Set fso=WScript.CreateObject("scripting.filesystemobject")
                fso.copyFile FromPath & SourceFileName,ToPath & SaveFileName
   Set fso=Nothing

            if err.number>0 then
                msgbox err.Description
            else
                CopyFile=true
            end if
    End Function
'**********************************************************************************************************************************************************
    Function CheckFile(FilePath,FileName)'检查文件是否存在
        Dim ReturnValue
        Set fso=CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(FilePath & FileName) Then'判断文件是否存在 
            ReturnValue=True
        Else
            ReturnValue=False
            msgbox "不存在" & FilePath & FileName,,"错误"
        End If
        Set fso=Nothing
        CheckFile=ReturnValue'存在返回真
    End Function
'**********************************************************************************************************************************************************
    Function CheckFolder(FolderPath,FolderName)'检查文件夹是否存在
        Dim ReturnValue
        Set fso=CreateObject("Scripting.FileSystemObject")
        If fso.FolderExists(FolderPath & FolderName) Then'判断文件夹是否存在
            ReturnValue=True
        Else
            ReturnValue=False
            if msgbox("不存在" & FolderPath & FolderName & vbcrlf &"是否创建备份文件夹？",vbYesNO,"文件夹不存在")=6 then'点击是则返回6点否返回7
                fso.CreateFolder(FolderPath & FolderName)'创建文件夹
                ReturnValue=True
            End if
        End If
        Set fso=Nothing
        CheckFolder=ReturnValue'存在返回真
    End Function  
'*********************************************************************************************************************************************************
 Function ReturnAllFiles(path)'返回一个保存文件名的数组
  dim allfolders
  dim allfiles
        dim files
        dim count
        dim FilesArray()
  set fso=WScript.CreateObject("scripting.filesystemobject")
  set allfolders=fso.getfolder(path)'创建文件夹对象
  set allfiles=allfolders.files'获得文件对象

  for each files in allfiles
        count=count+1
  next

        Redim FilesArray(count-1)
        count=0

        for each files in allfiles
  FilesArray(count)=files.name'输出文件名到数组
        count=count+1
  next

  set allfiles=nothing
  set allfolders=nothing
  set fso=nothing
  ReturnAllFiles=FilesArray
 End function
'*******************************************************************************************************************************************************
    Function ShowFiles(ByVal ShowArray())'显示数组内容
        dim i,FileNames
        for i=LBound(ShowArray) to UBound(ShowArray)
            FileNames=FileNames & vbcrlf & "[" & CStr(i) & "]." & Mid(Left(ShowArray(i),Len(ShowArray(i))-4),9)
        next
        ShowFiles=FileNames
    End Function
'*******************************************************************************************************************************************************
    Sub RestoreFile()
        Dim ChooseNumber
        FileList=ReturnAllFiles(BackupDataPath)'将文件名数组赋值给FileList
        ChooseNumber=inputbox("请输入要还原的时间点的序号:" & vbcrlf & ShowFiles(FileList),"还原记录",UBound(FileList))
        If ChooseNumber>=Cstr(LBound(FileList)) and ChooseNumber<=Cstr(UBound(FileList)) Then
            DeleteFile Path,SaveDataName
            If CopyFile(BackupDataPath,Path,FileList(ChooseNumber),SaveDataName) then
                msgbox "记录还原成功！" & vbcrlf & "记录名为:" & FileList(ChooseNumber),,"成功"
            Else
                msgbox "记录还原失败！",,"失败"
            End if
        Elseif ChooseNumber="" then
            WScript.quit
        Else
            msgbox "输入错误！",vbExclamation,"错误"
        End if
    End Sub
'*******************************************************************************************************************************************************
    Function DeleteFile(DeleteFilePath,DeleteFileName)
        Dim ReturnValue,DeletePath
        DeletePath=DeleteFilePath & DeleteFileName
        Set fso=WScript.CreateObject("scripting.filesystemobject")
        If fso.FileExists(DeletePath) Then
            fso.DeleteFile(DeletePath)
            ReturnValue=True
        Else
            ReturnValue=False
        End if
        Set fso=Nothing
        DeleteFile=ReturnValue
    End Function
'******************************************************************************************************************************************************
    Sub Remove()
        Dim ChooseNumber
        FileList=ReturnAllFiles(BackupDataPath)'将文件名数组赋值给FileList
        ChooseNumber=inputbox("请输入要删除的还原的时间点的序号:" & vbcrlf & ShowFiles(FileList),"还原记录",LBound(FileList))
        If ChooseNumber>=Cstr(LBound(FileList)) and ChooseNumber<=Cstr(UBound(FileList)) Then
            If DeleteFile(BackupDataPath,FileList(ChooseNumber)) then
                msgbox "记录删除成功！" & vbcrlf & "记录名为:" & FileList(ChooseNumber),,"成功"
            Else
                msgbox "记录删除失败！",,"失败"
            End if
        Elseif ChooseNumber="" then
            WScript.quit
        Else
            msgbox "输入错误！",vbExclamation,"错误"
        End if
    End Sub
Set WS=nothing
WScript.quit

 

 

将以上代码用记事本保存成 无尽记录备份工具.vbs

尽情挑战无尽泳池的乐趣吧。

注：目前只支持windows7