电信网通自动跳转程序(ASP类一)

<%
'-------------------------------------------------------------------------------------------------------------
' BOLOGE电信网通自动跳转程序ASP类
' 开发时间：2006年10月19日
' 技术支持QQ：475759155 Emaol:WebMaster@Bologe.Com
' set g = new GotoURL
' g.CheckUrl   = "http://www.ip138.com/ips8.asp"                          '获取IP地址的坚持地址（一般不改）
' g.CheckValue = "action=2&ip="&request.ServerVariables("REMOTE_ADDR")    '用于获取检测必须的（一般不改）
' g.TagS   = "查询结果1"             '用于判断返回信息关键标签的开始部分（一般不改）
' g.TagE   = "</li>"                                                '用于判断返回信息关键标签的结束部分（一般不改）
' g.url1   = "http://www.tc711.com"                                '电信用户跳转URL
' g.url2   = "http://tc711.com"                                '非电信用户跳转URL
' g.Run
'---------------------------------------------------------------------------------------------------------------
Class GotoURL
Public url1,url2,CheckUrl,CheckValue,TagS,TagE
Private Function Bologe_GetContent(Url)
  Dim Obj
  Set ōbj = Server.CreateObject("MSXML2.XMLHTTP")
  With Obj
   .Open "POST", Url, false
   .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   .Send CheckValue
  End With
  if Obj.Readystate <> 4 then
   Set ōbj = Nothing
   Bologe_GetContent = False
   Exit Function
  end if
  Bologe_GetContent = Bologe_ResSTS(Obj.ResponseBody)
  Set ōbj = Nothing
End Function

Private Function Bologe_ResSTS(Str)
  Dim ADOStreamObj
  Set ADOStreamObj = Server.CreateObject("Adodb.Stream")
  ADOStreamObj.Type = 1
  ADOStreamObj.Mode = 3
  ADOStreamObj.Open
  ADOStreamObj.Write Str
  ADOStreamObj.Position = 0
  ADOStreamObj.Type = 2
  ADOStreamObj.Charset = "GB2312"
  Bologe_ResSTS = ADOStreamObj.ReadText
  ADOStreamObj.Close
  Set ADOStreamObj = Nothing
End Function

Private Function GetContent(Str,StartStr,LastStr,Flag)
  On Error Resume next
  if Instr(LCase(Str),LCase(StartStr)) > 0 then
   Dim regEx,SearchStr,Matches,Matche
   Str = Replace(Replace(Str,Chr(13),""),Chr(10),"")
   StartStr = Replace(StartStr,"[变量]",".*")
   LastStr = Replace(LastStr,"[变量]",".*")
   SearchStr = StartStr & ".*" & LastStr
   Set regEx = New RegExp
   regEx.IgnoreCase = True
   regEx.Global=True
   regEx.Pattern = SearchStr
   Set Matches = regEx.Execute(str)
   set Matche = Matches(0)
   Select Case Flag
    Case 0 '不包括首尾特征字符
     GetContent = Matche
     regEx.Pattern = StartStr
     GetContent = regEx.Replace(GetContent,"")
     regEx.Pattern = LastStr & ".*|\n"
     GetContent = regEx.Replace(GetContent,"")
    Case 1 '包括首尾特征字符
     GetContent = Matche
    Case 2 '取开始字符后面的所有内容
     GetContent = Matche
     regEx.Pattern = StartStr
     GetContent = regEx.Replace(GetContent,"")
    Case else
     GetContent = ""
   End Select
  else
   GetContent = ""
  end if
  if Err then
   Err.clear
   GetContent = ""
  End If
End Function

Public Function Run()
  r=Request.Cookies("BologeComFrom")
  if r="" or IsEmpty(r) then
   r=GetContent(Bologe_GetContent(CheckUrl),TagS,TagE,2)
   Response.Cookies("BologeComFrom")=r
  end if
  if instr(r,"电信")>0 then
   Response.Redirect url1
  else
   Response.Redirect url2
  end if
End Function
end class
'-------开始调用了---------------------------------------------------------------------------------
set g = new GotoURL
g.CheckUrl   = "http://www.ip138.com/ips8.asp"                        '获取IP地址的坚持地址（一般不改）
g.CheckValue = "action=2&ip="&request.ServerVariables("REMOTE_ADDR") '用于获取检测必须的（一般不改）
g.TagS   = "查询结果1"             '用于判断返回信息关键标签的开始部分（一般不改）
g.TagE   = "</li>"                                                '用于判断返回信息关键标签的结束部分（一般不改）
g.url1   = "http://www.tc711.com"                                '电信用户跳转URL
g.url2   = "http://tc711.com"                                '非电信用户跳转URL
g.Run
%>