url = "http://www.ip138.com"
Body = getHTTPPage(url)
Body = Replace(getHTTPPage(url),vbcrlf,"")
Body=Replace(body,Chr(13),"")
Body=Replace(body,Chr(10),"")

Set Re = New RegExp
Re.Pattern = "(.+您的IP地址是：)(\d+.\d+.\d+.\d+)(.+)"
re.IgnoreCase = True
'Set Matches = Re.Execute(Body)
'If Matches.Count>0 Then Body = Matches(0)
body= Re.Replace(body, "<font color=red>$2</font>")
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