[技术讨论] [分享]VBS以TXT备份还原文件

Option Explicit

Dim blnNum, objFso, objFile, strFile, lngCnt, lngStartTime

If WScript.Arguments.Count = 0 Then
	CreateObject("Wscript.Shell").Popup "把文件拖到我身上就行了", 3, "^o^", 0
	WScript.Quit
End If

lngStartTime = Timer

strFile = WScript.Arguments(0)
Set objFso = CreateObject("Scripting.FileSystemObject")


'检查文件名后面部分是否为备份的 TXT 文件
If RM(strFile, "^.+_back\.txt$", True, True) = True Then
	Set objFile = objFso.OpenTextFile(strFile, 1, False)
	lngCnt = 0
	blnNum = False
	Do Until objFile.AtEndOfStream
		'检查数值范围是否为0~255(byte)
		blnNum = RM(objFile.ReadLine, _
			"^(?:1\d\d|2[0-4]\d|[1-9]\d|25[0-5]|\d)$", True, True)
		If blnNum = False Then Exit Do
		lngCnt = lngCnt + 1
		If lngCnt > 1000 Then Exit Do	'最多只检查前 1000 行数据
	Loop
	objFile.Close
	Set objFile = Nothing
	
	If blnNum = False Then
		set objFso = Nothing
		MsgBox "文件内容不符合备份文件的格式", vbOKOnly, ":("
		WScript.Quit
	End If
	
	'如果已经存在原文件则提示是否覆盖
	If objFso.FileExists(Left(strFile, len(strfile) - 9)) Then
		If MsgBox("目标文件已经存在,是否覆盖???", vbOKCancel, _
			"确定:覆盖   取消:退出") = 1 Then
			lngStartTime = Timer	'重新计时
			Call Recovery(strFile)
		End If
	Else
		Call Recovery(strFile)
	End If
Else	'如果不是备份的 TXT 文件
	If (objFso.GetFile(strFile).Size \ 1024) > 1024 Then
		'检查文件大小,大的文件处理的时间太长
		Set objFso = Nothing
		MsgBox "对不起,目前暂不处理大于 1M 的文件", vbOKOnly, ":("
		WScript.Quit
	End if
	If objFso.FileExists(strFile & "_back.txt") Then
		'如果存在备份文件则提示是否覆盖
		If MsgBox("备份文件已经存在,是否覆盖???", vbOKCancel, _
			"确定:覆盖   取消:退出") = 1 Then
			lngStartTime = Timer	'重新计时
			Call Backup(strFile)
		End If
	Else
		Call Backup(strFile)
	End If
End If

Set objFso = Nothing
CreateObject("Wscript.Shell").Popup "耗时:【" & _
	Round(Timer - lngStartTime, 4) & "】秒", 5, "Done...", 0


'##############################################################################
Sub Recovery(srcFile)	'把保存为 TXT 的文件恢复为原文件
	Dim arrBit(), objFso, objFile, objADODB, lngCnt, strTmp, arrChr, i
	lngCnt = 0
	
	Set objFso = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFso.OpenTextFile(srcFile, 1, False)
	Set objADODB = CreateObject("ADODB.Stream")
	Do Until objFile.AtEndOfStream
		ReDim Preserve arrBit(lngCnt)
		arrBit(lngCnt) = objFile.ReadLine
		lngCnt = lngCnt + 1
	Loop
	objFile.Close
	Set objFile = Nothing
	Set objFso = Nothing
	
	lngCnt = lngCnt - 1
	ReDim arrChr(lngCnt \ 2)
	For i = 0 To lngCnt - 1 Step 2
		arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))
	Next
	If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))
	arrChr = Join(arrChr, "")
	objADODB.Type = 1
	objADODB.Open
	With CreateObject("ADODB.Stream")
		.Type = 2	'adTypeText = 2
		.Open
		.Writetext arrChr
		.Position =  2
		.Copyto objADODB
		.Close
	End With
	objADODB.SaveToFile Left(srcFile, len(srcfile) - 9), 2
		'adSaveCreateOverWrite = 2, adSaveCreateNotExist = 1
	objADODB.Close
	Set objADODB = Nothing
End Sub


'##############################################################################
Sub Backup(srcFile)		'把源文件存储为 TXT 文件
	Dim objADODB, objFso, objFl, i, arrBit(0)
	Set objADODB = CreateObject("ADODB.Stream")
	Set objFso = CreateObject("Scripting.FileSystemObject")
	Set objFl = objFso.OpenTextFile(srcFile & "_Back.txt", 2, True)
	With objADODB
		.Open
		.Type = 1	'adTypeBinary = 1
		.LoadFromFile srcFile
		For i = 0 To .Size - 1
			arrBit(0) = AscB(.Read(1))
			objFl.WriteLine arrBit(0)
		Next
		.Close
	End With
	Set objADODB = Nothing
	objFl.Close
	Set objFl = Nothing
	Set objFso = Nothing
End Sub


'##############################################################################
Function RM(strVar, strPtrn, blnGlb, blnCase)
	'Regular-expression Match
	RM = False
	Dim objReg
	Set objReg = New RegExp
	With objReg
		.Pattern = strPtrn
		.Global = blnGlb
		.IgnoreCase = blnCase
		RM = .Test(strVar)
	End With
	Set objReg = Nothing
End Function
复制代码