aodama.gif(0.97KB) VB で URL エンコード

 サーバー上の CGI スクリプトなどに "hikisu" という引数を HTTP プロトコルを使用して渡す場合は、

    http://www.hoge.go.jp/cgi-bin/hoge.cgi?hikisu
のようにし、環境変数 QUERY_STRING を拾ってやればいいのですが、日本語の2バイト文字などを渡す場合は、 URL エンコード(URL エスケープ)というものをして変換してやる必要があります。
 たとえば "林道の鬼"(Shift-JIS) という引数を渡す場合は、
    http://www.hoge.co.jp/cgi-bin/hoge.cgi?%97%D1%93%B9%82%CC%8B%53
のように渡し、CGI スクリプト側でデコードしてやります。これは Perl での例です。
    $str = $ENV{'QUERY_STRING'};
    $str =~ s/\+/ /g;
    $str =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C",hex($1))/eg;
 ここに私が作った URL エンコード文字列作成関数を載せておきます。 処理速度を上げるために文字列連結演算子(&, +)を撤廃したため、 やたらと長くなってしまいました。 しかし文字列連結演算子を使用していた初回バージョンより 20 倍以上速いです(^^;

Option Explicit

'===== URL エンコードモジュール =====
'(C)1999-2002 けるべ
'MAIL : NULL
'HOME : http://www.geocities.co.jp/SilkRoad/4511/


'----- ☆ URL エンコードについて ☆ ------------------------------------------
'
'URL エンコードは一つ一つの文字を "%" + 文字コード(16 進)に
'変換します。16 進表記の文字列は VB の Hex 関数で得ることが
'できますが、0 から 15(&HF) の文字コードの場合は先頭に 0 を
'付加したほうがよいと思われます。(例 : "%09")
'
'(例 1) ! → %21
'(例 2) あ → %82%A0(Shift-JIS の場合)
'(例 3) ア → %B1(Shift-JIS の場合)
'(例 4) [タブ文字] → %09
'
'1 バイト半角スペースは "+" に変換します。
'1 バイト半角英数字 A-Z, a-z, 0-9 および、*-.@_ の記号は
'URL エンコードしません。
'
'(例 1) You is a big fool man. → You+is+a+big+fool+man.
'(例 2) Hahahaha!!!!!12345 → Hahahaha%21%21%21%21%2112345
'(例 3) (@_@) ('-'*) → %28@_@%29+%28%27-%27*%29
'
'ここでは Microsoft Internet Explorer で行われている一般的な
'URL エンコードを記述しましたが、RFC2396 では
'
'reserved   = ";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" | "$" | ","
'unreserved = "-" | "_" | "." | "!" | "~" | "*" | "'" | "(" | ")" | alphanum
'
'とされているため、今後書き直す必要があるかもしれません。
'UriEncode に名称を変更する必要もあるでしょう(^-^;
'---------------------------------------------------------------------------


'UrlEncode 関数 Ver 1.08 より、文字列を一括して ANSI/S-JIS に
'変換し、Shift-JIS 2 バイト文字コードを判別する方法を、
'文字コードの直接比較に変更しました。これにより前バージョンより
'20% ほどスピードアップしました。引数名は変更しましたが、
'引数の型および戻り値は従来通りなのでそのまま使用できます。


'----- UrlEncode 関数 Ver 1.08 -----
'文字列を URL エンコードします。Shift-JIS を URL エンコードした
'文字列となります。
'
'引数 strSource
'   URL エンコードする対象の文字列を指定します。
'
'戻り値
'   関数が成功すると、URL エンコードされた文字列が返ります。
'
Public Function UrlEncode(ByRef strSource As String) As String

 Dim lngLength As Long                                          '文字列のサイズ(S-JIS 変換後)を格納する
 Dim bytSource() As Byte                                        'ANSI/S-JIS に変換した文字列を格納するバイト型配列
 Dim strBuffer As String                                        'URL エンコードされた文字列を一時格納するバッファ
 Dim bytSingle As Byte                                          '配列から抜き出した 1 バイトを格納する
 Dim strSingleHex As String                                     '文字コードを 16 進化した文字列を格納する
 Dim lngReadCount As Long                                       'bytSource 読み込み位置カウンタ
 Dim lngWriteCount As Long                                      'strBuffer 書き込み位置カウンタ
 
    lngLength = LenB(StrConv(strSource, vbFromUnicode))         'ANSI/S-JIS 変換後のサイズを求める
    If Not CBool(lngLength) Then Exit Function                  '0 バイトの場合関数を抜ける
    ReDim bytSource(lngLength - 1)                              'ANSI/S-JIS 変換文字列を格納する領域を確保
    bytSource = StrConv(strSource, vbFromUnicode)               'ANSI/S-JIS に変換し bytSource に格納
    
    strBuffer = String$(lngLength * 3, vbNullChar)              'URL エンコード文字列一時格納バッファを確保
    strSingleHex = "%00"                                        '16 進化した文字コードを格納するバッファを確保
    lngWriteCount = 1                                           '書き込みカウンタは 1 から開始
    
    Do                                                          '文字列の終端までループ
        bytSingle = bytSource(lngReadCount)                     '配列から 1 バイト抜く(毎回参照するより速い?)
        If ((bytSingle >= &H81) And (bytSingle <= &H9F)) Or _
           ((bytSingle >= &HE0) And (bytSingle <= &HEF)) Then   'Shift-JIS 2 バイト文字と確認された場合
            Mid(strSingleHex, 2, 2) = Hex$(bytSingle)           '文字コードを 16 進数に変換(上位バイト)
            Mid(strBuffer, lngWriteCount, 3) = strSingleHex     'URL エンコードされた文字列をバッファに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 3                   '書き込みカウンタを 3 増やす
            If lngReadCount = lngLength Then Exit Do            '文字列の終端に達した場合、ループを抜ける
            bytSingle = bytSource(lngReadCount)                 '配列から 1 バイト抜く
            Mid(strSingleHex, 2, 2) = Hex$(bytSingle)           '文字コードを 16 進数に変換(下位バイト)
            Mid(strBuffer, lngWriteCount, 3) = strSingleHex     'URL エンコードされた文字列をバッファに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 3                   '書き込みカウンタを 3 増やす
        ElseIf bytSingle = &H20 Then                            '半角スペース文字(" ")の場合
            Mid(strBuffer, lngWriteCount, 1) = "+"              '"+" を代わりに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 1                   '書き込みカウンタを 1 増やす
        ElseIf ((bytSingle >= &H40) And (bytSingle <= &H5A)) Or _
               ((bytSingle >= &H61) And (bytSingle <= &H7A)) Or _
               ((bytSingle >= &H30) And (bytSingle <= &H39)) Or _
               (bytSingle = &H2A) Or _
               (bytSingle = &H2D) Or _
               (bytSingle = &H2E) Or _
               (bytSingle = &H5F) Then                          '無変換文字であった場合
            Mid(strBuffer, lngWriteCount, 1) = Chr$(bytSingle)  '文字コードを文字列に戻して書き込む(^^;
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 1                   '書き込みカウンタを 1 増やす
        Else                                                    'その他の文字の場合
            If bytSingle <= &HF Then                            'Hex$() の結果が 1 文字になる場合
                Mid(strSingleHex, 2, 1) = "0"                   '0 を先頭に付加
                Mid(strSingleHex, 3, 1) = Hex$(bytSingle)       '文字コードを 16 進数に変換
            Else                                                '0 を付加する必要がない場合
                Mid(strSingleHex, 2, 2) = Hex$(bytSingle)       '文字コードを 16 進数に変換
            End If
            Mid(strBuffer, lngWriteCount, 3) = strSingleHex     'URL エンコードされた文字列をバッファに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 3                   '書き込みカウンタを 3 増やす
        End If
    Loop Until lngReadCount = lngLength

    Erase bytSource                                             'バイト型配列を消去
    
    If lngWriteCount > 1 Then                                   'バッファに文字列が書き込まれた場合
        UrlEncode = Left$(strBuffer, lngWriteCount - 1)         'バッファの余分な部分を削り、戻り値とする
    End If

End Function

サンプル : ダウンロード urlenc.lzh(9.51KB) ※ UrlDecode と共通です

 ここに記述しているコードは ANSI/Shift-JIS として URL エンコードするものですが、 サンプルアーカイブ内には、EUC として URL エンコードする関数、UTF-8 として URL エンコードする関数、 Unicode として URL エンコードする関数も入れてあります。 ただしすべてベータ版ですが(^^;

UrlEncodeEUC 関数(Beta)     - ue_euc.txt  (5.39KB)
UrlEncodeUtf8 関数(Beta)    - ue_utf8.txt (7.34KB)
UrlEncodeUnicode 関数(Beta) - ue_uni.txt  (5.42KB)
 UrlEncodeJis 関数(Beta)は NKF32.DLL 必須なので、別サンプルにしています。
UrlEncodeJis 関数(Beta)     - ue_jis.lzh  (3.83KB)

 VB 以外で使える URL エンコード関数もついでに作ってみました。

C 言語バージョン : C 言語で URL エンコード(β版)
VBScript バージョン : VBScript で URL エンコード


aodama.gif(0.97KB) URL デコードする

 URL エンコードされた文字列を、元にもどします。 でも、何に使うんだろ? VB で CGI を作ろうと思っている人や、 アクセスログをデコードしたい人には役に立つかも(^^;

'----- UrlDecode 関数 Ver 1.02 -----
'URL エンコードされた文字列をデコードし、デコードされた
'文字列をバイト型配列に格納します。
'
'引数 strEncoded
'   URL エンコードされている文字列を指定します。
'
'引数 bytResult()
'   URL デコードされた文字コードを格納するバイト型配列を指定します。
'   関数を呼び出すプロシージャで動的配列として宣言して指定して下さい。
'
'戻り値
'   バイト型配列 bytResult() に格納したサイズを返します。
'   関数が失敗した場合は 0 が返ります。
'
'デコード結果を文字列型ではなくバイト型配列に格納する仕様にしたのは、
'EUC や JIS を URL エンコードした文字列も扱えるようにするためです。
'バイト型配列に格納した文字列をVBで扱うためには、Unicode に
'変換する必要があります。文字コードが Shift-JIS であれば
'StrConv 関数で Unicode に変換できますが、EUC や JIS の場合は
'NKF32.DLL などでいったん Shift-JIS に変換してやる必要があります。
'
'なんかやたらと長いコードになってしまいましたが、7 割方は
'URL エンコードされた文字列として不適切な文字が含まれていた場合の
'処理であり、処理速度には影響ないと思うのでご安心を(^^;
'
Public Function UrlDecode _
    (ByRef strEncoded As String, _
     ByRef bytResult() As Byte) As Long

 Dim lngLength As Long                                                          '文字列の長さを格納する
 Dim strSingle As String                                                        '抜き出した 1 文字を格納する
 Dim strHex As String                                                           '"&H??" の 16 進表記文字コードを格納する
 Dim lngReadCount As Long                                                       '文字列読み込み位置カウンタ
 Dim lngWriteCount As Long                                                      'バッファ書き込み位置カウンタ
 Dim lngAsc As Long                                                             '1 文字分の文字コードを格納
 
    lngLength = Len(strEncoded)                                                 'URL エンコードされている文字列の長さを得る
    If Not CBool(lngLength) Then Exit Function                                  '0 文字の場合、関数を抜ける
    ReDim bytResult(lngLength - 1)                                              'デコード結果格納バッファ領域を確保
    strHex = "&H00"                                                             '16 進表記文字コードを格納する領域を確保
    lngReadCount = 1                                                            '読み込みカウンタは 1 から開始
    
    Do                                                                          '文字列の終端までループ
        strSingle = Mid$(strEncoded, lngReadCount, 1)                           '1 文字を抜き出す
        If strSingle = "%" Then                                                 '"%" であった場合
            If (lngReadCount + 2) <= lngLength Then                             '文字列の終端に達していない場合(残り 2 文字)
                Mid(strHex, 3, 2) = Mid$(strEncoded, lngReadCount + 1, 2)       '"%" の次の 2 文字を抜き出し "&H??" にする
                If IsNumeric(strHex) Then                                       '"&H??" が数値として評価できる場合
                    bytResult(lngWriteCount) = CByte(strHex)                    '"&H??" を数値に変換し配列に代入
                    lngReadCount = lngReadCount + 3                             '読み込みカウンタを 3 増やす
                    lngWriteCount = lngWriteCount + 1                           '書き込みカウンタをインクリメント
                Else                                                            '"&H??" が数値として評価できなかった場合
                    If IsNumeric(Left$(strHex, 3)) Then                         '"&H?" が数値として評価できる場合
                        bytResult(lngWriteCount) = CByte(Left$(strHex, 3))      '"&H?" を数値に変換し配列に代入
                        lngReadCount = lngReadCount + 2                         '読み込みカウンタを 2 増やす
                        lngWriteCount = lngWriteCount + 1                       '書き込みカウンタをインクリメント
                    Else                                                        '"&H?" が数値として評価できない場合
                        bytResult(lngWriteCount) = &H25                         '"%" だけを配列に代入
                        lngReadCount = lngReadCount + 1                         '読み込みカウンタをインクリメント
                        lngWriteCount = lngWriteCount + 1                       '書き込みカウンタをインクリメント
                    End If
                End If
            ElseIf (lngReadCount + 1) = lngLength Then                          '文字列の終端に達していない場合(残り 1 文字)
                Mid(strHex, 3, 1) = Mid$(strEncoded, lngReadCount + 1, 1)       '"%" の次の 1 文字を抜き出し "&H??" にする
                If IsNumeric(Left$(strHex, 3)) Then                             '"&H?" が数値として評価できる場合
                    bytResult(lngWriteCount) = CByte(Left$(strHex, 3))          '"&H?" を数値に変換し配列に代入
                    lngReadCount = lngReadCount + 2                             '読み込みカウンタを 2 増やす
                    lngWriteCount = lngWriteCount + 1                           '書き込みカウンタをインクリメント
                Else                                                            '"&H?" が数値として評価できない場合
                    bytResult(lngWriteCount) = &H25                             '"%" だけを配列に代入
                    lngReadCount = lngReadCount + 1                             '読み込みカウンタをインクリメント
                    lngWriteCount = lngWriteCount + 1                           '書き込みカウンタをインクリメント
                End If
            Else                                                                '文字列の終端に達していた場合
                bytResult(lngWriteCount) = &H25                                 '"%" だけを配列に代入
                lngReadCount = lngReadCount + 1                                 '読み込みカウンタをインクリメント
                lngWriteCount = lngWriteCount + 1                               '書き込みカウンタをインクリメント
            End If
        ElseIf strSingle = "+" Then                                             '"+" であった場合
            bytResult(lngWriteCount) = &H20                                     '半角スペース(" ")を代わりに入れる
            lngReadCount = lngReadCount + 1                                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 1                                   '書き込みカウンタをインクリメント
        Else                                                                    'その他の文字であった場合
            lngAsc = CLng(Asc(strSingle)) And &HFFFF&                           '文字コードを符号無し長整数型(嘘)にキャスト
            If lngAsc <= &HFF& Then                                             '"&HFF" 以下であった場合
                bytResult(lngWriteCount) = CByte(lngAsc)                        'バイト型にキャストし、配列に代入
                lngReadCount = lngReadCount + 1                                 '読み込みカウンタをインクリメント
                lngWriteCount = lngWriteCount + 1                               '書き込みカウンタをインクリメント
            Else                                                                'その他の文字(マルチバイト文字)の場合
                lngReadCount = lngReadCount + 1                                 '読み込みカウンタをインクリメント
            End If
        End If
    Loop Until lngReadCount > lngLength
    
    If lngWriteCount Then                                                       '実際にバッファに書き込まれた場合
        ReDim Preserve bytResult(lngWriteCount - 1)                             'バッファサイズを実際のサイズに削る
        UrlDecode = lngWriteCount                                               '書き込んだサイズを返す
    Else                                                                        'バッファに何も書き込まれなかった場合
        Erase bytResult                                                         '配列を消去
    End If

End Function

サンプル : ダウンロード urlenc.lzh(9.51KB) ※ UrlEncode と共通です

 URL デコード結果をバイト型配列に格納するため、 URL エンコードされた文字列が EUC や JIS をエンコードしたものであっても、 NKF32.DLL などで Shift-JIS に変換した後に

    strResult = StrConv(bytResult, vbUnicode)
としてやれば、文字列型変数に格納できます。(参考 : NKF32.DLL で文字コード変換)


VBコーナーにもどる   トップページにもどる