【工作員のﾃﾝﾌﾟﾚ偽装】脱Google総合★15【注意！】
dat落ちしたので再掲、Windowsで動く位置情報サービス検索ツール
--
GLSQuery.hta という名前で保存してダブルクリック
MACアドレスを2つ入力してqueryボタンで検索実行
mapボタンで地図表示
<html><head><title>GLSQuery</title></head><body onLoad="VBScript:Window.ResizeTo 640,220">
<form name="form1">
<p>MAC1 <input type="text" name="mac1" /> MAC2 <input type="text" name="mac2" />
<input type="button" value="query" onClick="do_query()" />
<input type="button" value="map" onClick="do_map()" /></p>
<textarea name="result" cols="80" rows="7"></textarea>
</form>
<script language="VBScript">
Sub do_query()
url="http://www.google.com/loc/json"
lang = "ja_JP"
mac1 = document.form1.mac1.value
mac2 = document.form1.mac2.value
q = "{ ""version"": ""1.1.0"", "
q = q & """host"": ""maps.google.com"", "
q = q & """request_address"": true, "
q = q & """address_language"": """ & lang & """, "
q = q & """wifi_towers"": [ "
q = q & "{ ""mac_address"": """ & mac1 & """, ""signal_strength"": 8, ""age"": 0 }, "
q = q & "{ ""mac_address"": """ & mac2 & """, ""signal_strength"": 8, ""age"": 0 } "
q = q & "] }"
Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
oHttp.Open "POST", url, false
oHttp.SetRequestHeader "Pragma", "no-cache"
oHttp.SetRequestHeader "Cache-control", "no-cache"
On Error Resume Next
oHttp.Send q
If ERR then
result = "Error: " & Hex(ERR.number) & vbCrLf & ERR.Source & vbCrLf & ERR.Description
ElseIf oHttp.Status = "200" Then
result = oHttp.ResponseText
Else
result = "HTTP " & oHttp.Status & " " & oHttp.StatusText
End If
document.form1.result.value = result
End Sub
Sub do_map()
if document.form1.result.value = "" then do_query()
result = document.form1.result.value
label1 = """latitude"":"
label2 = ",""longitude"":"
label3 = ",""address"":"
pos1 = InStr(1, result, label1)
pos2 = InStr(1, result, label2)
pos3 = InStr(1, result, label3)
If pos1 > 0 And pos2 > 0 And pos3 > 0 Then
lati = Mid(result, pos1 + Len(label1), pos2 - pos1 - Len(label1))
longi = Mid(result, pos2 + Len(label2), pos3 - pos2 - Len(label2))
url="http://maps.google.com/maps?q=" & lati & "," & longi
Set wsh = CreateObject("WScript.Shell")
wsh.Run "cmd /c start " & url
End If
End Sub
</script></body></html>
--
GLSQuery.hta という名前で保存してダブルクリック
MACアドレスを2つ入力してqueryボタンで検索実行
mapボタンで地図表示
<html><head><title>GLSQuery</title></head><body onLoad="VBScript:Window.ResizeTo 640,220">
<form name="form1">
<p>MAC1 <input type="text" name="mac1" /> MAC2 <input type="text" name="mac2" />
<input type="button" value="query" onClick="do_query()" />
<input type="button" value="map" onClick="do_map()" /></p>
<textarea name="result" cols="80" rows="7"></textarea>
</form>
<script language="VBScript">
Sub do_query()
url="http://www.google.com/loc/json"
lang = "ja_JP"
mac1 = document.form1.mac1.value
mac2 = document.form1.mac2.value
q = "{ ""version"": ""1.1.0"", "
q = q & """host"": ""maps.google.com"", "
q = q & """request_address"": true, "
q = q & """address_language"": """ & lang & """, "
q = q & """wifi_towers"": [ "
q = q & "{ ""mac_address"": """ & mac1 & """, ""signal_strength"": 8, ""age"": 0 }, "
q = q & "{ ""mac_address"": """ & mac2 & """, ""signal_strength"": 8, ""age"": 0 } "
q = q & "] }"
Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
oHttp.Open "POST", url, false
oHttp.SetRequestHeader "Pragma", "no-cache"
oHttp.SetRequestHeader "Cache-control", "no-cache"
On Error Resume Next
oHttp.Send q
If ERR then
result = "Error: " & Hex(ERR.number) & vbCrLf & ERR.Source & vbCrLf & ERR.Description
ElseIf oHttp.Status = "200" Then
result = oHttp.ResponseText
Else
result = "HTTP " & oHttp.Status & " " & oHttp.StatusText
End If
document.form1.result.value = result
End Sub
Sub do_map()
if document.form1.result.value = "" then do_query()
result = document.form1.result.value
label1 = """latitude"":"
label2 = ",""longitude"":"
label3 = ",""address"":"
pos1 = InStr(1, result, label1)
pos2 = InStr(1, result, label2)
pos3 = InStr(1, result, label3)
If pos1 > 0 And pos2 > 0 And pos3 > 0 Then
lati = Mid(result, pos1 + Len(label1), pos2 - pos1 - Len(label1))
longi = Mid(result, pos2 + Len(label2), pos3 - pos2 - Len(label2))
url="http://maps.google.com/maps?q=" & lati & "," & longi
Set wsh = CreateObject("WScript.Shell")
wsh.Run "cmd /c start " & url
End If
End Sub
</script></body></html>
|
|
|