' VB Script Document
'植物大戰殭屍泳池無盡記錄備份工具v1.0
'本程序在windows7上測試通過
'《植物大戰殭屍》存檔位置：
'xp用戶
'默認在 plants vs zombies遊戲目錄 userdata
'vista操作系統以上用戶
'默認在 C:ProgramData/PopCap Games/PlantsVsZombie/userdata
'******************************************
'* *
'* 作者：[email protected] *
'* *
'******************************************
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 "作者:[email protected]",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