インターネットの制限された環境で

こんぴーた

追記（2011/09/29）

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


制限された環境で、テキストベースでバイナリデータをやりとりする。
そういう需要があるかもしれない。
Base64エンコードが最も適任と思われるが、Well knownなため、
解析されるかもしれない。
ということで、適当に作ってみた。
Linux環境なら、いろいろとやりようもあるので、Windows用。

バイナリファイルをテキスト変換

基本思想は、Base64と同じ。

Option Explicit

Dim TransTbl
TransTbl = "yAw2B!uCsDq8EoFmGkHi#IgJ17eKcLa^MbN94dOf%PhQjR3lS6nTpU0r$VtWvXxY5zZ"
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




' **********************************************************
' main
' **********************************************************
Function main(target, outFile, table, 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(2 ^ 6)
		InStream.Close
		Set InStream = Nothing
    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, spBuf(2,2), valid, outBuf, LoopF
    LoopF = 1
    Do While LoopF >= 0
        ' 1Byte取得し、上位4Bit,下位4Bitに分解する
        If InStream.EOS Then
            LoopF = -1
            Exit Do
        Else
            inBuf = AscB(InStream.Read(1))
            SplitByte inBuf, spBuf(0,0), spBuf(0,1), 4
        End If
        LogWrite CStr(inBuf) & "=" & CStr(spBuf(0,0)) & ":" & CStr(spBuf(0,1)) & " "
        ' 1Byte取得し、上位2Bit,下位6Bitに分解する（取得失敗は、0にする）
        ' 二文字取得では、3。1文字では2を保持する
        If InStream.EOS Then
            LoopF = -1
            spBuf(1,0) = 0
            spBuf(1,1) = 0
            valid = 2
        Else
            inBuf = AscB(InStream.Read(1))
            SplitByte inBuf, spBuf(1,0), spBuf(1,1), 6
            valid = 3
            LoopF = LoopF + 1
        End If
        LogWrite CStr(inBuf) & "=" & CStr(spBuf(0,0)) & ":" & CStr(spBuf(0,1)) & " " & CStr(valid) & " "
        ' 以下の三文字を出力する
        ' ・保持数*(2^4)+上位4Bit
        ' ・上位2Bit*(2^4)+下位4Bit
        ' ・下位6Bit
        outBuf = Mid(TransTbl, valid * (2 ^ 4) + spBuf(0,0) + 1, 1)
        OutStream.Write outBuf
        LogWrite outBuf
        outBuf = Mid(TransTbl, spBuf(1,0) * (2 ^ 4) + spBuf(0,1) + 1, 1)
        OutStream.Write outBuf
        LogWrite outBuf
        outBuf = Mid(TransTbl, spBuf(1,1) + 1, 1)
        OutStream.Write outBuf
        LogWrite outBuf
        If LoopF > 20 Then
            LoopF = 1
            OutStream.Write Chr(13) & Chr(10)
        End If
        LogWrite Chr(13) & Chr(10)
    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 target, outFile, table, log
If WScript.Arguments.length > 1 Then
    target = WScript.Arguments(0)
    outFile = WScript.Arguments(1)
    If WScript.Arguments.length > 2 Then
        table = Wscript.Arguments(2)
        If WScript.Arguments.length > 3 Then
            log = Wscript.Arguments(3)
        Else
            log = ""
        End If
    Else
        table = ""
    End If
End If
main target, outFile, table, log
WScript.Echo "Fin!"

続いて、できたテキストをバイナリに戻す

ASANO, Sei (Runrun)さんの、バイナリデータを生成するクラスに依存しています。
掲載の許可を頂いていないので、リンクまで。
ADODB.Streamに書き込めるバイナリデータを生成するクラス


リンク先にある「Class ByteStream」と一緒に、以下のコードを加えれば、OK。

Dim TransTbl
TransTbl = "yAw2B!uCsDq8EoFmGkHi#IgJ17eKcLa^MbN94dOf%PhQjR3lS6nTpU0r$VtWvXxY5zZ"
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




' **********************************************************
' main
' **********************************************************
Function main(target, outFile, table, 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(2 ^ 6)
		InStream.Close
		Set InStream = Nothing
    End If

    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, spBuf(3,3), i, outBuf
    Do While (Not InStream.AtEndOfStream)
        ' 3文字読込み、それぞれを数字にする
        ' 上位4Bit,下位4Bitに分解する
        i = 1
        Do While (i <= 3) And (Not InStream.AtEndOfStream)
            inBuf = InStream.Read(1)
            If Asc(inBuf) <> 10 And Asc(inBuf) <> 13 And Asc(inBuf) <> 32 Then
				LogWrite inBuf
                spBuf(i,0) = Instr(TransTbl, inBuf) - 1
                SplitByte spBuf(i,0), spBuf(i,1), spBuf(i,2), 4
                i = i + 1
            End If
        Loop
        If i < 4 Then
            Exit Do
        End If
		For i = 1 To 3
			LogWrite " " & CStr(spBuf(i,0)) & "=" & CStr(spBuf(i,1)) & ":" & CStr(spBuf(i,2))
		Next
        ' 合成して出力する
		outBuf = (spBuf(1,2) * (2 ^ 4) + spBuf(2,2))
		OutStream.Write bstream.getByte(outBuf)
		LogWrite " " & CStr(outBuf)
        ' 2Byte目もあるなら出力する
        If spBuf(1,1) > 2 Then
			outBuf = (spBuf(2,1) * (2 ^ 6) + spBuf(3,0))
			OutStream.Write bstream.getByte(outBuf)
			LogWrite " " & CStr(outBuf)
        End If
		LogWrite Chr(13) & Chr(10)
    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 target, outFile, table, log
If WScript.Arguments.length > 1 Then
    target = WScript.Arguments(0)
    outFile = WScript.Arguments(1)
    If WScript.Arguments.length > 2 Then
        table = Wscript.Arguments(2)
        If WScript.Arguments.length > 3 Then
            log = Wscript.Arguments(3)
        Else
            log = ""
        End If
    Else
        table = ""
    End If
End If
main target, outFile, table, log
WScript.Echo "Fin!"

、、、実験してて、バグを見つけた。
そのうち修正予定、、、。

追記(2/2)

  • 使用してたクラスの元ねたが分かったので、ソースから削除してリンクを掲載
  • バグの原因が分かったので、ソースを改修（スペースを無視するようにした、他）