使用方法:webproxy.asp?url=http://网址
<%
Response.Buffer = True
Dim sUrlB
PageWebProxy()
Sub PageWebProxy()
Dim i, re, Url, Html
Url = Request.QueryString("url")
If Url = "" Then Response.Redirect("?url=http://www.gdqy.edu.cn/")
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
sUrlB = Url
Html = getHTTPPage(Url)
Url = Left(Url, InStrRev(Url, "/"))
i = InStr(sUrlB, "?")
If i > 0 Then
sUrlB = Left(sUrlB, i - 1)
End If
re.Pattern = "(href|action)=('|"")?(?)"
Html = re.Replace(Html,"$1=$2" & sUrlB & "?")
re.Pattern = "(src|action|href)=('|"")?((http|https|javascript):[A-Za-z0-9./=?%-&_~`@[]':+!]+([^<>""])+)('|"")?"
Html = re.Replace(Html,"$1x=$2$3$2")
re.Pattern = "(window.open|url)(('|"")?((http|https):(//|\\)[A-Za-z0-9./=?%-&_~`@[]:+!]+([^'<>""])+)('|"")?)"
Html = re.Replace(Html,"$1x($2$3$2)")
re.Pattern = "(src|action|href|background)=('|"")?([^/""'][A-Za-z0-9./=?%-&_~`@[]:+!]+([^'<>""])+)('|"")?"
Html = re.Replace(Html,"$1=$2" & Url & "$3$2")
re.Pattern = "(src|action|href|background)=('|"")?/([^""'][A-Za-z0-9./=?%-&_~`@[]:+!]+([^'<>""])+)('|"")?"
Html = re.Replace(Html,"$1=$2http://" & Split(Url, "/")(2) & "/$3$2")
re.Pattern = "(src|action|href)=('|"")?/('|"")?"
Html = re.Replace(Html,"$1=$2http://" & Split(Url, "/")(2) & "/$2")
re.Pattern = "(window.open|url)(('|"")?([^/""'http:][A-Za-z0-9./=?%-&_~`@[]+!]+([^'<>""])+)('|"")?)"
Html = re.Replace(Html,"$1($2" & Url & "$3$2)")
re.Pattern = "(window.open|url)(('|"")?/([^""'http:][A-Za-z0-9./=?%-&_~`@[]+!]+([^'<>""])+)('|"")?)"
Html = re.Replace(Html,"$1($2http://" & Split(Url, "/")(2) & "/$3$2)")
Html = Replace(Html, "&", "%26")
' If Split(Url, "/")(2) = "club.isso.com.cn" Then
' Html = Replace(Html, "%26amp;", "%26")
' Else
Html = Replace(Html, "%26amp;", "&")
' End If
Html = Replace(Html, "%26nbsp;", " ")
Html = Replace(Html, "%26lt;", "<")
Html = Replace(Html, "%26gt;", ">")
Html = Replace(Html, "%26quot;", """)
Html = Replace(Html, "%26copy;", "©")
Html = Replace(Html, "%26reg;", "®")
Html = Replace(Html, "%26raquo;", "»")
Html = Replace(Html, "%26%26", "&&")
Html = Replace(Html, "%26#", "&#")
' Html = Replace(Html, "%26", "")
re.Pattern = "(src|action|href)x=('|"")?((http|https|javascript):[A-Za-z0-9./=?%-&_~`@[]':+!]+([^<>""])+)('|"")?"
Html = re.Replace(Html,"$1=$2$3$2")
re.Pattern = "((http|https):(//|\\)[A-Za-z0-9./=?%-&_~`@[]':+!]+([^<>""])+)" '"(gif|jpg|bmp|png))"
Html = re.Replace(Html,"?url=$1")
re.Pattern = "?url=" & Url & "(#|javascript:)"
Html = re.Replace(Html,"$1")
re.Pattern = "multipart/form-data"
Html = re.Replace(Html,"")
Response.Write(Html)
End Sub
Function getHTTPPage(url)
Dim Http, theStr, fileExt
Set Http = Server.CreateObject("MSXML2.XMLHTTP")
If Request.Form.Count > 0 Then
For Each x In Request.Form
theStr = theStr & Server.UrlEncode(x) & "=" & Server.UrlEncode(Request.Form(x)) & "&"
Next
Http.Open "POST", url, False
Http.SetRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
Http.Send(theStr)
Else
Http.Open "GET", url, False
Http.Send()
End If
If Http.readystate<>4 then Exit Function
fileExt = LCase(Mid(url, InStrRev(url, ".") + 1))
If InStr("$jpg$gif$bmp$png$js$", "$" & fileExt & "$") > 0 Then
Response.Clear
Response.BinaryWrite Http.responseBody
Response.End()
Else
If InStr("$rar$mdb$zip$exe$com$ico$", "$" & fileExt & "$") > 0 Then
Response.AddHeader "Content-Disposition", "Attachment; Filename=" & Mid(sUrlB, InStrRev(sUrlB, "/") + 1)
Response.BinaryWrite Http.responseBody
Response.Flush
Else
getHTTPPage = bytesToBSTR(Http.responseBody, "GB2312")
End If
End If
Set Http = 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
%>