If IP = "" Then IP = "www.haiyangtop.net" url = "http://www.seologs.com/ip-domains.html?domainname=" IP "" Body = getHTTPPage(url)
Set Re = New RegExp Re.Pattern = "(font face=""arial"">[\s\S]+/font> /td>/tr>/table>)" Set Matches = Re.Execute(Body) If Matches.Count>0 Then Body = Matches(0).value
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, "GB2312") 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