ソースコード - テキストダンプ

これはテキストファイルの十六進ダンプを出力するスクリプトです。

テキストダンプは以下のファイルで構成されています。

• textDump.vbs テキストダンプ

動作要件

• Windows Script Host 2.0 (Microsoft Windows 98、Windows NT オプション パック、Windows 2000に含まれている・・・らしい。^^;)
• VBScript Ver 5.5 (IE5以上)

諸注意

エラー処理は特にしていません。ソースコードを読んだ上でお使いください。
このスクリプトの改変・再配布等は自由です。

textDump.vbs

'テキストファイルの十六進ダンプイメージを出力するスクリプト
'制作者 clone_01@yahoo.co.jp
'最終更新 午後 04:23 00/11/10

'使用上の注意
'このスクリプトを使った事により発生したいかなる損害についても制作者は一切責を負いません。
'	ソースコードを読んだ上で、自己責任において使ってください。
'
'元になるファイルのサイズ(単位：バイト)が奇数の場合は一時的に作業用ファイルを生成します。
'	これはユニコードとしてファイルからデータを読み込むためファイルサイズが奇数だと最後の1バイトが読み込めないので、
'	作業用ファイルの最後尾にスペース(ASCIIコード)を付加し、ファイルのサイズを偶数にするからです。
'
'実行後に スクリプトと同じフォルダに "DUMP_元のファイル名.txt" という名前のファイルを生成します。
'	同名のファイルがあった場合は上書きします。
'
'ファイルサイズが大きいと処理できない事があります。
'	ReadAllでデータを全部読み込んでいるからです(^^;。

'使い方
'テキストファイルをこのスクリプトのアイコンにドラッグ＆ドロップするだけ。
'処理が終わると"完了"のメッセージボックスがでます。

Option Explicit
Dim WshShell
Dim i

For i = 0 to WScript.Arguments.Count - 1
	textDump WScript.Arguments(i)
Next

Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.AppActivate "textDump.vbs"

MsgBox "完了",vbOKOnly,"テキスト ダンプ"


Sub textDump(filePath)
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
	Const TMP_FILE_NAME="TMP_textDump.tmp"
	Dim fso,file,textStream
	Dim fName,fPath
	Dim tmpStr,oddFlg
	Dim count

	'メモ帳を開いて表示する場合
	Dim WshShell

	Set fso = CreateObject("Scripting.FileSystemObject")
	Set file=fso.GetFile(filePath)
	'名前を取得しておく
	fName=file.Name

	If file.size>0 Then
		'ファイルサイズが奇数の場合はテンポラリファイルにコピーし、ファイルの最後尾にスペース(ASCIIコード)を付加する
		If file.size mod 2 =1 Then
			file.Copy TMP_FILE_NAME,True
			Set file=fso.GetFile(TMP_FILE_NAME)
			Set textStream = file.OpenAsTextStream(ForAppending,TristateFalse)
			textStream.Write Chr(&H20)
			textStream.Close
			oddFlg=True
		Else
			oddFlg=False
		End If

		'ユニコードで文字列取得
		Set textStream = file.OpenAsTextStream(ForReading,TristateTrue)
		tmpStr=textStream.ReadAll
		textStream.Close

		If oddFlg Then file.Delete

		tmpStr = toHex(tmpStr,oddFlg)
	End If

	'名前をつけて保存
	If LCase(Right(fName,4)) <> ".txt" Then fName=fName & ".txt"
	fPath="DUMP_" & fName
	Set textStream=fso.CreateTextFile(fPath,True)
	textStream.Write(tmpStr)
	textStream.Close

	'メモ帳を開いて表示する。
	Set WshShell = WScript.CreateObject("WScript.Shell")
	WshShell.Run ("notepad.exe " & fPath)
End Sub

Function toHex(mainStr,oddFlg)
	Dim i,count,bufStr,length

	length=LenB(mainStr)
	If oddFlg Then length=length-1

	For i=1 to length
		count=count+1
		If count>16 Then
			bufStr = bufStr & vbCrLf
			count=1
		End If
		bufStr = bufStr & Right("0" &  Hex(AscB(MidB(mainStr,i,1))),2) & " "
	Next
	toHex=bufStr
End Function