Board logo

标题: [技术讨论] [分享]VBS以TXT备份还原文件 [打印本页]

作者: more    时间: 2011-11-9 23:50     标题: [分享]VBS以TXT备份还原文件

把任意格式的文件分解到文本文件中,并且还可以用此脚本进行恢复...
目前把目标文件限制为 1M 以内,因为大的文件会另保存的文本文件变得很大...
使用方法:把需要处理的文件拖曳到此脚本上就可以了...
  1. Option Explicit
  2. Dim blnNum, objFso, objFile, strFile, lngCnt, lngStartTime
  3. If WScript.Arguments.Count = 0 Then
  4. CreateObject("Wscript.Shell").Popup "把文件拖到我身上就行了", 3, "^o^", 0
  5. WScript.Quit
  6. End If
  7. lngStartTime = Timer
  8. strFile = WScript.Arguments(0)
  9. Set objFso = CreateObject("Scripting.FileSystemObject")
  10. '检查文件名后面部分是否为备份的 TXT 文件
  11. If RM(strFile, "^.+_back\.txt$", True, True) = True Then
  12. Set objFile = objFso.OpenTextFile(strFile, 1, False)
  13. lngCnt = 0
  14. blnNum = False
  15. Do Until objFile.AtEndOfStream
  16. '检查数值范围是否为0~255(byte)
  17. blnNum = RM(objFile.ReadLine, _
  18. "^(?:1\d\d|2[0-4]\d|[1-9]\d|25[0-5]|\d)$", True, True)
  19. If blnNum = False Then Exit Do
  20. lngCnt = lngCnt + 1
  21. If lngCnt > 1000 Then Exit Do '最多只检查前 1000 行数据
  22. Loop
  23. objFile.Close
  24. Set objFile = Nothing
  25. If blnNum = False Then
  26. set objFso = Nothing
  27. MsgBox "文件内容不符合备份文件的格式", vbOKOnly, ":("
  28. WScript.Quit
  29. End If
  30. '如果已经存在原文件则提示是否覆盖
  31. If objFso.FileExists(Left(strFile, len(strfile) - 9)) Then
  32. If MsgBox("目标文件已经存在,是否覆盖???", vbOKCancel, _
  33. "确定:覆盖   取消:退出") = 1 Then
  34. lngStartTime = Timer '重新计时
  35. Call Recovery(strFile)
  36. End If
  37. Else
  38. Call Recovery(strFile)
  39. End If
  40. Else '如果不是备份的 TXT 文件
  41. If (objFso.GetFile(strFile).Size \ 1024) > 1024 Then
  42. '检查文件大小,大的文件处理的时间太长
  43. Set objFso = Nothing
  44. MsgBox "对不起,目前暂不处理大于 1M 的文件", vbOKOnly, ":("
  45. WScript.Quit
  46. End if
  47. If objFso.FileExists(strFile & "_back.txt") Then
  48. '如果存在备份文件则提示是否覆盖
  49. If MsgBox("备份文件已经存在,是否覆盖???", vbOKCancel, _
  50. "确定:覆盖   取消:退出") = 1 Then
  51. lngStartTime = Timer '重新计时
  52. Call Backup(strFile)
  53. End If
  54. Else
  55. Call Backup(strFile)
  56. End If
  57. End If
  58. Set objFso = Nothing
  59. CreateObject("Wscript.Shell").Popup "耗时:【" & _
  60. Round(Timer - lngStartTime, 4) & "】秒", 5, "Done...", 0
  61. '##############################################################################
  62. Sub Recovery(srcFile) '把保存为 TXT 的文件恢复为原文件
  63. Dim arrBit(), objFso, objFile, objADODB, lngCnt, strTmp, arrChr, i
  64. lngCnt = 0
  65. Set objFso = CreateObject("Scripting.FileSystemObject")
  66. Set objFile = objFso.OpenTextFile(srcFile, 1, False)
  67. Set objADODB = CreateObject("ADODB.Stream")
  68. Do Until objFile.AtEndOfStream
  69. ReDim Preserve arrBit(lngCnt)
  70. arrBit(lngCnt) = objFile.ReadLine
  71. lngCnt = lngCnt + 1
  72. Loop
  73. objFile.Close
  74. Set objFile = Nothing
  75. Set objFso = Nothing
  76. lngCnt = lngCnt - 1
  77. ReDim arrChr(lngCnt \ 2)
  78. For i = 0 To lngCnt - 1 Step 2
  79. arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))
  80. Next
  81. If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))
  82. arrChr = Join(arrChr, "")
  83. objADODB.Type = 1
  84. objADODB.Open
  85. With CreateObject("ADODB.Stream")
  86. .Type = 2 'adTypeText = 2
  87. .Open
  88. .Writetext arrChr
  89. .Position =  2
  90. .Copyto objADODB
  91. .Close
  92. End With
  93. objADODB.SaveToFile Left(srcFile, len(srcfile) - 9), 2
  94. 'adSaveCreateOverWrite = 2, adSaveCreateNotExist = 1
  95. objADODB.Close
  96. Set objADODB = Nothing
  97. End Sub
  98. '##############################################################################
  99. Sub Backup(srcFile) '把源文件存储为 TXT 文件
  100. Dim objADODB, objFso, objFl, i, arrBit(0)
  101. Set objADODB = CreateObject("ADODB.Stream")
  102. Set objFso = CreateObject("Scripting.FileSystemObject")
  103. Set objFl = objFso.OpenTextFile(srcFile & "_Back.txt", 2, True)
  104. With objADODB
  105. .Open
  106. .Type = 1 'adTypeBinary = 1
  107. .LoadFromFile srcFile
  108. For i = 0 To .Size - 1
  109. arrBit(0) = AscB(.Read(1))
  110. objFl.WriteLine arrBit(0)
  111. Next
  112. .Close
  113. End With
  114. Set objADODB = Nothing
  115. objFl.Close
  116. Set objFl = Nothing
  117. Set objFso = Nothing
  118. End Sub
  119. '##############################################################################
  120. Function RM(strVar, strPtrn, blnGlb, blnCase)
  121. 'Regular-expression Match
  122. RM = False
  123. Dim objReg
  124. Set objReg = New RegExp
  125. With objReg
  126. .Pattern = strPtrn
  127. .Global = blnGlb
  128. .IgnoreCase = blnCase
  129. RM = .Test(strVar)
  130. End With
  131. Set objReg = Nothing
  132. End Function
复制代码

作者: more    时间: 2011-11-10 00:20

应用: 把GREP.EXE还原到临时文件夹中并用GREP.EXE打印脚本中非注释部分的代码...
由于文件比较大,故只贴出还原的代码,全部代码(包含GREP.EXE的内容)则以附件形式上传...
  1. Option Explicit
  2. '把保存为 TXT 的文件恢复为原文件
  3. Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i
  4. Dim blnStart, strTmp
  5. blnStart = False
  6. lngCnt = 0
  7. Set objFso = CreateObject("Scripting.FileSystemObject")
  8. Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)
  9. Set objADODB = CreateObject("ADODB.Stream")
  10. strFile = objFso.GetSpecialFolder(2) & "\grep.exe" '文件还原到"临时文件夹"
  11. '把文件内容赋值给数组
  12. Do Until objFile.AtEndOfStream
  13. If blnStart = True Then
  14. ReDim Preserve arrBit(lngCnt)
  15. strTmp = objFile.ReadLine
  16. arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)
  17. lngCnt = lngCnt + 1
  18. Else
  19. If objFile.ReadLine = "'grep.exe" Then blnStart = True
  20. End If
  21. Loop
  22. objFile.Close
  23. Set objFile = Nothing
  24. '还原文件
  25. lngCnt = lngCnt - 1
  26. ReDim arrChr(lngCnt \ 2)
  27. For i = 0 To lngCnt - 1 Step 2
  28. arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))
  29. Next
  30. If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))
  31. arrChr = Join(arrChr, "")
  32. objADODB.Type = 1
  33. objADODB.Open
  34. With CreateObject("ADODB.Stream")
  35. .Type = 2
  36. .Open
  37. .Writetext arrChr
  38. .Position =  2
  39. .Copyto objADODB
  40. .Close
  41. End With
  42. objADODB.SaveToFile strFile, 2
  43. objADODB.Close
  44. Set objADODB = Nothing
  45. Set objFso = Nothing
  46. CreateObject("Wscript.Shell").Run "cmd /c " & strFile & " -P ""^[^']+"" """ & _
  47. 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铃声的代码...
  1. Option Explicit
  2. '把保存为 TXT 的文件恢复为原文件
  3. Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i
  4. Dim blnStart, strTmp
  5. blnStart = False
  6. lngCnt = 0
  7. Set objFso = CreateObject("Scripting.FileSystemObject")
  8. strFile = objFso.GetSpecialFolder(2) & "\不要用我的爱来伤害我.mp3" '文件还原到"临时文件夹"
  9. '如果已经存在指定文件(非第一次运行此脚本)则直接调用播放的过程
  10. If objFso.FileExists(strFile) Then
  11. Call PlaySong(strFile)
  12. Set objFso = Nothing
  13. WScript.Quit
  14. End If
  15. Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)
  16. Set objADODB = CreateObject("ADODB.Stream")
  17. '把文件内容赋值给数组
  18. Do Until objFile.AtEndOfStream
  19. If blnStart = True Then
  20. ReDim Preserve arrBit(lngCnt)
  21. strTmp = objFile.ReadLine
  22. arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)
  23. lngCnt = lngCnt + 1
  24. Else
  25. If objFile.ReadLine = "'不要用我的爱来伤害我.mp3" Then blnStart = True
  26. End If
  27. Loop
  28. objFile.Close
  29. 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
  52. Call PlaySong(strFile)
  53. Sub PlaySong(strMusic)
  54. Dim i
  55. For i = 0 To 2 '播放三次
  56. With CreateObject("WMPlayer.ocx")
  57. .url = strMusic
  58. .controls.play
  59. Do Until .playstate = 1
  60. WScript.Sleep 500
  61. Loop
  62. End With
  63. Next
  64. End Sub
  65. '不要用我的爱来伤害我.mp3
复制代码
http://pan.baidu.com/share/link?shareid=159314051&uk=1124163200




欢迎光临 批处理之家 (http://bathome.net./) Powered by Discuz! 7.2