msg="請輸入你要查詢的IP或域名:"  
IP=Inputbox(msg,"IP地理位置查詢小偷") 

If IP = "" Then IP = "127.0.0.1" 
url = "http://www.ip.cn/?q="& IP &"" 
Body = getHTTPPage(url) 

Set Re = New RegExp 
Re.Pattern = "(查詢結果為：.+)" 
Set Matches = Re.Execute(Body) 
If Matches.Count>0 Then Body = Matches(0) 
'Re.Pattern = "/[[/s/S]*/]" 
'Body = Re.Replace(Body, "") 

'wscript.echo IP & Body 
Set oXMLHttpRequest=Nothing 
Set objExplorer = WScript.CreateObject("InternetExplorer.Application") 
objExplorer.Navigate "about:blank"  
objExplorer.ToolBar = 0 
objExplorer.StatusBar = 0 
objExplorer.Visible = 1 
objExplorer.height=300 
objExplorer.width=400 
objExplorer.left=400 
objExplorer.resizable=0 
objExplorer.Document.Body.InnerHTML =IP & Body 

'objExplorer.document.parentwindow.clipboardData.SetData "text", IP & Body 

Set objExplorer=nothing 


'函數區 

Function getHTTPPage(Path) 
      t = GetBody(Path) 
      getHTTPPage = BytesToBstr(t, "UTF-8") 
End Function 

Function GetBody(url) 
     On Error Resume Next 
     Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
     With Retrieval 
         .Open "Get", url, False, "", "" 
         .Send 
          GetBody = .ResponseBody 
     End With 
     Set Retrieval = Nothing 
End Function 

Function BytesToBstr(Body, Cset) 
     Dim objstream 
     Set objstream = CreateObject("adodb.stream") 
      objstream.Type = 1 
      objstream.Mode = 3 
      objstream.Open 
      objstream.Write Body 
      objstream.Position = 0 
      objstream.Type = 2 
      objstream.Charset = Cset 
      BytesToBstr = objstream.ReadText 
      objstream.Close 
     Set objstream = Nothing 
End Function