标题: [技术讨论] [分享]VBS以TXT备份还原文件 [打印本页]
作者: more 时间: 2011-11-9 23:50 标题: [分享]VBS以TXT备份还原文件
把任意格式的文件分解到文本文件中,并且还可以用此脚本进行恢复...
目前把目标文件限制为 1M 以内,因为大的文件会另保存的文本文件变得很大...
使用方法:把需要处理的文件拖曳到此脚本上就可以了...- 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
复制代码
作者: more 时间: 2011-11-10 00:20
应用: 把GREP.EXE还原到临时文件夹中并用GREP.EXE打印脚本中非注释部分的代码...
由于文件比较大,故只贴出还原的代码,全部代码(包含GREP.EXE的内容)则以附件形式上传...- Option Explicit
-
- '把保存为 TXT 的文件恢复为原文件
- Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i
- Dim blnStart, strTmp
-
- blnStart = False
- lngCnt = 0
-
- Set objFso = CreateObject("Scripting.FileSystemObject")
- Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)
- Set objADODB = CreateObject("ADODB.Stream")
- strFile = objFso.GetSpecialFolder(2) & "\grep.exe" '文件还原到"临时文件夹"
-
- '把文件内容赋值给数组
- Do Until objFile.AtEndOfStream
- If blnStart = True Then
- ReDim Preserve arrBit(lngCnt)
- strTmp = objFile.ReadLine
- arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)
- lngCnt = lngCnt + 1
- Else
- If objFile.ReadLine = "'grep.exe" Then blnStart = True
- End If
- Loop
- objFile.Close
- Set objFile = 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
- .Open
- .Writetext arrChr
- .Position = 2
- .Copyto objADODB
- .Close
- End With
- objADODB.SaveToFile strFile, 2
- objADODB.Close
- Set objADODB = Nothing
- Set objFso = Nothing
-
- CreateObject("Wscript.Shell").Run "cmd /c " & strFile & " -P ""^[^']+"" """ & _
- WScript.ScriptFullName & """&echo.&set/p=请按任意键退出...<nul&pause>nul"
复制代码
http://pan.baidu.com/share/link?shareid=164262390&uk=1124163200
作者: more 时间: 2011-11-26 19:35
再来一个还原嵌入mp3铃声的代码...- Option Explicit
-
- '把保存为 TXT 的文件恢复为原文件
- Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i
- Dim blnStart, strTmp
-
- blnStart = False
- lngCnt = 0
-
- Set objFso = CreateObject("Scripting.FileSystemObject")
- strFile = objFso.GetSpecialFolder(2) & "\不要用我的爱来伤害我.mp3" '文件还原到"临时文件夹"
-
- '如果已经存在指定文件(非第一次运行此脚本)则直接调用播放的过程
- If objFso.FileExists(strFile) Then
- Call PlaySong(strFile)
- Set objFso = Nothing
- WScript.Quit
- End If
-
- Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)
- Set objADODB = CreateObject("ADODB.Stream")
-
- '把文件内容赋值给数组
- Do Until objFile.AtEndOfStream
- If blnStart = True Then
- ReDim Preserve arrBit(lngCnt)
- strTmp = objFile.ReadLine
- arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)
- lngCnt = lngCnt + 1
- Else
- If objFile.ReadLine = "'不要用我的爱来伤害我.mp3" Then blnStart = True
- End If
- Loop
- objFile.Close
- Set objFile = 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
- .Open
- .Writetext arrChr
- .Position = 2
- .Copyto objADODB
- .Close
- End With
- objADODB.SaveToFile strFile, 2
- objADODB.Close
- Set objADODB = Nothing
- Set objFso = Nothing
-
- Call PlaySong(strFile)
-
- Sub PlaySong(strMusic)
- Dim i
- For i = 0 To 2 '播放三次
- With CreateObject("WMPlayer.ocx")
- .url = strMusic
- .controls.play
- Do Until .playstate = 1
- WScript.Sleep 500
- Loop
- End With
- Next
- End Sub
-
- '不要用我的爱来伤害我.mp3
复制代码
http://pan.baidu.com/share/link?shareid=159314051&uk=1124163200
欢迎光临 批处理之家 (http://bathome.net./) |
Powered by Discuz! 7.2 |