VBScript三昧

最近VBScriptとJavaScriptに凝ってます。(ってほどでもない気もしますが。。)
特にIEをコントロールしたり、mdbファイルを扱ってSQLを発行したりすることに

Access_Tracker.vbs

Dim items(10)
Dim  match, matchCol

mdbファイルの指定
myMdbPath = "c:workAccess_Tracker.mdb"

解析CGIのURL
targetUrl = "http://hpcgi2.nifty.com/XXX/trackerBlog.cgi"

Set Ie = WScript.CreateObject("InternetExplorer.Application")
Ie.Navigate targetUrl
Do While IE.Busy Or IE.ReadyState<>4
WScript.Sleep 100
Loop

Set document=IE.document

document.loginForm.page.Value = "top"

最近のアクセスをチェック
document.loginForm.type(9).checked  = true

document.loginForm.submit()

Do While IE.Busy Or IE.ReadyState<>4
WScript.Sleep 100
Loop

デバッグ
Set document=IE.document
For Each item In document.All
WScript.Echo item.tagName
If item.tagName = "HTML" Then
WScript.Echo item.InnerHTML
WScript.Echo item.InnerText
End If
Next

Set tables = Ie.document.getElementsByTagName("TABLE")
3番目のテーブルのみ対象
Set targetTable = tables(2)

mdb関連
Set objADO = CreateObject("ADODB.Connection")
objADO.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ="& myMdbPath &";"

For Each line In targetTable.getElementsByTagName("TR")
1アクセスの処理
Set tds = line.getElementsByTagName("TD")

tdの要素を配列に入れる
index = 0

For Each td In tds
WScript.Echo "(" & index & ")[" & td.innerHTML & "]"
If index = 0 Then
items(index) = td.innerText
Else
items(index) = td.innerHtml
End If

index = index + 1
Next

検索日付の取得
myDate = items(0)
曜日の部分を取り除く
Set regPattern = new RegExp
regPattern.Pattern = "(.*?) (.*) (.*)"
tmp = regPattern.Replace(myDate, "$1 " & "$2")
myDate = tmp
Set regPattern = Nothing

キーワード解析
myQuery = items(6)
if Len(myQuery) > 0 Then
WScript.Echo "[" & myQuery & "]"
Google対応
Set regPattern = new RegExp
regPattern.Pattern = "A href=.*?google.*?/search.*?q=(.*?)&"

Set matchCol = regPattern.Execute(myQuery)
If matchCol.Count > 0 Then
Googleからのアクセスの場合

WScript.Echo "[" & myQuery & "]"
Set match = matchCol(0)
tmpBuf = match.SubMatches(0)


regPattern.Pattern = "ie=Shift_JIS"
If regPattern.Test(tmpBuf) Then
Shift JISの場合はそのまま
strSearch = tmpBuf
Else
With CreateObject("ScriptControl")
.Language = "JScript"
With .CodeObject
On Error Resume Next
strSearch = .decodeURI(tmpBuf)
End With
End With
End If

+をスペースに変換
regPattern.Pattern = "+"
regPattern.Global = true
tmp = regPattern.Replace(strSearch, " ")
strSearch = tmp

%2Fを/に変換
regPattern.Pattern = "%2F"
regPattern.Global = true
tmp = regPattern.Replace(strSearch, "/")
strSearch = tmp

" target=_blank>http://www.googleを削除する
regPattern.Pattern = "(.*)" & """" & " target=_blank>http://www.google.*"
tmp = regPattern.Replace(strSearch, "$1")
strSearch = tmp

WScript.Echo "[" & tmpBuf & "]"
WScript.Echo "<" & strSearch & ">@" & myDate

mdbに登録
strSqlStmt = "INSERT INTO ACCESS_TRACKER (" & _
"search_date,search_key_phrase" & _
") VALUES  (" & _
"" & myDate & "," & _
"" & strSearch & "" & _
")"
WScript.Echo "strSqlStmt = " & strSqlStmt
重複エラーを事前のOn Error Resume Nextにより回避済み
objADO.Execute strSqlStmt

Else
Google以外

End If
Set regPattern = Nothing
End If

Next

集計結果
On Error Goto 0
strSqlStmt = "select " & _
"search_key_phrase,count(*),sum(search_date) " & _
"from ACCESS_TRACKER " & _
"group by search_key_phrase " & _
"order by 2,3"

Set objADORS = objADO.Execute(strSqlStmt)

Do While Not objADORS.EOF
buf = ""
For i = 0 to objADORS.Fields.Count -1
buf = buf & objADORS(i) & vbTab
Next
WScript.Echo buf
objADORS.MoveNext
Loop

objADORS.Close
Set objADORS = Nothing

mdbコネクションを切断
objADO.Close
Set objADO = Nothing

function URLDecodeHex(match, hex_digits, pos, source)
URLDecodeHex = chr("&H" & hex_digits)
URLDecodeHex = "&H" & hex_digits
end function