軟體 - 內碼批量轉換小工具 For 2k/XP(GBK、UNICODE、UTF-16、UTF-8等)

[psac]

論壇裡看到有人求可以批量轉換編碼的工具，正好自己以前寫過一個VBS腳本，拿出來分享一下，希望對大家有幫助。

下面簡單介紹一下：
1. 可以將文本文件在眾多編碼之間進行轉換。比如，把GB2312編碼的轉成UNICODE的。並且支持批量轉換。
2. 只能在2k/XP/2k3下執行，但是不受系統語言限制，只要你的IE可以正常看這個編碼，就可以轉。比如你用的是英文版XP，要想在GBK和UNICODE之間轉換也沒問題。
3. 在GB和BIG5之間轉換時，必須是繁體中文，否則，轉換後會出現字元丟失。
原理很簡單，是利用操作系統自帶的ADODB.Stream對像來完成編碼轉換的。所以，相容性應該也很好吧。

==========================================================
'
' NAME: 編碼轉換小工具.vbs
'

'
' COMMENT: 1. 可以將文本文件在眾多編碼之間進行轉換。比如，把GB2312編碼的
' 轉成UTF-8的。並且支持批量轉換。
' 2. 在GB和BIG5之間轉換時，必須是繁體中文，否則，轉換後會出現字
' 符丟失。
'
'=========================================================

Option Explicit

Dim ret, CFS, CharSet_Read, CharSet_Write, objArgs, CharSets

Const Caption="編碼轉換小工具"
CharSets = vbcrlf & "BIG5" & vbcrlf & "GB2312" & vbcrlf & "GBK" & vbcrlf & "HZ-GB-2312" & vbcrlf & _
"UNICODE" & vbcrlf & "UTF-16" & vbcrlf & "UTF-8"

Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then
ret = MsgBox("請把需要轉換的文本文件拖上來 ",16,Caption)
WScript.Quit (1)
Else
CharSet_Read = InputBox( "請輸入剛才文件所用的編碼：" & vbcrlf & "（不區分大小寫）" & vbcrlf & vbcrlf & _
"例如： " & CharSets, "第一步：", "GB2312")
If CharSet_Read <> "" Then
CharSet_Write = InputBox( "請輸入文件所需的新編碼：" & vbcrlf & "（不區分大小寫）" & vbcrlf & vbcrlf & _
"例如： " & CharSets, "第二步：", "UNICODE")
If CharSet_Write <> "" Then
CFS = ConvertTextFile '調用轉換文件的子函數
ret = MsgBox("成功轉換了" & CFS & "個文件 ",64,"結束")
Else
WScript.Quit (2)
End If
Else
WScript.Quit (2)
End If
End If


'**********************************************************
'
' 根據CharSet，利用ADODB.Stream讀取文本文件
'
'**********************************************************
Function ReadFromTextFile(TextFile, CharSet)
Dim objStream, ret
Set objStream = CreateObject("ADODB.Stream")
With objStream
' .Type = 2 '以文本模式
' .Mode = 3
.Charset = CharSet
.Open
.Loadfromfile TextFile
ret = .ReadText
.Close
End With
ReadFromTextFile=ret
Set objStream = Nothing
End Function


'**********************************************************
'
' 根據CharSet，利用ADODB.Stream寫入文本文件
'
'**********************************************************
Sub WriteToTextFile(Text, TextFile, CharSet)
Const adSaveCreateOverWrite = 2
Dim objStream, ret
Set objStream = CreateObject("ADODB.Stream")
With objStream
' .Type = 2 '以文本模式
' .Mode = 3
.Charset = CharSet
.Open
.WriteText(Text)
.SaveToFile TextFile,adSaveCreateOverWrite '覆蓋模式
.Close
End With
Set objStream = Nothing
End Sub


Function ConvertTextFile 'ConvertTextFile函數返回總共轉換了幾個文件
Dim FSO, i, InFile, OutFile, OutPath
Set FSO = CreateObject("Scripting.FileSystemObject")
OutPath = FSO.GetParentFolderName(objArgs(0)) & "\Converted"
If Not FSO.FolderExists(OutPath) Then FSO.CreateFolder(OutPath) '如果當前目錄沒有「Converted」資料夾，則新增一個。
For i = 0 to objArgs.Count - 1
InFile = objArgs(i)
OutFile = OutPath & "\" & FSO.GetFileName(InFile)
WriteToTextFile ReadFromTextFile(InFile, CharSet_Read), OutFile, CharSet_Write '轉換的關鍵語句
ConvertTextFile = i+1 '一共轉換了i+1個文件
Next
End Function