あけおめです。（Base64）

あけましておめでとうございます。

さて、本年も年初めとしてネタはーーーーとくにありません。



とまぁ、それだとあれなので、久しぶりにプログラムコードでも投稿です。

VB Scriptという奴で、下記のコードを全丸丸コピーし、メモ帳に貼り付けます。

貼りつけたテキストを保存し、拡張子を「.txt」から「.vbs」に変更。ただそれだけです。


何ができるかと言えば、ZIPファイルをドロップアンドドラッグするとテキストデータに変換された「.txt」ファイルを作る。
ただそれだけです。

変換した「.txt」ファイルと再びドロップアンドドラッグすると「.zip」ファイルを作成する。

とまぁ、ただそれだけの話ですね。

ZIPファイルをHTMLページに組み込んだりするのに使用しようかなと、作ったデータもの。

画像なんかは
<img alt="" src="data:image/jpeg;base64,生成したコード" />
みたいな感じで埋め込めるので、ZIPも出来ないのかなぁ？　と思って作った産物です。

 埋め込みの方法は

data:[<MIME-type>][;charset=<encoding>][;base64],<data>

で、MIME-typeは「application」を指定し、charsetには「zip」と記載してやればいけそうです。

zipアーカイブ

需要はどれだけあるか不明ですが、当ブログのようなケースだと、この方法使えば別にファイルをアップロードしてリンクを張らなくて済むという利点があるので、助かると言えば助かりますね。
ただまぁ、ファイル名がファイル名なので、これが今後の課題かなぁ。

Option Explicit

Dim objParm


'①コマンドライン引数の情報を保存
Set objParm = Wscript.Arguments

'②取得したコマンドライン引数が2つ未満のときはエラー
If objParm.Count = 0 Then
WScript.echo "コマンドライン引数が足りません"
WScript.Quit
end if

Dim strMessage

For Each strMessage in objParm
WScript.echo strMessage & "を処理します。"
SetPath(strMessage)
next
WScript.Quit


'データ処理
Sub SetPath(Value)
Dim pos , root, filename , exi,rec , filepath
rec = -1
pos = InStrRev(Value, "\")
root = Left(Value, pos)
filename = Mid(Value, pos + 1)
pos = InStrRev(filename, ".")
exi = Mid(filename, pos + 1)
filename = Left(filename, pos - 1)
if exi = "zip" then
pos = EncodeBase64(Value)
filepath = root & filename & ".txt"
rec = PrintText(pos, filepath)
WScript.echo "エンコード処理を実施します"
elseif exi="txt" then
pos = ReadText(Value)
filepath = root & filename & ".zip"
rec = DecodeBase64(pos, filepath)
WScript.echo "デコード処理を実施します"
end if
if rec = -1 then
WScript.echo "失敗しました。"
else
WScript.echo "成功しました。"
end if
End Sub

'ファイルをBase64エンコード
Function EncodeBase64(filepath )
Dim elm
Dim ret
Const adTypeBinary = 1
Const adReadAll = -1
ret = "" '初期化
On Error Resume Next
Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
With CreateObject("ADODB.Stream")
.Type = adTypeBinary
.Open
.LoadFromFile filepath
elm.DataType = "bin.base64"
elm.nodeTypedValue = .Read(adReadAll)
ret = elm.Text
.Close
End With
On Error GoTo 0
EncodeBase64 = ret
End Function

'ファイルをBase64デコード
Function DecodeBase64( Base64Str , filepath )
Dim elm
Dim ret
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
ret = -1 '初期化
On Error Resume Next
Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
elm.DataType = "bin.base64"
elm.Text = Base64Str
With CreateObject("ADODB.Stream")
.Type = adTypeBinary
.Open
.Write elm.nodeTypedValue
.SaveToFile filepath, adSaveCreateOverWrite
.Close
End With
If Err.Number <> 0 Then ret = 0
On Error GoTo 0
DecodeBase64 = ret
End Function

'テキスト出力
Function PrintText(Value ,filepath)
dim objFileSys
dim strScriptPath
dim objWriteStream
on error resume next
err.clear

Set objFileSys = CreateObject("Scripting.FileSystemObject")
objFileSys.CreateTextFile filepath

Set objWriteStream = objFileSys.OpenTextFile(filepath,2,True)

objWriteStream.Write Value
objWriteStream.Close


Set objWriteStream = nothing
Set objFileSys = Nothing

if err.Number <> 0 then
PrintText = -1
else
PrintText = 1
end if
End Function

'テキスト入力
Function ReadText(filepath)
dim objFileSys
dim objTextStream
dim strText

Set objFileSys = Createobject("Scripting.FileSystemObject")

Set objTextStream = objFileSys.OpenTextFile(filepath,1)

if objTextStream.AtEndOfStream = False then
strText = objTextStream.ReadAll
end if

objTextStream.Close

Set objTextStream = nothing
Set objFileSys = Nothing

ReadText = strText

End Function