<%@LANGUAGE="VBScript" CODEPAGE="65001"%>
<%
Session.CodePage=65001
Response.Charset="utf-8"
Response.Expires=-1
%>
<%
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 "":Response.End
If Not IsNumeric(c_loginid) Or Not IsNumeric(c_loginpower) Then Response.Write "":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 "":Rscl.Close:Set Rscl=Nothing:Conn.Close:Set Conn=Nothing:Response.End
If Rscl(0)=0 Then Response.Write "":Rscl.Close:Set Rscl=Nothing:Conn.Close:Set Conn=Nothing:Response.End
If Rscl(1)<>Cint(c_loginpower) Then Response.Write "":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 "":Rscl.Close:Set Rscl=Nothing:Conn.Close:Set Conn=Nothing:Response.End
If Rscl(0)=0 Then Response.Write "":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 "":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 "":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 =""
t0=Regs.Replace(t0,"")
Regs.pattern =""
t0=Regs.Replace(t0,"")
'再过滤其他
t0=Replace(t0,"<","<")
t0=Replace(t0,">",">")
Regs.Pattern="<.+?>"
Set Matches=Regs.Execute(t0)
For Each Match In Matches
t0=Replace(t0,Match.value,"")
Next
t0=Replace(t0," ","")
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,"&","&")
t0=Replace(t0,"""",""")
t0=Replace(t0,"<","<")
t0=Replace(t0,">",">")
t0=Replace(t0," "," ")
Txt2HTML = t0
End Function
Function HTML2Txt(ByVal t0)
IF IsNull(t0) Or Len(t0)<0 Or IsArray(t0) Then Exit Function
t0=Replace(t0,""","""")
t0=Replace(t0,"<","<")
t0=Replace(t0,">",">")
t0=Replace(t0," "," ")
t0=Replace(t0,"&","&")
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),"&") '“&” 这个在第一防止重复替换下面的内容
t0=Replace(t0,CHR(9)," ") '“tab(水平制表符)”
t0=Replace(t0,CHR(11)," ") '“tab(垂直制表符) ”
t0=Replace(t0,CHR(10),"
") '“换行”
t0=Replace(t0,CHR(13),"
") '“回车”
t0=Replace(t0,CHR(32)," ") '“ ”
t0=Replace(t0,CHR(34),""") '“"”
t0=Replace(t0,CHR(37),"%") '“%”
t0=Replace(t0,CHR(39),"'") '“'”
t0=Replace(t0,CHR(40),"(") '“(”
t0=Replace(t0,CHR(41),")") '“)”
t0=Replace(t0,CHR(60),"<") '“<”
t0=Replace(t0,CHR(62),">") '“>”
t0=Replace(t0,CHR(91),"[") '“[”
t0=Replace(t0,CHR(93),"]") '“]”
t0=Replace(t0,CHR(94),"^") '“^”
t0=Replace(t0,CHR(95),"_") '“_”
t0=Replace(t0,CHR(123),"{") '“{”
t0=Replace(t0,CHR(124),"|") '“|”
t0=Replace(t0,CHR(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," ",CHR(9)) '“tab(水平制表符)”
t0=Replace(t0," ",CHR(11)) '“tab(垂直制表符) ”
t0=Replace(t0,"
",CHR(10)) '“换行”
t0=Replace(t0,"
",CHR(13)) '“回车”
t0=Replace(t0," ",CHR(32)) '“ ”
t0=Replace(t0,""",CHR(34)) '“"”
t0=Replace(t0,"%",CHR(37)) '“%”
t0=Replace(t0,"'",CHR(39)) '“'”
t0=Replace(t0,"(",CHR(40)) '“(”
t0=Replace(t0,")",CHR(41)) '“)”
t0=Replace(t0,"<",CHR(60)) '“<”
t0=Replace(t0,">",CHR(62)) '“>”
t0=Replace(t0,"[",CHR(91)) '“[”
t0=Replace(t0,"]",CHR(93)) '“]”
t0=Replace(t0,"^",CHR(94)) '“^”
t0=Replace(t0,"_",CHR(95)) '“_”
t0=Replace(t0,"{",CHR(123)) '“{”
t0=Replace(t0,"|",CHR(124)) '“|”
t0=Replace(t0,"}",CHR(125)) '“}”
t0=Replace(t0,"&",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),"&") '“&”
t0=Replace(t0,CHR(32)," ") '“ ”
t0=Replace(t0,CHR(34),""") '“"”
t0=Replace(t0,CHR(37),"%") '“%”
t0=Replace(t0,CHR(39),"'") '“'”
t0=Replace(t0,CHR(40),"(") '“(”
t0=Replace(t0,CHR(41),")") '“)”
t0=Replace(t0,CHR(60),"<") '“<”
t0=Replace(t0,CHR(62),">") '“>”
t0=Replace(t0,CHR(91),"[") '“[”
t0=Replace(t0,CHR(93),"]") '“]”
t0=Replace(t0,CHR(94),"^") '“^”
t0=Replace(t0,CHR(95),"_") '“_”
t0=Replace(t0,CHR(123),"{") '“{”
t0=Replace(t0,CHR(124),"|") '“|”
t0=Replace(t0,CHR(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," ",CHR(32)) '“ ”
t0=Replace(t0,""",CHR(34)) '“"”
t0=Replace(t0,"%",CHR(37)) '“%”
t0=Replace(t0,"'",CHR(39)) '“'”
t0=Replace(t0,"(",CHR(40)) '“(”
t0=Replace(t0,")",CHR(41)) '“)”
t0=Replace(t0,"<",CHR(60)) '“<”
t0=Replace(t0,">",CHR(62)) '“>”
t0=Replace(t0,"[",CHR(91)) '“[”
t0=Replace(t0,"]",CHR(93)) '“]”
t0=Replace(t0,"^",CHR(94)) '“^”
t0=Replace(t0,"_",CHR(95)) '“_”
t0=Replace(t0,"{",CHR(123)) '“{”
t0=Replace(t0,"|",CHR(124)) '“|”
t0=Replace(t0,"}",CHR(125)) '“}”
t0=Replace(t0,"&",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," ",CHR(9)) '“tab(水平制表符)”
t0=Replace(t0," ",CHR(11)) '“tab(垂直制表符) ”
t0=Replace(t0,"
","
") '“换行”
t0=Replace(t0,"
","
") '“换行”
t0=Replace(t0,"
","
") '“回车”
t0=Replace(t0," "," ") '“ ”
t0=Replace(t0,"&",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\>)|(\]+\>)|(\.+?\<\/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
%>