| Here's the code:
<%
Response.Expires = 0
Response.ExpiresAbsolute = Now ()-1
Response.AddHeader "Pragma", "No-cache"
Response.AddHeader "Cache-control", "private"
Response.CacheControl = "No-cache"
Response.Charset = "GB2312"
Server.ScriptTimeout = 9999
If request ("IP") <> "Then
Response.Write GetIP ("Request" ("IP"))
Response.End
End If
Function GetPage (Path)
t = GetBody (Path)
Getpage=bytestobstr (T, "UTF-8")
End Function
Function GetPage2 (Path)
t = GetBody (Path)
Getpage2=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 = Server.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
Function fixstr (ByVal str, ByVal start, ByVal last, ByVal N)
Dim strtemp
On Error Resume Next
If InStr (str, start) > 0 Then
Select Case N
Case 0
strtemp = Right (str, Len (str)-INSTR (str, start)-Len (start) + 1)
strtemp = Left (strtemp, InStr (strtemp, last)-1)
Case Else
strtemp = Right (str, Len (str)-INSTR (str, start) + 1)
strtemp = Left (strtemp, InStr (strtemp, last) + Len (last)-1)
End Select
Else
strtemp = ""
End If
Fixstr = strtemp
End Function
Public Function removehtml (ByVal strcontent)
Dim Objreg, strtmp
If strcontent= "" OR ISNull (strcontent) Then Exit Function
Set objreg=new REGEXP
Objreg.ignorecase =true
Objreg.global=true
Objreg.pattern= "< (. [ ^>]*) > "
Strtmp=objreg.replace (Strcontent, "")
Set objreg=nothing
Removehtml=strtmp
Strtmp= ""
End Function
Public Function getip (IP)
strHTML = Getpage2 ("http://www.ip138.cn/index.php?ip=" &trim (IP) & "")
strHTML = Fixstr (strhtml, "Query results <br><br>", "<br><br>", 0)
GetIP = Replace (removehtml (strhtml), Trim (IP), "")
End Function
%> |
