我贴一个VBS- On Error ReSume Next
- Dim fso, myDir, dstFolder
- Set fso = CreateObject("Scripting.FileSystemObject")
- myDir = fso.GetFile(WSH.ScriptFullName).ParentFolder.Path '脚本自身目录
- dstFolder = myDir & "\Result" '目标目录
- If Not fso.FolderExists(dstFolder) Then fso.CreateFolder(dstFolder) '创建目标目录
-
- Dim objFile
- For Each objFile In fso.GetFolder(myDir).Files
- If LCase(Right(objFile.Name, 4)) = ".txt" Then
- If objFile.Size > 0 Then
- CheckEncoding objFile.Path, dstFolder & "\" & objFile.Name
- End If
- End If
- Next
-
- Function DeleteStr(ByRef str)
- Dim reg, arrIn, n, i, arrOut()
- Set reg = New RegExp
- reg.IgnoreCase = True
- reg.Pattern = "PS[0-9]*:" '删除包含 "PS" + 数字 + ":"的行
- str = Replace(str, vbCrLf, vbLf)
- arrIn = Split(str, vbLf)
- n = 0
- For i = 0 To UBound(arrIn)
- If Not reg.Test(arrIn(i)) Then
- ReDim PreServe arrOut(n)
- arrOut(n) = arrIn(i)
- n = n + 1
- End If
- Next
- DeleteStr = Join(arrOut, vbCrLf)
- End Function
-
- Function ConvertUtf32ToUtf16(srcFile, dstFile, encName)
- Dim xmlDoc, node
- Set xmlDoc = CreateObject("MSXML2.DOMDocument")
- Set node = xmlDoc.CreateElement("binary")
- node.DataType = "bin.hex"
- Dim ado, sz, i, j, arr()
- Set ado = CreateObject("ADODB.Stream")
- ado.Type = 1
- ado.Open
- ado.LoadFromFile srcFile
- sz = ado.Size
- ReDim arr(sz\4)
- Dim h(3)
- For i = 1 To sz Step 4
- For j = 0 To 3
- h(j) = Right("00" & Hex(AscB(ado.Read(1))), 2)
- Next
- If encName = "UTF32LE" Then
- arr(i\4) = h(0) & h(1)
- ElseIf encName = "UTF32BE" Then
- arr(i\4) = h(2) & h(3)
- End If
- Next
- node.Text = Join(arr, "")
- ado.Position = 0
- ado.Write node.NodeTypedValue
- ado.SetEOS()
- ado.SaveToFile dstFile, 2
- ado.Close()
- SaveFileUtf16ToAnsi dstFile, dstFile
- End Function
-
- Function SaveFileUtf16ToAnsi(srcFile, dstFile)
- Dim f, str
- Set f = fso.OpenTextFile(srcFile, 1, True, -1)
- str = DeleteStr(f.ReadAll)
- f.Close
- fso.OpenTextFile(dstFile, 2, True).Write(str)
- End Function
-
- Function SaveFileUtf8ToAnsi(srcFile, dstFile, charset)
- Dim ado, str
- Set ado = CreateObject("ADODB.Stream")
- ado.Type = 2
- ado.CharSet = charset
- ado.Open
- ado.LoadFromFile srcFile
- str = ado.ReadText(-1)
- ado.Position = 0
- ado.CharSet = "GB2312"
- ado.WriteText DeleteStr(str)
- ado.SetEOS
- ado.SaveToFile dstFile, 2
- ado.Close
- End Function
-
- Function SaveFileAnsiToAnsi(srcFile, dstFile)
- Dim f, str
- Set f = fso.OpenTextFile(srcFile, 1, True)
- str = DeleteStr(f.ReadAll)
- f.Close
- fso.OpenTextFile(dstFile, 2, True).Write(str)
- End Function
-
- Function CheckEncoding(srcFile, dstFile)
- Dim ado, i, BOM
- Set ado = CreateObject("ADODB.Stream")
- ado.Type = 1
- ado.Open
- ado.LoadFromFile srcFile
- For i = 0 To 3
- BOM = BOM & Right("00" & Hex(AscB(ado.Read(1))), 2)
- Next
- If BOM = "FFFE0000" Then
- ado.Close
- ConvertUtf32ToUtf16 srcFile, dstFile, "UTF32LE"
- ElseIf BOM = "0000FEFF" Then
- ado.Close
- ConvertUtf32ToUtf16 srcFile, dstFile, "UTF32BE"
- ElseIf Left(BOM, 4) = "FFFE" or Left(BOM, 4) = "FEFF" Then
- ado.Close
- SaveFileUtf16ToAnsi srcFile, dstFile 'UNICODE
- ElseIf Left(BOM, 6) = "EFBBBF" Then
- ado.Close
- SaveFileUtf8ToAnsi srcFile, dstFile, "UTF-8"
- ElseIf Left(BOM, 6) = "2B2F76" Then
- ado.Close
- SaveFileUtf8ToAnsi srcFile, dstFile, "UTF-7"
- Else
- Dim sz, arr()
- ado.Position = 0
- sz = ado.Size
- ReDim arr(sz-1)
- For i = 1 To sz
- arr(i-1) = ChrW(AscB(ado.Read(1)))
- Next
- If isUTF8(arr) Then
- ado.Close
- SaveFileUtf8ToAnsi srcFile, dstFile, "UTF-8"
- Else
- ado.Close
- SaveFileAnsiToAnsi srcFile, dstFile 'ANSI
- End If
- End If
- End Function
-
- Function isUTF8(ByRef arr)
- Dim s, reg
- s = "[\xC0-\xDF](?:[^\x80-\xBF]|$)"
- s = s & "|[\xE0-\xEF].{0,1}(?:[^\x80-\xBF]|$)"
- s = s & "|[\xF0-\xF7].{0,2}(?:[^\x80-\xBF]|$)"
- s = s & "|[\xF8-\xFB].{0,3}(?:[^\x80-\xBF]|$)"
- s = s & "|[\xFC-\xFD].{0,4}(?:[^\x80-\xBF]|$)"
- s = s & "|[\xFE-\xFE].{0,5}(?:[^\x80-\xBF]|$)"
- s = s & "|[\x00-\x7F][\x80-\xBF]"
- s = s & "|[\xC0-\xDF].[\x80-\xBF]"
- s = s & "|[\xE0-\xEF]..[\x80-\xBF]"
- s = s & "|[\xF0-\xF7]...[\x80-\xBF]"
- s = s & "|[\xF8-\xFB]....[\x80-\xBF]"
- s = s & "|[\xFC-\xFD].....[\x80-\xBF]"
- s = s & "|[\xFE-\xFE]......[\x80-\xBF]"
- s = s & "|^[\x80-\xBF]"
- Set reg = New RegExp
- reg.Pattern = s
- isUTF8 = Not reg.Test(Join(arr, ""))
- End Function
-
- MsgBox "Done"
复制代码
|