以前写的一个东西。可以通过服务器访问服务器能访问的网站页面，比如服务器内部网络的站点，等等。
访问方法：文件名后加 ?url=要访问的地址
例如：PageWebProxy.asp?url=http://192.168.1.1/index.asp(当然，前边的域名和相关路径也不可少)
源代码如下：
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>web代理</title>
</head>
<body>
<%
PageWebProxy()
Sub PageWebProxy()
Dim i, re, Html
Response.Clear()
If sUrl <> "" Then Url = sUrl Else Url = Request.QueryString("url")
If Url = "" Then Response.Redirect("?url=http://www.shanrui.net/")
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
sUrlB = Url
Html = getHTTPPage(Url)
If sUrl <> "" Then Echo Html:Response.End()
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")
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#", "&#")
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\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)"
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, "")
re.Pattern = ">\?url=((http|https|javascript):[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)<"
Html = re.Replace(Html, ">$1<")
Echo Html
End Sub
Function GetHTTPPage(url)
Dim Http, x, theStr, fileExt
Set Http = Server.CreateObject("MSXML2.XMLHTTP")
If Request.Form.Count > 0 Then
For Each x In Request.Form
theStr = theStr & UrlEncode(x) & "=" & UrlEncode(Request.Form(x)) & "&"
Next
Http.Open "POST", url, False
Http.SetRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
Http.Send(theStr)
Else
On Error Resume Next
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
Sub Echo(sStr)
Response.Write sStr
End Sub
%>
</body>
</html>