バイナリのテキスト変換

こんぴーた

追記（2011/09/29）

ただのBase64変換で良く、使うオブジェクトに制限がなければ、お手軽版があります。
WSHでバイナリー・テキスト相互変換(Base64変換) - じゅんじゅんのきまぐれ


先日、ネットワーク管理者の目をごまかすために、Base64もどきを書いたけど、テーブルを差し替えてしまえば、Base64でも充分分からん、と思ったので、WSHでBase64。

Base64エンコーダ

引数は、

  1. 対象ファイル
  2. 出力ファイル名（Base64ファイル）
  3. 変換テーブル用ファイル（Base64から差し替える場合）
  4. パディング文字（Base64から差し替える場合）
  5. 出力ログ（ログを出力する場合）
Option Explicit

' テキスト→バイナリ
' 任意のファイルを、テキストにBase64変換します。
' 変換テーブルやパディングを変更可能です。（戻す時に同じ設定が必要になります）
' 戻す用のt2f.vbsは、Cr / Lf / (space) は無視しますので、変換文字には使えません
Dim TransTbl, PadChar, sp(5)
TransTbl = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
PadChar = "="
sp(1) = 2
sp(2) = 4
sp(3) = 6
sp(4) = 8
Const Non = 256
Const TblLen = 64
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateUseDefault = -2	' システムデフォルトでファイルを開く
Const TristateTrue = -1			' ファイルをUnicodeファイルとして開く
Const TristateFalse = 0			' ファイルをASCIIファイルとして開く


Dim LogStream
' **********************************************************
' ログ出力
' **********************************************************
Function LogWrite(msg)
	If Not IsNull(LogStream) Then
		LogStream.Write msg
	End If
End Function

' **********************************************************
' 1Byteを二つに分割する
' **********************************************************
Function SplitByte(inData, up, down, split)
	up = Int(inData / (2 ^ split))
	down = inData Mod (2 ^ split)
End Function

' **********************************************************
' encode
' **********************************************************
Function encode(target)
	Dim spBuf(5,2), valid, outBuf, i, ret
	spBuf(0,1) = 0
	spBuf(4,0) = 0
	ret = ""

	' データを取得し、分割する
	valid = 3
	For i = 1 To 3
		' 上位Bit,下位Bitに分解する（取得失敗は、0にする）
		If target(i-1) = Non Then
			spBuf(i,0) = 0
			spBuf(i,1) = 0
		Else
			SplitByte target(i-1), spBuf(i,0), spBuf(i,1), sp(i)
			valid = valid - 1
		End If
		LogWrite CStr(target(i-1)) & "=" & CStr(spBuf(i,0)) & ":" & CStr(spBuf(i,1)) & " "
	Next
	' 出力する
	' ・(1-6Bit)
	' ・(1-2Bit)*(2^4)+(2-4Bit)
	' ・(2-4Bit)*(2^2)+(3-2Bit) or pad
	' ・(3-6Bit) or pad
	For i = 1 To 4
		outBuf = Mid(TransTbl, spBuf(i-1,1) * (2 ^ (8 - sp(i))) + spBuf(i,0) + 1, 1)
		If valid > 3 Then
			outBuf = PadChar
		End If
		ret = ret & outBuf
		LogWrite outBuf
		valid = valid + 1
	Next
	LogWrite Chr(13) & Chr(10)

	encode = ret
End Function



' **********************************************************
' main
' **********************************************************
Function main(target, outFile, table, pad, log)
	Dim fso, InStream, OutStream
	' Stream オブジェクト の作成
	Set fso = CreateObject("Scripting.FileSystemObject")

	' 変換テーブル用文字列を読込む（指定がない場合は、デフォルト）
	If Len(table) > 0 Then
		Set InStream = fso.OpenTextFile(table, ForReading, false, TristateUseDefault)
		TransTbl = InStream.Read(TblLen)
		InStream.Close
		Set InStream = Nothing
	End If
	' パディングが指定されている場合は、それを使う
	If Len(pad) > 0 Then
		PadChar = pad
	End If

	Set InStream = CreateObject("ADODB.Stream")
	InStream.Open
	InStream.Type = 1
	InStream.LoadFromFile target
	Set OutStream = fso.CreateTextFile(outFile, true)
	If Len(log) > 0 Then
		Set LogStream = fso.OpenTextFile(log, ForAppending, true, TristateUseDefault)
	Else
		LogStream = Null
	End If

	' 対象ファイルが終わるまで以下の処理を行う
	Dim inBuf, LoopF, i, buf(3)
	LoopF = 1
	Do While LoopF >= 0 And Not InStream.EOS
		' データを取得し、分割する
		For i = 0 To 2
			' 1Byte取得し、上位Bit,下位Bitに分解する（取得失敗は、0にする）
			If InStream.EOS Then
				LoopF = -2
				buf(i) = Non
			Else
				buf(i) = AscB(InStream.Read(1))
			End If
		Next
		LoopF = LoopF + 1
		' 出力する
		OutStream.Write encode(buf)
		If LoopF > 15 Then
			LoopF = 1
			OutStream.Write Chr(13) & Chr(10)
		End If
	Loop

	InStream.Close
	OutStream.Close
	If Not IsNull(LogStream) Then
		LogStream.Close
	End If
	Set InStream = Nothing
	Set OutStream = Nothing
	Set LogStream = Nothing
End Function


Dim arg(5), i
For i = 0 To 4
	If WScript.Arguments.length > i Then
		arg(i) = Wscript.Arguments(i)
	Else
		arg(i) = ""
	End If
Next
main arg(0), arg(1), arg(2), arg(3), arg(4)
WScript.Echo "Fin!"

Base64デコーダ

引数は、エンコーダと同じ

  1. 対象ファイル（Base64ファイル）
  2. 出力ファイル名
  3. 変換テーブル用ファイル（Base64から差し替える場合）
  4. パディング文字（Base64から差し替える場合）
  5. 出力ログ（ログを出力する場合）


こちら、利用していたクラスの掲載許可を頂きました。
ということで、スクリプト全文を掲載してます。
使っているのは、「Class ByteStream」（元ねたはこちら）
Copyright © 2006-2007 ASANO, Sei All Rights Reserved.
ありがとうございます！

Option Explicit

Const ENCODE_UNICODE = "unicode"

' StreamTypeEnum
Const adTypeBinary = 1
Const adTypeText = 2

'*********************************************************************
' ByteStreamクラス
' version 1.1
'*********************************************************************
Class ByteStream
	Private innerArray(255)
	'=================================================================
	' クラスの初期化処理
	'=================================================================
	Private Sub Class_Initialize()

		Dim wkStream
		Set wkStream = WScript.CreateObject("ADODB.Stream")
		wkStream.Type = adTypeText
		wkStream.Charset = ENCODE_UNICODE
		wkStream.Open

		Dim i
		For i=0 To &hff
			wkStream.WriteText ChrW(i)
		Next
		wkStream.Position = 0
		wkStream.Type = adTypeBinary

		If ("fe" = LCase(Hex(AscB(wkStream.Read(1))))) Then
			wkStream.Position = 2
		End If

		For i=0 To &hff
			wkStream.Position = wkStream.Position + 1
			innerArray(i) = wkStream.Read(1)
		Next

		wkStream.Close
		Set wkStream = Nothing
	End Sub
	'=================================================================
	' 指定した数値のByte()を返す
	'=================================================================
	Public Function getByte(num)
		If (num < 0) Or (UBound(innerArray) < num) Then
			getByte = innerArray(0) '0x00を返す
		Else
			getByte = innerArray(num)
		End If
	End Function
End Class



' テキスト→バイナリ
' f2t.vbsが変換したテキストファイルをバイナリに戻す
' Cr / Lf / (space) は無視しますので、変換文字には使えません
Dim TransTbl, PadChar, SecondTbl, sp(4)
TransTbl = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
SecondTbl = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
PadChar = "="
sp(0) = 6
sp(1) = 4
sp(2) = 2
sp(3) = 0
Const Non = 256
Const TblLen = 64
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateUseDefault = -2	' システムデフォルトでファイルを開く
Const TristateTrue = -1			' ファイルをUnicodeファイルとして開く
Const TristateFalse = 0			' ファイルをASCIIファイルとして開く


Dim LogStream
' **********************************************************
' ログ出力
' **********************************************************
Function LogWrite(msg)
	If Not IsNull(LogStream) Then
		LogStream.Write msg
	End If
End Function

' **********************************************************
' 1Byteを二つに分割する
' **********************************************************
Function SplitByte(inData, up, down, split)
    up = Int(inData / (2 ^ split))
	down = inData Mod (2 ^ split)
End Function

Dim mDecodeIndex, mDecode(4)
mDecodeIndex = 0
' **********************************************************
' decode
' **********************************************************
Function decode(target)
	' 内部バッファに蓄える
	If Asc(target) <> 10 And Asc(target) <> 13 And Asc(target) <> 32 Then
		mDecode(mDecodeIndex) = target
		mDecodeIndex = mDecodeIndex + 1
	End If
	If mDecodeIndex < 4 Then
		decode = Null
		Exit Function
	End If
	mDecodeIndex = 0

	Dim inBuf, spBuf(4,3), i, outBuf, ret(3)
	' 4文字読込み、それぞれを数字にする
	' 上位Bit,下位Bitに分解する
	For i = 0 To 3
		inBuf = mDecode(i)
		LogWrite inBuf
		spBuf(i,0) = Instr(TransTbl, inBuf)
		If IsNull(spBuf(i,0)) Then
			spBuf(i,0) = Instr(SecondTbl, inBuf)
		End If
		If IsNull(spBuf(i,0)) Then
			spBuf(i,1) = 0
			spBuf(i,2) = 0
		Else
			spBuf(i,0) = spBuf(i,0) - 1
			SplitByte spBuf(i,0), spBuf(i,1), spBuf(i,2), sp(i)
		End If
	Next
	For i = 0 To 3
		LogWrite " " & CStr(spBuf(i,0)) & "=" & CStr(spBuf(i,1)) & ":" & CStr(spBuf(i,2))
	Next

	' 合成して出力する
	For i = 0 To 2
		If spBuf(i+1,0) < TblLen Then
			ret(i) = spBuf(i,2) * (2 ^ (8 - sp(i))) + spBuf(i+1,1)
		Else
			ret(i) = Non
		End If
		LogWrite " " & CStr(ret(i))
	Next
	LogWrite Chr(13) & Chr(10)

	decode = ret
End Function



' **********************************************************
' main
' **********************************************************
Function main(target, outFile, table, pad, log)
	Dim fso, InStream, OutStream, bstream
	' Stream オブジェクト の作成
	Set fso = CreateObject("Scripting.FileSystemObject")

	' 変換テーブル用文字列を読込む（指定がない場合は、デフォルト）
	If Len(table) > 0 Then
		Set InStream = fso.OpenTextFile(table, ForReading, false, TristateUseDefault)
		TransTbl = InStream.Read(TblLen)
		InStream.Close
		Set InStream = Nothing
	End If
	' パディングが指定されている場合は、それを使う
	If Len(pad) > 0 Then
		PadChar = pad
	End If
	TransTbl = TransTbl & PadChar
	SecondTbl = SecondTbl & PadChar

	Set InStream = fso.OpenTextFile(target, ForReading, false, TristateUseDefault)
	Set OutStream = CreateObject("ADODB.Stream")
	OutStream.Type = adTypeBinary
	OutStream.Open
	Set bstream = New ByteStream
	If Len(log) > 0 Then
		Set LogStream = fso.OpenTextFile(log, ForAppending, true, TristateUseDefault)
	Else
		LogStream = Null
	End If

	' 対象ファイルが終わるまで以下の処理を行う
	Dim inBuf, buf, i, trans
	Do While (Not InStream.AtEndOfStream)
		' 4文字読込み、それぞれを数字にする
		inBuf = InStream.Read(1)
		' 合成して出力する
		buf = decode(inBuf)
		If Not IsNull(buf) Then
			For i = 0 To 2
				If buf(i) < Non Then
					OutStream.Write bstream.getByte(buf(i))
				End If
			Next
		End If
	Loop

	InStream.Close
	OutStream.SaveToFile outFile, 2
	OutStream.Flush
	OutStream.Close
	If Not IsNull(LogStream) Then
		LogStream.Close
	End If
	Set InStream = Nothing
	Set OutStream = Nothing
	Set bstream = Nothing
	Set LogStream = Nothing
End Function


Dim arg(5), i
For i = 0 To 4
	If WScript.Arguments.length > i Then
		arg(i) = Wscript.Arguments(i)
	Else
		arg(i) = ""
	End If
Next
main arg(0), arg(1), arg(2), arg(3), arg(4)
WScript.Echo "Fin!"


ADODB.Streamを使っているので、OFFにしている場合は、レジストリの変更が必要。
WSHのみで動いているので、HTAでGUIをつけても良い。
Base64自体は、ファイル出力でなく、標準出力でも良かったなぁ。
そのうち改修するかも。