Board logo

标题: [技术讨论] [分享]VBS以TXT备份还原文件 [打印本页]
作者: more    时间: 2011-11-9 23:50     标题: [分享]VBS以TXT备份还原文件

把任意格式的文件分解到文本文件中,并且还可以用此脚本进行恢复...
目前把目标文件限制为 1M 以内,因为大的文件会另保存的文本文件变得很大...
使用方法:把需要处理的文件拖曳到此脚本上就可以了...
  1. Option Explicit

  2. 

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

  4. 

  5. If WScript.Arguments.Count = 0 Then

  6. 	CreateObject("Wscript.Shell").Popup "把文件拖到我身上就行了", 3, "^o^", 0

  7. 	WScript.Quit

  8. End If

  9. 

  10. lngStartTime = Timer

  11. 

  12. strFile = WScript.Arguments(0)

  13. Set objFso = CreateObject("Scripting.FileSystemObject")

  14. 

  15. 

  16. '检查文件名后面部分是否为备份的 TXT 文件

  17. If RM(strFile, "^.+_back\.txt$", True, True) = True Then

  18. 	Set objFile = objFso.OpenTextFile(strFile, 1, False)

  19. 	lngCnt = 0

  20. 	blnNum = False

  21. 	Do Until objFile.AtEndOfStream

  22. 		'检查数值范围是否为0~255(byte)

  23. 		blnNum = RM(objFile.ReadLine, _

  24. 			"^(?:1\d\d|2[0-4]\d|[1-9]\d|25[0-5]|\d)$", True, True)

  25. 		If blnNum = False Then Exit Do

  26. 		lngCnt = lngCnt + 1

  27. 		If lngCnt > 1000 Then Exit Do	'最多只检查前 1000 行数据

  28. 	Loop

  29. 	objFile.Close

  30. 	Set objFile = Nothing

  31. 	

  32. 	If blnNum = False Then

  33. 		set objFso = Nothing

  34. 		MsgBox "文件内容不符合备份文件的格式", vbOKOnly, ":("

  35. 		WScript.Quit

  36. 	End If

  37. 	

  38. 	'如果已经存在原文件则提示是否覆盖

  39. 	If objFso.FileExists(Left(strFile, len(strfile) - 9)) Then

  40. 		If MsgBox("目标文件已经存在,是否覆盖???", vbOKCancel, _

  41. 			"确定:覆盖   取消:退出") = 1 Then

  42. 			lngStartTime = Timer	'重新计时

  43. 			Call Recovery(strFile)

  44. 		End If

  45. 	Else

  46. 		Call Recovery(strFile)

  47. 	End If

  48. Else	'如果不是备份的 TXT 文件

  49. 	If (objFso.GetFile(strFile).Size \ 1024) > 1024 Then

  50. 		'检查文件大小,大的文件处理的时间太长

  51. 		Set objFso = Nothing

  52. 		MsgBox "对不起,目前暂不处理大于 1M 的文件", vbOKOnly, ":("

  53. 		WScript.Quit

  54. 	End if

  55. 	If objFso.FileExists(strFile & "_back.txt") Then

  56. 		'如果存在备份文件则提示是否覆盖

  57. 		If MsgBox("备份文件已经存在,是否覆盖???", vbOKCancel, _

  58. 			"确定:覆盖   取消:退出") = 1 Then

  59. 			lngStartTime = Timer	'重新计时

  60. 			Call Backup(strFile)

  61. 		End If

  62. 	Else

  63. 		Call Backup(strFile)

  64. 	End If

  65. End If

  66. 

  67. Set objFso = Nothing

  68. CreateObject("Wscript.Shell").Popup "耗时:【" & _

  69. 	Round(Timer - lngStartTime, 4) & "】秒", 5, "Done...", 0

  70. 

  71. 

  72. '##############################################################################

  73. Sub Recovery(srcFile)	'把保存为 TXT 的文件恢复为原文件

  74. 	Dim arrBit(), objFso, objFile, objADODB, lngCnt, strTmp, arrChr, i

  75. 	lngCnt = 0

  76. 	

  77. 	Set objFso = CreateObject("Scripting.FileSystemObject")

  78. 	Set objFile = objFso.OpenTextFile(srcFile, 1, False)

  79. 	Set objADODB = CreateObject("ADODB.Stream")

  80. 	Do Until objFile.AtEndOfStream

  81. 		ReDim Preserve arrBit(lngCnt)

  82. 		arrBit(lngCnt) = objFile.ReadLine

  83. 		lngCnt = lngCnt + 1

  84. 	Loop

  85. 	objFile.Close

  86. 	Set objFile = Nothing

  87. 	Set objFso = Nothing

  88. 	

  89. 	lngCnt = lngCnt - 1

  90. 	ReDim arrChr(lngCnt \ 2)

  91. 	For i = 0 To lngCnt - 1 Step 2

  92. 		arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))

  93. 	Next

  94. 	If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))

  95. 	arrChr = Join(arrChr, "")

  96. 	objADODB.Type = 1

  97. 	objADODB.Open

  98. 	With CreateObject("ADODB.Stream")

  99. 		.Type = 2	'adTypeText = 2

  100. 		.Open

  101. 		.Writetext arrChr

  102. 		.Position =  2

  103. 		.Copyto objADODB

  104. 		.Close

  105. 	End With

  106. 	objADODB.SaveToFile Left(srcFile, len(srcfile) - 9), 2

  107. 		'adSaveCreateOverWrite = 2, adSaveCreateNotExist = 1

  108. 	objADODB.Close

  109. 	Set objADODB = Nothing

  110. End Sub

  111. 

  112. 

  113. '##############################################################################

  114. Sub Backup(srcFile)		'把源文件存储为 TXT 文件

  115. 	Dim objADODB, objFso, objFl, i, arrBit(0)

  116. 	Set objADODB = CreateObject("ADODB.Stream")

  117. 	Set objFso = CreateObject("Scripting.FileSystemObject")

  118. 	Set objFl = objFso.OpenTextFile(srcFile & "_Back.txt", 2, True)

  119. 	With objADODB

  120. 		.Open

  121. 		.Type = 1	'adTypeBinary = 1

  122. 		.LoadFromFile srcFile

  123. 		For i = 0 To .Size - 1

  124. 			arrBit(0) = AscB(.Read(1))

  125. 			objFl.WriteLine arrBit(0)

  126. 		Next

  127. 		.Close

  128. 	End With

  129. 	Set objADODB = Nothing

  130. 	objFl.Close

  131. 	Set objFl = Nothing

  132. 	Set objFso = Nothing

  133. End Sub

  134. 

  135. 

  136. '##############################################################################

  137. Function RM(strVar, strPtrn, blnGlb, blnCase)

  138. 	'Regular-expression Match

  139. 	RM = False

  140. 	Dim objReg

  141. 	Set objReg = New RegExp

  142. 	With objReg

  143. 		.Pattern = strPtrn

  144. 		.Global = blnGlb

  145. 		.IgnoreCase = blnCase

  146. 		RM = .Test(strVar)

  147. 	End With

  148. 	Set objReg = Nothing

  149. End Function
复制代码
作者: more    时间: 2011-11-10 00:20

应用: 把GREP.EXE还原到临时文件夹中并用GREP.EXE打印脚本中非注释部分的代码...
由于文件比较大,故只贴出还原的代码,全部代码(包含GREP.EXE的内容)则以附件形式上传...
  1. Option Explicit

  2. 

  3. '把保存为 TXT 的文件恢复为原文件

  4. Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i

  5. Dim blnStart, strTmp

  6. 

  7. blnStart = False

  8. lngCnt = 0

  9. 

  10. Set objFso = CreateObject("Scripting.FileSystemObject")

  11. Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)

  12. Set objADODB = CreateObject("ADODB.Stream")

  13. strFile = objFso.GetSpecialFolder(2) & "\grep.exe"	'文件还原到"临时文件夹"

  14. 

  15. '把文件内容赋值给数组

  16. Do Until objFile.AtEndOfStream

  17. 	If blnStart = True Then

  18. 		ReDim Preserve arrBit(lngCnt)

  19. 		strTmp = objFile.ReadLine

  20. 		arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)

  21. 		lngCnt = lngCnt + 1

  22. 	Else

  23. 		If objFile.ReadLine = "'grep.exe" Then blnStart = True

  24. 	End If

  25. Loop

  26. objFile.Close

  27. Set objFile = Nothing

  28. 

  29. '还原文件

  30. lngCnt = lngCnt - 1

  31. ReDim arrChr(lngCnt \ 2)

  32. For i = 0 To lngCnt - 1 Step 2

  33. 	arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))

  34. Next

  35. If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))

  36. arrChr = Join(arrChr, "")

  37. objADODB.Type = 1

  38. objADODB.Open

  39. With CreateObject("ADODB.Stream")

  40. 	.Type = 2

  41. 	.Open

  42. 	.Writetext arrChr

  43. 	.Position =  2

  44. 	.Copyto objADODB

  45. 	.Close

  46. End With

  47. objADODB.SaveToFile strFile, 2

  48. objADODB.Close

  49. Set objADODB = Nothing

  50. Set objFso = Nothing

  51. 

  52. CreateObject("Wscript.Shell").Run "cmd /c " & strFile & " -P ""^[^']+"" """ & _

  53. 	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. 

  3. '把保存为 TXT 的文件恢复为原文件

  4. Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i

  5. Dim blnStart, strTmp

  6. 

  7. blnStart = False

  8. lngCnt = 0

  9. 

  10. Set objFso = CreateObject("Scripting.FileSystemObject")

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

  12. 

  13. '如果已经存在指定文件(非第一次运行此脚本)则直接调用播放的过程

  14. If objFso.FileExists(strFile) Then

  15. 	Call PlaySong(strFile)

  16. 	Set objFso = Nothing

  17. 	WScript.Quit

  18. End If

  19. 

  20. Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)

  21. Set objADODB = CreateObject("ADODB.Stream")

  22. 

  23. '把文件内容赋值给数组

  24. Do Until objFile.AtEndOfStream

  25. 	If blnStart = True Then

  26. 		ReDim Preserve arrBit(lngCnt)

  27. 		strTmp = objFile.ReadLine

  28. 		arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)

  29. 		lngCnt = lngCnt + 1

  30. 	Else

  31. 		If objFile.ReadLine = "'不要用我的爱来伤害我.mp3" Then blnStart = True

  32. 	End If

  33. Loop

  34. objFile.Close

  35. Set objFile = Nothing

  36. 

  37. '还原文件

  38. lngCnt = lngCnt - 1

  39. ReDim arrChr(lngCnt \ 2)

  40. For i = 0 To lngCnt - 1 Step 2

  41. 	arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))

  42. Next

  43. If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))

  44. arrChr = Join(arrChr, "")

  45. objADODB.Type = 1

  46. objADODB.Open

  47. With CreateObject("ADODB.Stream")

  48. 	.Type = 2

  49. 	.Open

  50. 	.Writetext arrChr

  51. 	.Position =  2

  52. 	.Copyto objADODB

  53. 	.Close

  54. End With

  55. objADODB.SaveToFile strFile, 2

  56. objADODB.Close

  57. Set objADODB = Nothing

  58. Set objFso = Nothing

  59. 

  60. Call PlaySong(strFile)

  61. 

  62. Sub PlaySong(strMusic)

  63. 	Dim i

  64. 	For i = 0 To 2	'播放三次

  65. 		With CreateObject("WMPlayer.ocx")

  66. 			.url = strMusic

  67. 			.controls.play

  68. 			Do Until .playstate = 1

  69. 				WScript.Sleep 500

  70. 			Loop

  71. 		End With

  72. 	Next

  73. End Sub

  74. 

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



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