mtb_crm_asp/system/conn.asp

<%@LANGUAGE="VBScript" CODEPAGE="65001"%>
<%
Session.CodePage=65001
Response.Charset="utf-8"
Response.Expires=-1
%>
<!--#include file="Md5.asp"-->
<%
Dim Conn
Set Conn=Server.CreateObject("ADODB.Connection")
Conn.Open "PROVIDER=SQLOLEDB;server=127.0.0.1,1435;uid=crm;pwd=Qweasdzxc;database=crm"
Set Rsinc = Server.CreateObject("ADODB.RecordSet")
Rsinc.Open "Select Top 1 webname,keywords,description,indexwebname,copyright From inc",Conn,1,1
webname=TextUncode(Rsinc(0))
webkeywords=TextUncode(Rsinc(1))
webdescription=TextUncode(Rsinc(2))
indexwebname=TextUncode(Rsinc(3))
copyright=TextUncode(Rsinc(4))
Rsinc.Close:Set Rsinc=Nothing


Dim useid,usename,usesex,usecompany,usetel,useemail

Function Add_Session(t0,t1)
	Session("hjunkel.com"&t0)=t1
End Function

Function Load_Session(t0)
	Load_Session=Session("hjunkel.com"&t0)
End Function


Sub Checklogin(t)

c_loginid = Load_Session("loginid")
c_loginuser = Load_Session("loginuser")
c_loginname = Load_Session("loginname")
c_loginpower = Load_Session("loginpower")

If c_loginid="" Or c_loginuser="" Or c_loginname="" Or c_loginpower="" Then Response.Write "<script>top.location.href='login.asp'</script>":Response.End

If Not IsNumeric(c_loginid) Or Not IsNumeric(c_loginpower) Then Response.Write "<script>top.location.href='login.asp'</script>":Response.End

Set Rscl = Server.CreateObject("ADODB.RecordSet")

Rscl.Open "Select loginstate,loginpower From login Where id="&c_loginid&" And loginuser='"&c_loginuser&"'",Conn,1,1

If Rscl.Bof Or Rscl.Eof Then Response.Write "<script>alert('登陆超时，请重新登陆');top.location.href='login.asp'</script>":Rscl.Close:Set Rscl=Nothing:Conn.Close:Set Conn=Nothing:Response.End

If Rscl(0)=0 Then Response.Write "<script>alert('您的帐号已被系统停用，请联系管理员');top.location.href='login.asp'</script>":Rscl.Close:Set Rscl=Nothing:Conn.Close:Set Conn=Nothing:Response.End

If Rscl(1)<>Cint(c_loginpower) Then Response.Write "<script>alert('您的权限已被更新，请重新登陆');top.location.href='login.asp'</script>":Rscl.Close:Set Rscl=Nothing:Conn.Close:Set Conn=Nothing:Response.End

Rscl.Close

Rscl.Open "Select powerstate,powercontent From power Where id="&c_loginpower,Conn,1,1

If Rscl.Bof Or Rscl.Eof Then Response.Write "<script>alert('您的帐号已被系统停用，请联系管理员');top.location.href='login.asp'</script>":Rscl.Close:Set Rscl=Nothing:Conn.Close:Set Conn=Nothing:Response.End

If Rscl(0)=0 Then Response.Write "<script>alert('您的帐号已被系统停用，请联系管理员');top.location.href='login.asp'</script>":Rscl.Close:Set Rscl=Nothing:Conn.Close:Set Conn=Nothing:Response.End

powercontent=Rscl(1)

Rscl.Close:Set Rscl=Nothing

If Len(t)>0 And Instr(powercontent,t)<=0 Then Response.Write "<script>alert('Sorry，您没有操作该功能的权限');history.back();</script>":Response.End

End Sub


Function Chklogin(t)
Set Rsc2 = Server.CreateObject("ADODB.RecordSet")
Rsc2.open "Select powercontent From power Where id="&Load_Session("loginpower"),Conn,1,1
If Rsc2.Bof Or Rsc2.Eof Then
Rsc2.Close:Set Rsc2=Nothing
ChkLogin=False
Else
If Len(t)>0 And Instr(Rsc2("powercontent"),t)<=0 Then
Rsc2.Close:Set Rsc2=Nothing
ChkLogin=False
Else
Rsc2.Close:Set Rsc2=Nothing
ChkLogin=True
End If
End If
End Function



Sub CheckPost
'server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) 
'server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) 
'If Mid(server_v1,8,Len(server_v2))<>server_v2 Then Conn.Close:Set Conn=Nothing:Response.Write "<script>alert('对不起，服务器拒绝您的请求');history.back()</script>":Response.End
End Sub

Function GetIp
	GetIp=Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	IF GetIp="" Then GetIp=Request.ServerVariables("REMOTE_ADDR")
	IF Len(GetIp)>15 Then GetIp="UnKnow"
	GetIp=HTMLEncode(GetIp)
End Function

Function RemoveHTML(ByVal t0)
	IF Len(t0)=0 Or IsNull(t0) Then
		Removehtml=""
		Exit Function
	End IF
	Dim Regs,Matches,Match
	Set Regs=New Regexp
	Regs.Ignorecase=True
	Regs.Global=True
	'过滤掉JS,Iframe
	Regs.pattern ="<script.+?/script>"
	t0=Regs.Replace(t0,"")
	Regs.pattern ="<iframe.+?/iframe>"
	t0=Regs.Replace(t0,"")
	'再过滤其他
	t0=Replace(t0,"&lt;","<")
	t0=Replace(t0,"&gt;",">")
	Regs.Pattern="<.+?>"
	Set Matches=Regs.Execute(t0)
	For Each Match In Matches
		t0=Replace(t0,Match.value,"")
	Next
	t0=Replace(t0,"&nbsp;","")
	t0=Replace(t0,vbCrLf,"")
	't0=Replace(t0,"　","")
	't0=Replace(t0," ","")
	t0=Replace(t0,CHR(9),"")
	t0=Replace(t0,CHR(13),"")
	t0=Replace(t0,CHR(10),"")
	t0=Replace(t0,CHR(22),"")
	Set Regs=Nothing
	Removehtml=t0
End Function

Function Txt2HTML(ByVal t0)

	IF IsNull(t0) Or Len(t0)<0 Or IsArray(t0) Then Exit Function

	t0=Replace(t0,"&","&amp;")
	t0=Replace(t0,"""","&quot;")
	t0=Replace(t0,"<","&lt;")
	t0=Replace(t0,">","&gt;")
	t0=Replace(t0," ","&nbsp;")
	Txt2HTML = t0

End Function

Function HTML2Txt(ByVal t0)

	IF IsNull(t0) Or Len(t0)<0 Or IsArray(t0) Then Exit Function

	t0=Replace(t0,"&quot;","""")
	t0=Replace(t0,"&lt;","<")
	t0=Replace(t0,"&gt;",">")
	t0=Replace(t0,"&nbsp;"," ")
	t0=Replace(t0,"&amp;","&")

	HTML2Txt = t0

End Function

Function HTMLEnCode(ByVal t0)
	IF IsNull(t0) Or Len(t0)<0 Or IsArray(t0) Then Exit Function

	t0=Replace(t0,CHR(38),"&#38;")			'“&” 这个在第一防止重复替换下面的内容

	t0=Replace(t0,CHR(9),"&#9;")			'“tab(水平制表符)”
	t0=Replace(t0,CHR(11),"&#11;")			'“tab(垂直制表符) ”
	t0=Replace(t0,CHR(10),"&#10;")			'“换行”
	t0=Replace(t0,CHR(13),"&#13;")			'“回车”

	t0=Replace(t0,CHR(32),"&#32;")			'“ ”
	t0=Replace(t0,CHR(34),"&#34;")			'“"”
	t0=Replace(t0,CHR(37),"&#37;")			'“%”

	t0=Replace(t0,CHR(39),"&#39;")			'“'”
	t0=Replace(t0,CHR(40),"&#40;")			'“(”
	t0=Replace(t0,CHR(41),"&#41;")			'“)”
	t0=Replace(t0,CHR(60),"&#60;")			'“<”
	t0=Replace(t0,CHR(62),"&#62;")			'“>”
	t0=Replace(t0,CHR(91),"&#91;")			'“[”
	t0=Replace(t0,CHR(93),"&#93;")			'“]”
	t0=Replace(t0,CHR(94),"&#94;")			'“^”
	t0=Replace(t0,CHR(95),"&#95;")			'“_”
	t0=Replace(t0,CHR(123),"&#123;")		'“{”
	t0=Replace(t0,CHR(124),"&#124;")		'“|”
	t0=Replace(t0,CHR(125),"&#125;")		'“}”
	HTMLEnCode=t0
End Function

Function HTMLUnCode(ByVal t0)
	IF IsNull(t0) Or Len(t0)<0 Or IsArray(t0) Then Exit Function

	t0=Replace(t0,"&#9;",CHR(9))			'“tab(水平制表符)”
	t0=Replace(t0,"&#11;",CHR(11))			'“tab(垂直制表符) ”
	t0=Replace(t0,"&#10;",CHR(10))			'“换行”
	t0=Replace(t0,"&#13;",CHR(13))			'“回车”

	t0=Replace(t0,"&#32;",CHR(32))			'“ ”
	t0=Replace(t0,"&#34;",CHR(34))			'“"”
	t0=Replace(t0,"&#37;",CHR(37))			'“%”

	t0=Replace(t0,"&#39;",CHR(39))			'“'”
	t0=Replace(t0,"&#40;",CHR(40))			'“(”
	t0=Replace(t0,"&#41;",CHR(41))			'“)”
	t0=Replace(t0,"&#60;",CHR(60))			'“<”
	t0=Replace(t0,"&#62;",CHR(62))			'“>”
	t0=Replace(t0,"&#91;",CHR(91))			'“[”
	t0=Replace(t0,"&#93;",CHR(93))			'“]”
	t0=Replace(t0,"&#94;",CHR(94))			'“^”
	t0=Replace(t0,"&#95;",CHR(95))			'“_”
	t0=Replace(t0,"&#123;",CHR(123))		'“{”
	t0=Replace(t0,"&#124;",CHR(124))		'“|”
	t0=Replace(t0,"&#125;",CHR(125))		'“}”

	t0=Replace(t0,"&#38;",CHR(38))			'“&”
	HTMLUnCode=t0
End Function

Function TextEncode(ByVal t0)
	IF IsNull(t0) Or Len(t0)<0 Or IsArray(t0) Then Exit Function
	t0=Trim(t0)
	t0=Replace(t0,CHR(8),"")			'“回格”
	t0=Replace(t0,CHR(9),"")			'“tab(水平制表符)”
	t0=Replace(t0,CHR(11),"")			'“tab(垂直制表符) ”
	t0=Replace(t0,CHR(12),"")			'“换页”
	t0=Replace(t0,CHR(10),"")			'“换行”
	t0=Replace(t0,CHR(13),"")			'“回车”

	t0=Replace(t0,CHR(38),"&#38;")			'“&”

	t0=Replace(t0,CHR(32),"&#32;")			'“ ”
	t0=Replace(t0,CHR(34),"&#34;")			'“"”
	t0=Replace(t0,CHR(37),"&#37;")			'“%”

	t0=Replace(t0,CHR(39),"&#39;")			'“'”
	t0=Replace(t0,CHR(40),"&#40;")			'“(”
	t0=Replace(t0,CHR(41),"&#41;")			'“)”
	t0=Replace(t0,CHR(60),"&#60;")			'“<”
	t0=Replace(t0,CHR(62),"&#62;")			'“>”
	t0=Replace(t0,CHR(91),"&#91;")			'“[”
	t0=Replace(t0,CHR(93),"&#93;")			'“]”
	t0=Replace(t0,CHR(94),"&#94;")			'“^”
	t0=Replace(t0,CHR(95),"&#95;")			'“_”
	t0=Replace(t0,CHR(123),"&#123;")		'“{”
	t0=Replace(t0,CHR(124),"&#124;")		'“|”
	t0=Replace(t0,CHR(125),"&#125;")		'“}”

	TextEncode=t0
End Function

Function TextUncode(ByVal t0)
	IF IsNull(t0) Or Len(t0)<0 Or IsArray(t0) Then Exit Function

	t0=Replace(t0,"&#32;",CHR(32))			'“ ”
	t0=Replace(t0,"&#34;",CHR(34))			'“"”
	t0=Replace(t0,"&#37;",CHR(37))			'“%”

	t0=Replace(t0,"&#39;",CHR(39))			'“'”
	t0=Replace(t0,"&#40;",CHR(40))			'“(”
	t0=Replace(t0,"&#41;",CHR(41))			'“)”
	t0=Replace(t0,"&#60;",CHR(60))			'“<”
	t0=Replace(t0,"&#62;",CHR(62))			'“>”
	t0=Replace(t0,"&#91;",CHR(91))			'“[”
	t0=Replace(t0,"&#93;",CHR(93))			'“]”
	t0=Replace(t0,"&#94;",CHR(94))			'“^”
	t0=Replace(t0,"&#95;",CHR(95))			'“_”
	t0=Replace(t0,"&#123;",CHR(123))		'“{”
	t0=Replace(t0,"&#124;",CHR(124))		'“|”
	t0=Replace(t0,"&#125;",CHR(125))		'“}”

	t0=Replace(t0,"&#38;",CHR(38))			'“&”

	TextUncode=t0
End Function

Function HTMLUnCode1(ByVal t0)
	IF IsNull(t0) Or Len(t0)<0 Or IsArray(t0) Then Exit Function

	t0=Replace(t0,"&#9;",CHR(9))			'“tab(水平制表符)”
	t0=Replace(t0,"&#11;",CHR(11))			'“tab(垂直制表符) ”
	t0=Replace(t0,"&#13;&#10;","<br />")			'“换行”
	t0=Replace(t0,"&#10;","<br />")			'“换行”
	t0=Replace(t0,"&#13;","<br />")			'“回车”

	t0=Replace(t0,"&#32;","&nbsp;")			'“ ”
	t0=Replace(t0,"&#38;",CHR(38))			'“&”
	HTMLUnCode1=t0
End Function


Function FormatTime(ttime,tparam)
If Not IsDate(ttime) Then Exit Function
tsrt = tparam
tsrt = Replace(tsrt,"yyyy",Year(ttime))
tsrt = Replace(tsrt,"yy",Right(Year(ttime),2))
tsrt = Replace(tsrt,"mm",Right("0"&Month(ttime),2))
tsrt = Replace(tsrt,"dd",Right("0"&Day(ttime),2))
tsrt = Replace(tsrt,"hh",Right("0"&Hour(ttime),2))
tsrt = Replace(tsrt,"ff",Right("0"&Minute(ttime),2))
tsrt = Replace(tsrt,"ss",Right("0"&Second(ttime),2))
tsrt = Replace(tsrt,"m",Month(ttime))
tsrt = Replace(tsrt,"d",Day(ttime))
tsrt = Replace(tsrt,"h",Hour(ttime))
tsrt = Replace(tsrt,"f",Minute(ttime))
tsrt = Replace(tsrt,"s",Second(ttime))
FormatTime = tsrt
End Function


Function EnMonth(m)
Select case m
Case "1"
  m="Jan"
Case "2"
  m="Feb"
Case "3"
  m="Mar"
Case "4"
  m="Apr"
Case "5"
  m="May"
Case "6"
  m="Jun"
Case "7"
  m="Jul"
Case "8"
  m="Aug"
Case "9"
  m="Sep"
Case "10"
  m="Oct"
Case "11"
  m="Nov"
Case ELSE
  m="Dec"
End Select
EnMonth=m
End Function

Function StrLeft(Str, StrLen)
	Dim L, T, I, C
	If Str = "" Then
		StrLeft = ""
		Exit Function
	End If
	L = Len(Str)
	T = 0
	For i = 1 To L
		C = Abs(AscW(Mid(Str, i, 1)))
		If C>255 Then
			T = T + 2
		Else
			T = T + 1
		End If
		If T> StrLen Then
			StrLeft = Left(Str, i) & ".."
			Exit For
		Else
			StrLeft = Str
		End If
	Next
End Function

Function StrLen(Str)
	If Str = "" Or IsNull(Str) Then
		StrLen = 0
		Exit Function
	Else
		Dim regex
		Set regex = New regexp
		regEx.Pattern = "[^\x00-\xff]"
		regex.Global = True
		Str = regEx.Replace(Str, "^^")
		Set regex = Nothing
		StrLen = Len(Str)
	End If
End Function

Function IsValidEmail(email)

dim names, name, i, c

'Check for valid syntax in an email address.
IsValidEmail = true
names = Split(email, "@")
If UBound(names) <> 1 then
   IsValidEmail = false
   exit Function
end If
for each name in names
   If Len(name) <= 0 then
     IsValidEmail = false
     exit Function
   end If
   for i = 1 to Len(name)
     c = Lcase(Mid(name, i, 1))
     If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
       IsValidEmail = false
       exit Function
     end If
   next
   If Left(name, 1) = "." or Right(name, 1) = "." then
      IsValidEmail = false
      exit Function
   end If
next
If InStr(names(1), ".") <= 0 then
   IsValidEmail = false
   exit Function
end If
i = Len(names(1)) - InStrRev(names(1), ".")
If i <> 2 and i <> 3 then
   IsValidEmail = false
   exit Function
end If
If InStr(email, "..") > 0 then
   IsValidEmail = false
end If

end Function

't0 内容，t1将什么，t2,替换成什么，t3替换的次数
function sitelink_replace(byval t0,byval t1,byval t2,byval t3)
	If t0="" Or IsNull(t0) Then Exit Function
	dim t4:t4=t0

	reg.pattern="(\<a[^<>]+\>.+?\<\/a\>)|(\<img[^<>]+\>)|(\<h[1-6]+[\s]*\>.+?\<\/h[1-6]+\>)"
	set matches=reg.execute(t4)
	dim i:i=0
	dim myarray()
	if matches.count>0 then
		for each match in matches
			redim preserve myarray(i)
			myarray(i)=mid(match.value,1,len(match.value))
			t4=replace(t4,match.value,"["&i&"]",1,t3)
			i=i+1
		next
	end if
	if i=0 Then
		t0=replace(t0,t1,t2,1,t3)
		sitelink_replace=t0
		'Set reg=Nothing
		exit function
	end if
	t4=replace(t4,t1,t2,1,t3)
	for i=0 to ubound(myarray)
		t4=replace(t4,"["&i&"]",myarray(i),1,t3)
	next
	sitelink_replace=t4
end function
%>