UTF-8 の BOM を削除する VBScript を書いてみた。

UTF-8 BOM削除にはまったので書いた。
ライセンスは CC0 なのでお好きにご利用ください。
gist >> https://gist.github.com/1611826

Option Explicit
' ==================================================================================
' UTF-8 のファイルのBOMを削除するVBScript
' ファイルをドラッグ&ドロップして利用する。
' 2012/01/14 Nakamura, Tomohiro
' This Software is under CC0
' ADODB の為、要Excel
' ==================================================================================

Dim adTypeBinary, adTypeText, adSaveCreateOverWrite   
adTypeBinary = 1
adTypeText = 2
adSaveCreateOverWrite = 2

Sub Main
	Dim msg, filePath
	If (WScript.Arguments.Count = 0) Then
		msg = "ファイルをドラッグ&ドロップしてください。"
	Else
		filePath = WScript.Arguments(0)
		DeleteUTF8Bom filePath
		msg = "下記のファイルについて UTF-8 BOM有りの場合は削除しました。" & vbCrLf _
		    & """" & filePath & """" 
	End If
	MsgBox msg
End Sub

' UTF-8 のファイルについて BOM の削除をする
Sub DeleteUTF8Bom(filePath)
	Dim inputFile, tmp, data, outputFile

	If CheckBom(filePath) Then
		Set inputFile = WScript.CreateObject("ADODB.Stream") 
		inputFile.Type = adTypeBinary
		inputFile.Open
		inputFile.LoadFromFile filePath
		inputFile.Position = 3
		data = inputFile.Read(-1)
		inputFile.Close

		Set outputFile = WScript.CreateObject("ADODB.Stream") 
		outputFile.Type = adTypeBinary
		outputFile.Open
		outputFile.Write data
		outputFile.SaveToFile filePath, adSaveCreateOverWrite
		outputFile.Close
	End If
End Sub

' UTF-8 のファイルについて BOM 有/無の判定をする
Function CheckBom(filePath)
	Dim inputFile, data, bin
	bin = vbNullString

	Set inputFile = WScript.CreateObject("ADODB.Stream") 
	inputFile.Type = adTypeBinary
	inputFile.Open
	inputFile.LoadFromFile filePath
	inputFile.Position = 0
	If inputFile.Size > 2 Then
		data = inputFile.Read(3)
		bin = Hex(AscB(MidB(data, 1, 1))) _
			& Hex(AscB(MidB(data, 2, 1))) _
			& Hex(AscB(MidB(data, 3, 1)))
	End If
	inputFile.Close

	CheckBom = (bin = "EFBBBF")
End Function

Main