把任意格式的文件分解到文本文件中,并且还可以用此脚本进行恢复...
目前把目标文件限制为 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
复制代码
|