一个asp代码分享，虚似主机绑多个独立企业站方法

最新推荐文章于 2021-06-04 12:22:22 发布

自律-少年

最新推荐文章于 2021-06-04 12:22:22 发布

阅读量128

点赞数

文章标签： asp

本文链接：https://blog.csdn.net/3650798/article/details/105385721

版权

企业站点流量不大，有些备案麻烦，就买个香港空间代替也不错，但一个主机放一个有点浪费，想出这个法子，asp 已经落后了，都没个代码可选。。。

<%@ CODEPAGE=65001%>
<%Response.CodePage=65001%>
<%Response.Charset="UTF-8"%>
<%
Function GetHttpPage(HttpUrl)
   If IsNull(HttpUrl)=True Or HttpUrl="$False$" Then
      GetHttpPage="$False$"
      Exit Function
   End If
   Dim Http
   Set Http=server.createobject("MSXML2.XMLHTTP")
   Http.open "GET",HttpUrl,False
   Http.Send()
   If Http.Readystate<>4 then
      Set Http=Nothing 
      GetHttpPage="$False$"
      Exit function
   End if
   GetHTTPPage=bytesToBSTR(Http.responseBody,"utf-8")
   Set Http=Nothing
   If Err.number<>0 then
      Err.Clear
   End If
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 GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
   If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then
      GetBody="$False$"
      Exit Function
   End If
   Dim ConStrTemp
   Dim Start,Over
   ConStrTemp=Lcase(ConStr)
   StartStr=Lcase(StartStr)
   OverStr=Lcase(OverStr)
   Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
   If Start<=0 then
      GetBody="$False$"
      Exit Function
   Else
      If IncluL=False Then
         Start=Start+LenB(StartStr)
      End If
   End If
   Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
   If Over<=0 Or Over<=Start then
      GetBody="$False$"
      Exit Function
   Else
      If IncluR=True Then
         Over=Over+LenB(OverStr)
      End If
   End If
   GetBody=MidB(ConStr,Start,Over-Start)
End Function

Dim domainname
domainname=Request.ServerVariables("HTTP_HOST")

select case domainname
case "www.tangzuji.com" '条件1
HttpUrl="http://tangzuji.jdztci.com/"
case "www.zhongchunming.com" '条件2
HttpUrl="http://zhongchunming.jdztci.com/"
case else '上面都查不到情况下执行
HttpUrl="http://www.jdztci.com/"
end select

StartGet = GetHttpPage(HttpUrl)	
List=GetBody(StartGet,"<!DOCTYPE html>","</html>",False,False)
'List=replace(List,urlname,domainname)

If List<>"$False$" Then
Response.write "<!DOCTYPE html>"
Response.write List
Response.write "</html>"
else
Response.write "404"
End If
%>

这上面是二个客人的宣传页面，其实也没流量，汤祖继陶瓷艺术官网钟春明陶瓷艺术官网胡杨红陶瓷艺术官网

http://www.zhongchunming.com/

http://www.tangzuji.com/

http://www.huyanghong.com/

这个是首页，也可以做成读取保存本地的html来显示，速度上会更快些