UTF-8 を 使った ソースコードを紹介する表示色の説明：ASP VBScriptは <% 〜 %>
キーワードはUTF-8 です。
<%@LANGUAGE=VBScript%>
<html>
<head><META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=x-sjis">
<title>文字コード関係で遊ぶ UTF-8からSJISへ変換(検索キーワードを戻す)</title>
</head>
<body>
<h1>文字コード関係で遊ぶ UTF-8からSJISへ変換(検索キーワードを戻す)</h1>
<br>
ログファイルから、UTF-8のキーワードを戻してみます。<br>
※詳細は、ソースと詳細解説のページを見てください。<br>
テストで上に元のgoogleの検索リンク、下に変換結果を作成しました<br>
<hr>
<%
'ADO DB Connection オブジェクトを作成
Set db=Server.CreateObject("ADODB.Connection")
db.Provider = "Microsoft.Jet.OLEDB.4.0"
'接続ＤＢの位置を渡し、ＤＢオープン
strDB = "../test/cnt_etc.mdb"
db.ConnectionString = Server.MapPath(strDB)
db.open 'データベースをオープンする
'お約束のレコードセットの作成 テーブル名logから全項目（＊）を指定
'UTF-8のデータをLikeで選択する
strSQL = "Select * From log Where referrer Like '%UTF-8%' "
strSQL = strSQL & " ORDER BY WriteTime DESC"
Set rs = db.Execute(strSQL)
'データの表示を行う
Response.Write "発行するSQL:" & strSQL & "<hr>"
'ＥＯＦまでループ or 10件まで
nCNT = 1
Do While rs.EOF = False And nCNT <= 10 '.EOFがFalseで10以下の間
'リンク元の表示
Response.Write "変換前:<A HREF='" & rs.Fields.Item("referrer") & "' "
Response.Write "Target='_blank'>"
Response.Write rs.Fields.Item("referrer") & "</A><BR>"
'%付のUTF-8コードを変換してみた
Response.Write "変換後:" & KANJI_HENKAN(rs.Fields.Item("referrer"))
Response.Write "<BR><BR><HR><BR>"
'次のレコードにポインタを移動する
rs.MoveNext 'これを忘れると悲惨なことに、、、
'カウンタを増やす
nCNT = nCNT + 1
Loop
'開いていたレコードセットを閉じる
rs.Close
'データベースも閉じようよ
db.Close
'お行儀よくオブジェクトも開放しましょう（通常は自動的に解放されるけど）
Set db = Nothing
'テストで終了時刻の表示
Response.Write "終了:" & Now() & "<hr>"
%>
<br>
</body>
</html>
<% '変換サブルーチンをまとめる
'％の後ろを強引に(手抜きで)変換してみた
Function KANJI_HENKAN(strMOJI)
Dim strRET
strRET = "" 'リターン値を初期化する
'特殊文字を手抜きでReplace関数で置き換える
strWORK = strMOJI
strWORK = Replace(strWORK, "%3F", "?")
strWORK = Replace(strWORK, "%2F", "/")
strWORK = Replace(strWORK, "%3A", ":")
strWORK = Replace(strWORK, "%3D", "=")
strWORK = Replace(strWORK, "%26", "&")
'+をスペースに変換したいけど、今回はそのまま。
strMOJI = strWORK '特殊文字変換結果の代入
'文字単位でループする
For n = 1 To Len(strMOJI)
strCHK = Mid(strMOJI, n, 1) '1文字取り出す
If strCHK = "%" Then '%の後ろをデコードするかチェック
strWORK = Mid(strMOJI, n, 9) '9文字取り出し変換処理へ渡す
strRET = strRET & UTF8toSJIS(strWORK) '変換結果を＋する
n = n + 8 '強引に８文字飛ばす
Else 'そのまま
strRET = strRET & strCHK 'そのまま＋する
End If
Next
KANJI_HENKAN = strRET
End Function
Function UTF8toSJIS(strCODE)
'%E6%96%87 の UTF-8コード文字列をSJISに直す
Dim strHEX
Dim n 'ループカウンタ
Dim i 'ループのカウンタ
Dim str2CODE '2進数の文字列
Dim str2UNI 'UNICODE2進数
'1コード目を変換
strHEX = Mid(strCODE, 2, 2) '%を抜かしたコードを取得
str2CODE = HEX16toSTR2(strHEX)
'2コード目を変換
strHEX = Mid(strCODE, 5, 2) '%を抜かしたコードを取得
str2CODE = str2CODE & HEX16toSTR2(strHEX)
'3コード目を変換
strHEX = Mid(strCODE, 8, 2) '%を抜かしたコードを取得
str2CODE = str2CODE & HEX16toSTR2(strHEX)
'コードを抜き出しコピーする
'0 1 2
'1234 5678 9012 3456 7890 1234
'1110 xxxx 10xx xxxx 10xx xxxx を下記に割り当てる
'xxxx xxxx xxxx xxxx
str2UNI = Mid(str2CODE, 5, 4)
str2UNI = str2UNI & Mid(str2CODE, 11, 6)
str2UNI = str2UNI & Mid(str2CODE, 19, 6)
'作成した2進数を16進数に直す
strHEX = STR2toHEX16(str2UNI)
'16進数文字列を数値に直し、さらにChrW関数でSJISに
UTF8toSJIS = ChrW(CInt("&H" & strHEX))
End Function
'HEX16進文字列を受け取り２進文字列を返す
Function HEX16toSTR2(strHEX)
Dim n 'ループカウンタ
Dim i 'ループのカウンタ
Dim n8421 '8 4 2 1の数値計算用
Dim str2STR
Dim nCHK
str2STR = "" '結果のエリアを初期化する
'文字数分ループする
For n = 1 To Len(strHEX)
nCHK = 0 '0で初期化
On Error Resume Next 'エラーを無視する
nCHK = CInt("&h" & Mid(strHEX, n, 1)) 'n文字目を数値変換
On Error Goto 0
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
Next
'リターン値をセットして終了
HEX16toSTR2 = str2STR
End Function
'2進文字列を受け取り16進文字列を返す
Function STR2toHEX16(str2)
Dim strHEX
Dim n 'ループカウンタ
Dim i 'ループのカウンタ
Dim n8421 '8 4 2 1の数値計算用
Dim nBYTE
'頭４文字単位かチェックする
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
'計算して、１倍との数値が完成したので１６進文字にしてセットする
strHEX = strHEX & Hex(nBYTE)
Next
'リターン値をセットして関数を抜ける
STR2toHEX16 = strHEX
End Function
%>
|
|