UTF8 エンコーディングのテキストファイルを ANSI エンコーディングに変換する方法を探しています。
Visual Basic (VB6) や vbscript でこれを実現するにはどうすればよいですか?
ファイルがそれほど大きくない場合 (たとえば、40MB だけでも非常に遅くなる場合があります)、VB6、VBA、または VBScript で次のコードを使用してこれを行うことができます。
Option Explicit
Private Const adReadAll = -1
Private Const adSaveCreateOverWrite = 2
Private Const adTypeBinary = 1
Private Const adTypeText = 2
Private Const adWriteChar = 0
Private Sub UTF8toANSI(ByVal UTF8FName, ByVal ANSIFName)
Dim strText
With CreateObject("ADODB.Stream")
.Open
.Type = adTypeBinary
.LoadFromFile UTF8FName
.Type = adTypeText
.Charset = "utf-8"
strText = .ReadText(adReadAll)
.Position = 0
.SetEOS
.Charset = "_autodetect" 'Use current ANSI codepage.
.WriteText strText, adWriteChar
.SaveToFile ANSIFName, adSaveCreateOverWrite
.Close
End With
End Sub
UTF8toANSI "UTF8-wBOM.txt", "ANSI1.txt"
UTF8toANSI "UTF8-noBOM.txt", "ANSI2.txt"
MsgBox "Complete!", vbOKOnly, WScript.ScriptName
BOM の有無にかかわらず、UTF-8 入力ファイルを処理することに注意してください。
強力な型指定と早期バインディングを使用すると、VB6 でパフォーマンスが大幅に向上し、それらの Const 値を宣言する必要がなくなります。ただし、これはスクリプトのオプションではありません。
非常に大きなファイルを処理する必要がある VB6 プログラムの場合、バイト配列に対して VB6 ネイティブ I/O を使用し、API 呼び出しを使用してデータをチャンクに変換する方がよい場合があります。ただし、これにより、文字境界を見つけるのがさらに面倒になります (UTF-8 では、文字ごとに可変バイト数が使用されます)。API 変換の安全な終点を見つけるには、読み取った各データ ブロックをスキャンする必要があります。
MultiByteToWideChar() と WideCharToMultiByte() を見て始めましょう。
UTF-8 は、CRLF の代わりに LF 行区切り文字で「到着」することが多いことに注意してください。
このスクリプトを使用して、(認識している) 文字セットまたはコード ページを変換しています。
このスクリプトは、一度に 1 行ずつストリーミングするため、大きなファイル(1 ギガバイト以上) も処理できます。
' - ConvertCharset.vbs -
'
' Inspired by:
' http://www.vbforums.com/showthread.php?533879-Generate-text-files-in-IBM-850-encoding
' http://stackoverflow.com/questions/5182102/vb6-vbscript-change-file-encoding-to-ansii/5186170#5186170
' http://stackoverflow.com/questions/13130214/how-to-convert-a-batch-file-stored-in-utf-8-to-something-that-works-via-another
'
' Start Main
Dim objArguments
Dim strSyntaxtext, strInputCharset, strOutputCharset, strInputFile, strOutputFile
Dim intReadPosition, intWritePosition
Dim arrCharsets
Const adReadAll = -1
Const adReadLine = -2
Const adSaveCreateOverWrite = 2
Const adSaveCreateNotExist = 1
Const adTypeBinary = 1
Const adTypeText = 2
Const adWriteChar = 0
Const adWriteLine = 1
strSyntaxtext = strSyntaxtext & "Converts the charset of the input text file to output file." & vbCrLf
strSyntaxtext = strSyntaxtext & "Syntax: " & vbCrLf
strSyntaxtext = strSyntaxtext & WScript.ScriptName & " /InputCharset:utf-8|windows-1252|ibm850|..." & vbCrLf
strSyntaxtext = strSyntaxtext & " /OutputCharset:utf-8|windows-1252|ibm850|..." & vbCrLf
strSyntaxtext = strSyntaxtext & " /InputFile:\\path\to\inputfile.ext" & vbCrLf
strSyntaxtext = strSyntaxtext & " /OutputFile:\\path\to\outputfile.ext" & vbCrLf
strSyntaxtext = strSyntaxtext & " [/ShowAllCharSets]" & vbCrLf & vbCrLf
strSyntaxtext = strSyntaxtext & "Example:" & vbCrLf
strSyntaxtext = strSyntaxtext & WScript.ScriptName & " /InputCharset:ibm850 /OutputCharset:utf-8 /InputFile:my_dos.txt /OutputFile:my_utf-8.txt" & vbCrLf
Set objArgumentsNamed = WScript.Arguments.Named
If objArgumentsNamed.Count = 0 Then
WScript.Echo strSyntaxtext
WScript.Quit(99)
End If
arrCharsets = Split("big5,big5-hkscs,euc-jp,euc-kr,gb18030,gb2312,gbk,ibm-thai," &_
"ibm00858,ibm01140,ibm01141,ibm01142,ibm01143,ibm01144," &_
"ibm01145,ibm01146,ibm01147,ibm01148,ibm01149,ibm037," &_
"ibm1026,ibm273,ibm277,ibm278,ibm280,ibm284,ibm285,ibm297," &_
"ibm420,ibm424,ibm437,ibm500,ibm775,ibm850,ibm852,ibm855," &_
"ibm857,ibm860,ibm861,ibm862,ibm863,ibm864,ibm865,ibm866," &_
"ibm869,ibm870,ibm871,iso-2022-jp,iso-2022-kr,iso-8859-1," &_
"iso-8859-13,iso-8859-15,iso-8859-2,iso-8859-3,iso-8859-4," &_
"iso-8859-5,iso-8859-6,iso-8859-7,iso-8859-8,iso-8859-9," &_
"koi8-r,koi8-u,shift_jis,tis-620,us-ascii,utf-16,utf-16be," &_
"utf-16le,utf-7,utf-8,windows-1250,windows-1251,windows-1252," &_
"windows-1253,windows-1254,windows-1255,windows-1256," &_
"windows-1257,windows-1258,unicode", ",")
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
For Each objArgumentNamed in objArgumentsNamed
Select Case Lcase(objArgumentNamed)
Case "inputcharset"
strInputCharset = LCase(objArgumentsNamed(objArgumentNamed))
If Not IsCharset(strInputCharset) Then
WScript.Echo "The InputCharset (" & strInputCharset & ") is not valid, quitting. The valid charsets are:" & vbCrLf
x = ShowCharsets()
WScript.Quit(1)
End If
Case "outputcharset"
strOutputCharset = LCase(objArgumentsNamed(objArgumentNamed))
If Not IsCharset(strOutputCharset) Then
WScript.Echo "The strOutputCharset (" & strOutputCharset & ") is not valid, quitting. The valid charsets are:" & vbCrLf
x = ShowCharsets()
WScript.Quit(2)
End If
Case "inputfile"
strInputFile = LCase(objArgumentsNamed(objArgumentNamed))
If Not objFileSystem.FileExists(strInputFile) Then
WScript.Echo "The InputFile (" & strInputFile & ") does not exist, quitting." & vbCrLf
WScript.Quit(3)
End If
Case "outputfile"
strOutputFile = LCase(objArgumentsNamed(objArgumentNamed))
If objFileSystem.FileExists(strOutputFile) Then
WScript.Echo "The OutputFile (" & strOutputFile & ") exists, quitting." & vbCrLf
WScript.Quit(4)
End If
Case "showallcharsets"
x = ShowCharsets()
Case Else
WScript.Echo "Unknown parameter, quitting: /" & objArgumentNamed & ":" & objArgumentsNamed(objArgumentNamed)
WScript.Echo strSyntaxtext
End Select
Next
If Len(strInputCharset) > 0 And Len(strOutputCharset) > 0 And Len(strInputFile) > 0 And Len(strOutputFile) Then
Set objInputStream = CreateObject("ADODB.Stream")
Set objOutputStream = CreateObject("ADODB.Stream")
With objInputStream
.Open
.Type = adTypeBinary
.LoadFromFile strInputFile
.Type = adTypeText
.Charset = strInputCharset
intWritePosition = 0
objOutputStream.Open
objOutputStream.Charset = strOutputCharset
Do While .EOS <> True
strText = .ReadText(adReadLine)
objOutputStream.WriteText strText, adWriteLine
Loop
.Close
End With
objOutputStream.SaveToFile strOutputFile , adSaveCreateNotExist
objOutputStream.Close
WScript.Echo "The " & objFileSystem.GetFileName(strInputFile) & " was converted to " & objFileSystem.GetFileName(strOutputFile) & " OK."
End If
' End Main
' Start Functions
Function IsCharset(strMyCharset)
IsCharset = False
For Each strCharset in arrCharsets
If strCharset = strMyCharset Then
IsCharset = True
Exit For
End If
Next
End Function
Function ShowCharsets()
strDisplayCharsets = ""
intCounter = 0
For Each strcharset in arrCharsets
intCounter = intCounter + Len(strcharset) + 1
strDisplayCharsets = strDisplayCharsets & strcharset & ","
If intCounter > 67 Then
intCounter = 0
strDisplayCharsets = strDisplayCharsets & vbCrLf
End If
Next
strDisplayCharsets = Mid(strDisplayCharsets, 1, Len(strDisplayCharsets)-1)
WScript.Echo strDisplayCharsets
End Function
' End Functions
これらのヘルパー関数を使用しています
Private Function pvReadFile(sFile)
Const ForReading = 1
Dim sPrefix
With CreateObject("Scripting.FileSystemObject")
sPrefix = .OpenTextFile(sFile, ForReading, False, False).Read(3)
End With
If Left(sPrefix, 3) <> Chr(&HEF) & Chr(&HBB) & Chr(&HBF) Then
With CreateObject("Scripting.FileSystemObject")
pvReadFile = .OpenTextFile(sFile, ForReading, False, Left(sPrefix, 2) = Chr(&HFF) & Chr(&HFE)).ReadAll()
End With
Else
With CreateObject("ADODB.Stream")
.Open
If Left(sPrefix, 2) = Chr(&HFF) & Chr(&HFE) Then
.Charset = "Unicode"
ElseIf Left(sPrefix, 3) = Chr(&HEF) & Chr(&HBB) & Chr(&HBF) Then
.Charset = "UTF-8"
Else
.Charset = "_autodetect"
End If
.LoadFromFile sFile
pvReadFile = .ReadText
End With
End If
End Function
Private Function pvWriteFile(sFile, sText, lType)
Const adSaveCreateOverWrite = 2
With CreateObject("ADODB.Stream")
.Open
If lType = 2 Then
.Charset = "Unicode"
ElseIf lType = 3 Then
.Charset = "UTF-8"
Else
.Charset = "_autodetect"
End If
.WriteText sText
.SaveToFile sFile, adSaveCreateOverWrite
End With
End Function
ANSI および UTF-16/UCS-2 ファイルの "ネイティブ" FileSystemObject 読み取りは、ADODB.Stream ハックよりもはるかに高速であることがわかりました。
@ Bob77の答えはうまくいかなかったので、@ Cioveの答えを単純なサブルーチンに変換しましたが、うまくいきました。
' Usage:
' EncodeFile strInFile, "UTF-8", strOutFile, "Windows-1254", 2
Sub EncodeFile(strInputFile, strInputCharset, strOutputFile, strOutputCharset, intOverwriteMode)
'5th parameter may take the following values:
'Const adSaveCreateOverWrite = 2
'Const adSaveCreateNotExist = 1
Const adReadLine = -2
Const adTypeBinary = 1
Const adTypeText = 2
Const adWriteLine = 1
Set objInputStream = CreateObject("ADODB.Stream")
Set objOutputStream = CreateObject("ADODB.Stream")
With objInputStream
.Open
.Type = adTypeBinary
.LoadFromFile strInputFile
.Type = adTypeText
.Charset = strInputCharset
objOutputStream.Open
objOutputStream.Charset = strOutputCharset
Do While .EOS <> True
strText = .ReadText(adReadLine)
objOutputStream.WriteText strText, adWriteLine
Loop
.Close
End With
objOutputStream.SaveToFile strOutputFile, intOverwriteMode
objOutputStream.Close
End Sub