设为首页收藏本站
切换到宽版

 找回密码
 注册
搜索
批处理之家»论坛 › 其他脚本区 › VBS求助&讨论 › [分享]VBS以TXT备份还原文件
[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发新帖
查看: 17370|回复: 2

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

[复制链接]
more
发表于 2011-11-9 23:50:44 | 显示全部楼层 |阅读模式
把任意格式的文件分解到文本文件中,并且还可以用此脚本进行恢复...
目前把目标文件限制为 1M 以内,因为大的文件会另保存的文本文件变得很大...
使用方法:把需要处理的文件拖曳到此脚本上就可以了...

  2. Option Explicit

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

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

  11. lngStartTime = Timer

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


  17. '检查文件名后面部分是否为备份的 TXT 文件
  18. If RM(strFile, "^.+_back\.txt$", True, True) = True Then
  19.         Set objFile = objFso.OpenTextFile(strFile, 1, False)
  20.         lngCnt = 0
  21.         blnNum = False
  22.         Do Until objFile.AtEndOfStream
  23.                 '检查数值范围是否为0~255(byte)
  24.                 blnNum = RM(objFile.ReadLine, _
  25.                         "^(?:1\d\d|2[0-4]\d|[1-9]\d|25[0-5]|\d)$", True, True)
  26.                 If blnNum = False Then Exit Do
  27.                 lngCnt = lngCnt + 1
  28.                 If lngCnt > 1000 Then Exit Do        '最多只检查前 1000 行数据
  29.         Loop
  30.         objFile.Close
  31.         Set objFile = Nothing
  32.        
  33.         If blnNum = False Then
  34.                 set objFso = Nothing
  35.                 MsgBox "文件内容不符合备份文件的格式", vbOKOnly, ":("
  36.                 WScript.Quit
  37.         End If
  38.        
  39.         '如果已经存在原文件则提示是否覆盖
  40.         If objFso.FileExists(Left(strFile, len(strfile) - 9)) Then
  41.                 If MsgBox("目标文件已经存在,是否覆盖???", vbOKCancel, _
  42.                         "确定:覆盖   取消:退出") = 1 Then
  43.                         lngStartTime = Timer        '重新计时
  44.                         Call Recovery(strFile)
  45.                 End If
  46.         Else
  47.                 Call Recovery(strFile)
  48.         End If
  49. Else        '如果不是备份的 TXT 文件
  50.         If (objFso.GetFile(strFile).Size \ 1024) > 1024 Then
  51.                 '检查文件大小,大的文件处理的时间太长
  52.                 Set objFso = Nothing
  53.                 MsgBox "对不起,目前暂不处理大于 1M 的文件", vbOKOnly, ":("
  54.                 WScript.Quit
  55.         End if
  56.         If objFso.FileExists(strFile & "_back.txt") Then
  57.                 '如果存在备份文件则提示是否覆盖
  58.                 If MsgBox("备份文件已经存在,是否覆盖???", vbOKCancel, _
  59.                         "确定:覆盖   取消:退出") = 1 Then
  60.                         lngStartTime = Timer        '重新计时
  61.                         Call Backup(strFile)
  62.                 End If
  63.         Else
  64.                 Call Backup(strFile)
  65.         End If
  66. End If

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


  73. '##############################################################################
  74. Sub Recovery(srcFile)        '把保存为 TXT 的文件恢复为原文件
  75.         Dim arrBit(), objFso, objFile, objADODB, lngCnt, strTmp, arrChr, i
  76.         lngCnt = 0
  77.        
  78.         Set objFso = CreateObject("Scripting.FileSystemObject")
  79.         Set objFile = objFso.OpenTextFile(srcFile, 1, False)
  80.         Set objADODB = CreateObject("ADODB.Stream")
  81.         Do Until objFile.AtEndOfStream
  82.                 ReDim Preserve arrBit(lngCnt)
  83.                 arrBit(lngCnt) = objFile.ReadLine
  84.                 lngCnt = lngCnt + 1
  85.         Loop
  86.         objFile.Close
  87.         Set objFile = Nothing
  88.         Set objFso = Nothing
  89.        
  90.         lngCnt = lngCnt - 1
  91.         ReDim arrChr(lngCnt \ 2)
  92.         For i = 0 To lngCnt - 1 Step 2
  93.                 arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))
  94.         Next
  95.         If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))
  96.         arrChr = Join(arrChr, "")
  97.         objADODB.Type = 1
  98.         objADODB.Open
  99.         With CreateObject("ADODB.Stream")
  100.                 .Type = 2        'adTypeText = 2
  101.                 .Open
  102.                 .Writetext arrChr
  103.                 .Position =  2
  104.                 .Copyto objADODB
  105.                 .Close
  106.         End With
  107.         objADODB.SaveToFile Left(srcFile, len(srcfile) - 9), 2
  108.                 'adSaveCreateOverWrite = 2, adSaveCreateNotExist = 1
  109.         objADODB.Close
  110.         Set objADODB = Nothing
  111. End Sub


  114. '##############################################################################
  115. Sub Backup(srcFile)                '把源文件存储为 TXT 文件
  116.         Dim objADODB, objFso, objFl, i, arrBit(0)
  117.         Set objADODB = CreateObject("ADODB.Stream")
  118.         Set objFso = CreateObject("Scripting.FileSystemObject")
  119.         Set objFl = objFso.OpenTextFile(srcFile & "_Back.txt", 2, True)
  120.         With objADODB
  121.                 .Open
  122.                 .Type = 1        'adTypeBinary = 1
  123.                 .LoadFromFile srcFile
  124.                 For i = 0 To .Size - 1
  125.                         arrBit(0) = AscB(.Read(1))
  126.                         objFl.WriteLine arrBit(0)
  127.                 Next
  128.                 .Close
  129.         End With
  130.         Set objADODB = Nothing
  131.         objFl.Close
  132.         Set objFl = Nothing
  133.         Set objFso = Nothing
  134. End Sub


  137. '##############################################################################
  138. Function RM(strVar, strPtrn, blnGlb, blnCase)
  139.         'Regular-expression Match
  140.         RM = False
  141.         Dim objReg
  142.         Set objReg = New RegExp
  143.         With objReg
  144.                 .Pattern = strPtrn
  145.                 .Global = blnGlb
  146.                 .IgnoreCase = blnCase
  147.                 RM = .Test(strVar)
  148.         End With
  149.         Set objReg = Nothing
  150. End Function
复制代码

评分

参与人数 1技术 +1 收起 理由
wc726842270 + 1 学习

查看全部评分

回复

举报

more
 楼主| 发表于 2011-11-10 00:20:49 | 显示全部楼层
应用: 把GREP.EXE还原到临时文件夹中并用GREP.EXE打印脚本中非注释部分的代码...
由于文件比较大,故只贴出还原的代码,全部代码(包含GREP.EXE的内容)则以附件形式上传...

  2. Option Explicit

  4. '把保存为 TXT 的文件恢复为原文件
  5. Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i
  6. Dim blnStart, strTmp

  8. blnStart = False
  9. lngCnt = 0

  11. Set objFso = CreateObject("Scripting.FileSystemObject")
  12. Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)
  13. Set objADODB = CreateObject("ADODB.Stream")
  14. strFile = objFso.GetSpecialFolder(2) & "\grep.exe"        '文件还原到"临时文件夹"

  16. '把文件内容赋值给数组
  17. Do Until objFile.AtEndOfStream
  18.         If blnStart = True Then
  19.                 ReDim Preserve arrBit(lngCnt)
  20.                 strTmp = objFile.ReadLine
  21.                 arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)
  22.                 lngCnt = lngCnt + 1
  23.         Else
  24.                 If objFile.ReadLine = "'grep.exe" Then blnStart = True
  25.         End If
  26. Loop
  27. objFile.Close
  28. Set objFile = Nothing

  30. '还原文件
  31. lngCnt = lngCnt - 1
  32. ReDim arrChr(lngCnt \ 2)
  33. For i = 0 To lngCnt - 1 Step 2
  34.         arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))
  35. Next
  36. If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))
  37. arrChr = Join(arrChr, "")
  38. objADODB.Type = 1
  39. objADODB.Open
  40. With CreateObject("ADODB.Stream")
  41.         .Type = 2
  42.         .Open
  43.         .Writetext arrChr
  44.         .Position =  2
  45.         .Copyto objADODB
  46.         .Close
  47. End With
  48. objADODB.SaveToFile strFile, 2
  49. objADODB.Close
  50. Set objADODB = Nothing
  51. Set objFso = Nothing

  53. CreateObject("Wscript.Shell").Run "cmd /c " & strFile & " -P ""^[^']+"" """ & _
  54.         WScript.ScriptFullName & """&echo.&set/p=请按任意键退出...<nul&pause>nul"

复制代码
http://pan.baidu.com/share/link?shareid=164262390&uk=1124163200
回复

举报

more
 楼主| 发表于 2011-11-26 19:35:14 | 显示全部楼层
再来一个还原嵌入mp3铃声的代码...

  2. Option Explicit

  4. '把保存为 TXT 的文件恢复为原文件
  5. Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i
  6. Dim blnStart, strTmp

  8. blnStart = False
  9. lngCnt = 0

  11. Set objFso = CreateObject("Scripting.FileSystemObject")
  12. strFile = objFso.GetSpecialFolder(2) & "\不要用我的爱来伤害我.mp3"        '文件还原到"临时文件夹"

  14. '如果已经存在指定文件(非第一次运行此脚本)则直接调用播放的过程
  15. If objFso.FileExists(strFile) Then
  16.         Call PlaySong(strFile)
  17.         Set objFso = Nothing
  18.         WScript.Quit
  19. End If

  21. Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)
  22. Set objADODB = CreateObject("ADODB.Stream")

  24. '把文件内容赋值给数组
  25. Do Until objFile.AtEndOfStream
  26.         If blnStart = True Then
  27.                 ReDim Preserve arrBit(lngCnt)
  28.                 strTmp = objFile.ReadLine
  29.                 arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)
  30.                 lngCnt = lngCnt + 1
  31.         Else
  32.                 If objFile.ReadLine = "'不要用我的爱来伤害我.mp3" Then blnStart = True
  33.         End If
  34. Loop
  35. objFile.Close
  36. Set objFile = Nothing

  38. '还原文件
  39. lngCnt = lngCnt - 1
  40. ReDim arrChr(lngCnt \ 2)
  41. For i = 0 To lngCnt - 1 Step 2
  42.         arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))
  43. Next
  44. If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))
  45. arrChr = Join(arrChr, "")
  46. objADODB.Type = 1
  47. objADODB.Open
  48. With CreateObject("ADODB.Stream")
  49.         .Type = 2
  50.         .Open
  51.         .Writetext arrChr
  52.         .Position =  2
  53.         .Copyto objADODB
  54.         .Close
  55. End With
  56. objADODB.SaveToFile strFile, 2
  57. objADODB.Close
  58. Set objADODB = Nothing
  59. Set objFso = Nothing

  61. Call PlaySong(strFile)

  63. Sub PlaySong(strMusic)
  64.         Dim i
  65.         For i = 0 To 2        '播放三次
  66.                 With CreateObject("WMPlayer.ocx")
  67.                         .url = strMusic
  68.                         .controls.play
  69.                         Do Until .playstate = 1
  70.                                 WScript.Sleep 500
  71.                         Loop
  72.                 End With
  73.         Next
  74. End Sub

  76. '不要用我的爱来伤害我.mp3
复制代码
http://pan.baidu.com/share/link?shareid=159314051&uk=1124163200
回复

举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|批处理之家 ( 渝ICP备10000708号 )

GMT+8, 2026-3-17 07:31 , Processed in 0.019390 second(s), 8 queries , File On.

Powered by Discuz! X3.5

© 2001-2026 Discuz! Team.

快速回复 返回顶部 返回列表