UTF8 を 使った ソースコードを紹介する表示色の説明：ASP VBScriptは <% 〜 %>
キーワードはUTF8 です。
<%@LANGUAGE=VBScript%>
<html>
<head><META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=x-sjis">
<title>文字コード関係で遊ぶ amazon KeyWord変換(UTF8変換テスト)</title>
</head>
<body>
<hr>
<p>VBA UTF-8 で 誤爆してGoogleからの来場者が多いので、先頭に書きます。<br>
<em>VBAからJavaScriptを使う方法</em>もありますよ。<br>
<br>
スクリプト コントロールの概要<br>
<a href='https://www.microsoft.com/japan/msdn/scripting/scriptcontrol/scoverview.htm'>https://www.microsoft.com/japan/msdn/scripting/scriptcontrol/scoverview.htm</a><br>
↑MSのサイトだけど、httpとhttpsが混在してると警告が出るけどビックリしないでね。<br>
頭の例は、MSが大好きなVBScriptだけど、.Language = "JScript" も可能と途中で書いてありました・・・。<br>
なんて↑へんな日本語で書くよりコード↓を見た方が伝わりやすいですよね。
<table bgcolor='FLORALWHITE' border=2 CELLPADDING=16><tr><td><pre><code>Sub JavaScript_Test() <Font Color='Green'>'VBA から VavaScriptを使うテスト</Font>
<Font Color='Green'>'検索文字を入力</Font>
Dim strMOJI As String
strMOJI = InputBox("キーワード=", "入力", "三流")
<Font Color='Green'>'検索文字をJavaScriptのencodeURI関数で作る</Font>
Dim strPARA As String <Font Color='Green'>'パラメーター</Font>
Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "Jscript" <Font Color='Green'>'JavaScriptを指定(書き間違えないでね)</Font>
strPARA = sc.CodeObject.encodeURI(strMOJI) <Font Color='Green'>'encodeURI関数を呼ぶ</Font>
Set sc = Nothing
Debug.Print strPARA
<Font Color='Green'>'手抜きで Shell でWebページを表示する</Font>
Dim strURL As String
strURL = "http://www.google.co.jp/search?hl=ja&ie=UTF-8&q=" & strPARA
Call Shell("explorer.exe """ & strURL & """", vbNormalFocus)
End Sub</code></pre></td></tr></table>
↑こんな感じで、使えるので、活用してみてください。VBAからJavaScriptを使って処理する感じです。<br>
※※上記でほぼ解決なのですが、下記、メルマガで書いた使えない、冗長な自作関数です。
</p>
<hr>
<h1>文字コード関係で遊ぶ amazon KeyWord変換(UTF8変換テスト)</h1>
<br>
受け取った文字列に対して、<br>
オリジナルのUTF8変換関数を使い、amazonのキーワードに変換します<br>
※詳細は、ソースと詳細解説のページを見てください。<br>
<hr>
<%
CHK_DATA = Request.QueryString("DATA") 'パラメータの代入
%>
<FORM ACTION="test097-3.asp" METHOD="GET">
調査したいキーワードの文字列を入力してください。<br>
<INPUT TYPE="text" SIZE="30" NAME="DATA" VALUE="<%=CHK_DATA%>">
<INPUT TYPE="submit" VALUE="調査開始"><br>
↑いろいろと遊んでみてください↑
</FORM>
<HR>
<%
'長さをチェックする
If Len(CHK_DATA) <> 0 Then '文字が入っていたら
'文字数分ループして、コードを表示
strUTF8 = "" '空文字で初期化
For n = 1 To Len(CHK_DATA)
strWORK = Mid(CHK_DATA, n, 1) 'ｎ番目の文字を取り出す
'２バイト、漢字か判断 手抜きでLen関数で文字数を見た
If Len(Hex(Asc(strWORK))) <= 2 Then
If Asc(strWORK) <= &H20 Then
'制御コードか？
strCODE = "%" & Right("0" & HEX(ASC(strWORK)), 2)
Else
'英数はそのまま＋する
strCODE = strWORK
End If
Else
strCODE = SJIStoUTF8(strWORK) '変換関数を呼ぶ
End If
strUTF8 = strUTF8 & strCODE '結果の文字列をつなげる
Next
Response.Write "受け取ったキーワード[<b>"
Response.Write Server.HTMLEncode(CHK_DATA) & "</b>]が<br>"
Response.Write Server.HTMLEncode(strUTF8) & "となります<br>"
Response.Write "テストでgoogleとamazonのキーワードを指定してみます<br>"
strURL = "http://www.google.co.jp/search?hl=ja&ie=UTF-8&q=" & strUTF8
Response.Write "<a Href='" & strURL & "' target='_blank'>"
Response.Write Server.HTMLEncode(strURL) & "</a><br>"
Response.Write "↑をクリックするとgoogleで調査できました？" & vbCrLf
Response.Write "<br>↓amazonキーワード結果リンク<br>" & vbCrLf
strURL = "http://www.amazon.co.jp/exec/obidos/external-search?"
strURL = strURL & "tag=ken3book-22&keyword=" & strUTF8 & "&mode=blended"
Response.Write "<a Href='" & strURL & "' target='_blank'>"
Response.Write Server.HTMLEncode(CHK_DATA) & "</a>←テストOK?<br>"
Response.Write "↑キーワードリンク リンクのコードは↓<br>"
Response.Write Server.HTMLEncode(strURL) & "<br>"
End If
%>
<br>
</body>
</html>
<%
'SJISコードの文字列を受け取り、UTF8コードの%付文字列を返す
Function SJIStoUTF8(strSJIS)
strUNICODE = ASCW(strSJIS) 'ASCWでユニコードにする
'コードを２進にしてワークに代入する
strWORK2 = HEX16toSTR2(HEX(strUNICODE))
'切り取って、UTF8の２進数を作成する
'xxxx xxxx xxxx xxxx を下記に割り当てる
'1110xxxx 10xxxxxx 10xxxxxx
strUTF8CODE = "1110" & Mid(strWORK2, 1, 4)
strUTF8CODE = strUTF8CODE & "10" & Mid(strWORK2, 5, 6)
strUTF8CODE = strUTF8CODE & "10" & Mid(strWORK2, 11, 6)
'作成した２進数を１６進数に戻す
strWORK16 = STR2toHEX16(strUTF8CODE)
'%を付けて格納
strRET = "" 'リターン値を初期化
strRET = strRET & "%" & Mid(strWORK16, 1, 2) '%を付けた文字列を作成
strRET = strRET & "%" & Mid(strWORK16, 3, 2)
strRET = strRET & "%" & Mid(strWORK16, 5, 2)
'リターン値を代入
SJIStoUTF8 = strRET
End Function
'HEX16進文字列を受け取り2進数文字列を返す
Function HEX16toSTR2(strHEX)
Dim n 'ループカウンタ
Dim i 'ループのカウンタ
Dim n8421 '8 4 2 1の数値計算用
Dim str2STR
Dim nCHK
str2STR = "" '結果のエリアを初期化する
'文字数分ループする
For n = 1 To Len(strHEX)
On Error Resume Next 'エラー発生時次の行へ
nCHK = 0 '0で初期化
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
%>
|
|