どうも、三流プログラマーのＫｅｎ３です。 今回は、 BASE64の変換処理にチャレンジしてみます。 http://www.ken3.org/vba/lzh/vba160.lzh にサンプルbase64test.xlsを圧縮しておきます、 Excel2000版ですが使ってみてください。/* * １．今回のキッカケ */
前回の No.159 IE 認証ページへのアクセス、basci認証ページって？ http://www.ken3.org/vba/backno/vba159.html で、 設定したユーザーとパスワードの組み合わせ mailmaga:guest をBASE64変換して bWFpbG1hZ2E6Z3Vlc3Q= ヘッダーに指定 "Authorization: Basic bWFpbG1hZ2E6Z3Vlc3Q=" そして開いていました。 今回は、このBASE64のコードを探ってみたいと思います。/* * ２．BASE64って何？ */
BASE64って何？私の知識でこの単語が引っかかるのは、 メールで添付フアイルを送る時、BASE64って単語を見たことがある程度です。 よし、Yahoo と Googleで探してみるか。(最近検索結果が違うので探りを兼ねて) GoogleでBASE64をキーワードに探すと、 http://www.google.co.jp/search?hl=ja&ie=UTF-8&q=BASE64&lr=lang_ja (日本語のページを探しました) BASE64とは何か ： IT用語辞典 ─ 用語解説 ─ 意味 ... http://e-words.jp/w/BASE64.html が一番上に出てきます。(2004/6/6現在) う〜ん、ここは用語説明でした、、、 上から３つ目に、 BASE64 について http://www.sea-bird.org/doc/Cygwin/BASE64enc.html とサイトがあり、 >1.エンコードすべきデータから、３バイト取得する。 >2.取得した３バイトを２４ビットのデータ領域に設定する。 >3.上位から６ビットを取り出し、その数値を下記の変換テーブルに従い >キャラクター文字に変換する。 >4.次の６ビット以降も同じ変換を行い、２４ビットすべて変換する。 >5.エンコードすべきデータが無くなるまで、１〜４の作業を繰り返す。 > ※エンコードすべきデータが、２バイトしか無い場合は、それまでBASE64 >エンコード変換した文字列の最終位置に'='を付加する。 > ※エンコードすべきデータが、１バイトしか無い場合は、それまでBASE64 >エンコード変換した文字列の最終位置に'=='を付加する。 > >変換テーブル：６ビットデータの「０〜６３」を以下の文字列に変換する。 > 0 〜25:A〜Z > 26〜51:a〜z > 52〜61:0〜9 > 62 :+ > 63 :/ と、丁寧に変換方法が載ってました。 YahooでBASE64を検索しても、いろいろなページがヒットします。 http://search.yahoo.co.jp/bin/query?p=BASE64&hc=0&hs=0 読んでいくと、 ６ビット単位にデータを取り出し、それを指定された文字に当てはめる。 って感じです。/* * ３．さっそく作ってみた */
手抜きで、漢字２バイトには対応していないが、 下記のように作ってみました。 ※なんか無駄に長いんだけど、気にしないでね。 'BASE64の変換処理にチャレンジする 全角文字未対応
Function base64(strMOJI As String) As String
Dim strWORK As String
Dim strCODE As String
Dim n As Integer, i As Integer
Dim nAMARI As Integer
Dim n6BOX(5) As Integer '6ビット取り出した数値
Dim nCODE As Integer
Dim strRET As String
strRET = "" 'リターン値を初期化する
For n = 1 To Len(strMOJI) Step 3
'3バイトを２進数に変換する、２４ビットの数値を作成する
strWORK = ""
nAMARI = 0
For i = 0 To 2
strCODE = Mid(strMOJI, n + i, 1) '文字を取り出す
If strCODE = "" Then
nAMARI = 3 - i
strWORK = strWORK & "00000000"
Exit For
Else 'コードに変換する
strWORK = strWORK & HEX16toSTR2(Hex(Asc(strCODE)))
End If
Next i
Debug.Print strWORK
'8*3の24ビット2進数から６ビット単位で4つ取り出し、数値に変換する
For i = 0 To 3
n6BOX(i) = Val("&H0" & STR2toHEX16(Mid(strWORK, 1 + i * 6, 6)))
Debug.Print n6BOX(i)
Next i
'対応表にそって変換する
'６ビットデータの「０〜６３」を以下の文字列に変換する。
' 0 〜25:A〜Z
' 26〜51:a〜z
' 52〜61:0〜9
' 62 :+
' 63 :/
For i = 0 To 3 - nAMARI
If n6BOX(i) = 63 Then strRET = strRET & "/"
If n6BOX(i) = 62 Then strRET = strRET & "+"
' 0 〜25:A〜Z
If 0 <= n6BOX(i) And n6BOX(i) <= 25 Then
strRET = strRET & Chr(Asc("A") + n6BOX(i) - 0)
End If
' 26〜51:a〜z
If 26 <= n6BOX(i) And n6BOX(i) <= 51 Then
strRET = strRET & Chr(Asc("a") + n6BOX(i) - 26)
End If
' 52〜61:0〜9
If 52 <= n6BOX(i) And n6BOX(i) <= 61 Then
strRET = strRET & Chr(Asc("0") + n6BOX(i) - 52)
End If
Next i
'あまりの文字分=を追加する
If nAMARI = 1 Then strRET = strRET & "="
If nAMARI = 2 Then strRET = strRET & "=="
Next n
base64 = strRET
End Function |
Function STR2toHEX16(ByVal str2 As String) As String
Dim strHEX As String
Dim n As Integer 'ループカウンタ
Dim i As Integer 'ループのカウンタ
Dim n8421 As Integer '8 4 2 1の数値計算用
Dim nBYTE As Integer
'頭４文字単位かチェックする
n = Len(str2) Mod 4 '足りない文字数を計算する
If n <> 0 Then
str2 = String(4 - n, "0") & str2 '頭に文字０を追加する
End If
strHEX = "" '結果のエリアを初期化する
'文字数分ループする
For n = 1 To Len(str2) Step 4 '４文字(1バイト)単位にループを作る
n8421 = 8 '初期値に８を代入する(上から計算したいので)
nBYTE = 0 '1バイト計算用変数を初期化
For i = 0 To 3 '４回まわるよ(4ビット分)
'ビットが立っているかチェックする
If Mid(str2, n + i, 1) = "1" Then
nBYTE = nBYTE + n8421 'ビットに対応した数値を＋する
End If
'次のビットを計算したいので２で割る
n8421 = n8421 / 2
Next i
'計算して、１倍との数値が完成したので１６進文字にしてセットする
strHEX = strHEX & Hex(nBYTE)
Next n
'リターン値をセットして関数を抜ける
STR2toHEX16 = strHEX
End Function |
Function HEX16toSTR2(strHEX As String) As String
Dim n As Integer 'ループカウンタ
Dim i As Integer 'ループのカウンタ
Dim n8421 As Integer '8 4 2 1の数値計算用
Dim str2STR As String
Dim nCHK As Integer
str2STR = "" '結果のエリアを初期化する
'文字数分ループする
For n = 1 To Len(strHEX)
nCHK = CInt("&h" & Mid(strHEX, n, 1)) 'n文字目を数値変換
n8421 = 8 '初期値に８を代入する(上からチェックしたいので)
For i = 1 To 4 '４回まわるよ
If (nCHK And n8421) = 0 Then 'Andでビットをチェックする
str2STR = str2STR & "0" 'ビットは立ってないよ
Else
str2STR = str2STR & "1" 'ビットは立ってるよ
End If
'次のビットをチェックしたいので２で割る
n8421 = n8421 / 2
Next i
Next n
'リターン値をセットして終了
HEX16toSTR2 = str2STR
End Function |
Sub bbbb()
Dim objIE As Object 'ＩＥオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
'テスト用の認証ページに飛ぶ
Const strURL = "http://www.kurokiya.sake-ten.jp/zzz/"
Dim strHEAD As String
'ID:passwordをBASE64変換してヘッダ情報を作成する
strHEAD = "Authorization: Basic " & base64("mailmaga:guest") & vbCrLf
objIE.navigate2 strURL, , , , strHEAD
'表示終了まで待つ
Do While objIE.Busy = True
'何もしないループ（笑）
DoEvents
Loop
'テストでHTMLソースを取出す
Dim strhtml As String
strhtml = objIE.Document.all(0).innerHTML '変数に代入
MsgBox "ソースは" & strhtml & "です"
End Sub |
ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、
|
気になったジャンル↓を選択してください。 人気記事(来場者が多いTOP3): Excel関係: Access関係: その他：VBAの共通関数やテキストファイルの操作など 開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う] 仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力] ※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。 |
Blogとリンク:[三流君の作業日記]/
[VBAやASPのサンプルコード]/
広告-[通販人気商品の足跡]