<%
' 判断提交是否來自外部
Öffentliche Funktion ChkPost()
Dimmen Sie server_v1,server_v2
Chkpost=Falsch
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
Wenn Mid(server_v1,8,len(server_v2))=server_v2, dann ist Chkpost=True
Funktion beenden
'系统分配随机密码
Öffentliche Funktion Createpass()
Dim Ran,i,LengthNum
LängeNum=16
Createpass=""
Für i=1 bis LengthNum
Randomisieren
Ran = CInt(Rnd * 2)
Randomisieren
Wenn Ran = 0, dann
Ran = CInt(Rnd * 25) + 97
Createpass =Createpass& UCase(Chr(Ran))
ElseIf Ran = 1 Then
Ran = CInt(Rnd * 9)
Createpass = Createpass & Ran
ElseIf Ran = 2 Then
Ran = CInt(Rnd * 25) + 97
Createpass =Createpass& Chr(Ran)
Ende wenn
Nächste
Funktion beenden
'重写ausführen
Rem-Funktion
Öffentliche Funktion Execute (Befehl)
Wenn nicht IsObject(Conn), dann ConnectionDatabase
'检查权限，防止注入攻击
Wenn InStr(LCase(Command),"dv_admin")>0 And Left(ScriptName,6)<> "admin_" Then
Response.Write SaveSQLLOG(Command,"")
Command=Replace(LCase(Command),"dv_admin","dv<i>"&Chr(95)&"</i>admin")
Ende wenn
Wenn IsDeBug = 0, dann
Bei Fehler Weiter fortsetzen
Set Execute = Conn.Execute(Befehl)
Wenn Sie sich irren, dann
ähm.Klar
Setzen Sie Conn = Nothing
Response.Write SaveSQLLOG(Command,“Die Antwort lautet:“示本信息, 要查看详细的错误信息, 请修改您的程序文件conn.asp。把""Const IsDeBug = 0""改为:""Const IsDeBug = 1""")
Antwort.Ende
Ende wenn
Anders
'Response.Write-Befehl & „<br>“
Set Execute = Conn.Execute(Befehl)
Ende wenn
SqlQueryNum = SqlQueryNum+1
Endfunktion
'记录查询错误事件
Öffentliche Funktion SaveSQLLOG(sCommand,message)
Dimmen Sie lConnStr,lConn,ldb,SQL,RS
ldb = "data/DvSQLLOG.mdb"
lConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(ldb)
Setze lConn = Server.CreateObject("ADODB.Connection")
lConn.Open lConnStr
Setze Rs = Server.CreateObject("adodb.recordset")
Sql="select * from dv_sql_log"
Rs.open sql,lconn,1,3
Rs.addnew
Rs("ScriptName")=ScriptName
Rs("S_Info")=Left(sCommand,255)
Rs("ip")=UserTrueIP
RS.Update
Rs.schließen
lConn.Execute(SQL)
lConn.Close
Setzen Sie lConn = Nothing
SaveSQLLOG = Nachricht
Endfunktion
'IP来源
Öffentliche Funktionsadresse (SIP)
Dim aConnStr,aConn,adb
Dimmen Sie str1, str2, str3, str4
Dim Num
Düsteres Land, Stadt
Dim irs,SQL
If IsNumeric(Left(sip,2)) Then
Wenn sip="127.0.0.1" Dann sip="192.168.0.1"
str1=Left(sip,InStr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str2=Left(sip,instr(sip,".")-1)
sip=Mid(sip,InStr(sip,".")+1)
str3=Left(sip,instr(sip,".")-1)
str4=Mid(sip,instr(sip,".")+1)
Wenn isNumeric(str1)=0 oder isNumeric(str2)=0 oder isNumeric(str3)=0 oder isNumeric(str4)=0 Dann
Anders
num=CLng(str1)*16777216+CLng(str2)*65536+CLng(str3)*256+CLng(str4)-1
adb = „data/ipaddress.mdb“
aConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(adb)
Setze AConn = Server.CreateObject("ADODB.Connection")
aConn.Open aConnStr
sql="Wählen Sie Top 1 Land, Stadt aus dv_address aus, wobei ip1 <="&num&" und ip2 >="&num&""
Setze irs=aConn.execute(sql)
Wenn irs.EOF und irs.bof dann
Land="亚洲"
Stadt=""
Anders
Land=irs(0)
Stadt=irs(1)
Ende wenn
Setze irs=Nothing
Setze aConn = Nothing
SqlQueryNum = SqlQueryNum+1
Ende wenn
Adresse=Land&Stadt
Anders
Adresse="Adresse"
Ende wenn
Funktion beenden
'用于用户发布的各种信息过滤,带脏话过滤
Öffentliche Funktion HTMLEncode(fString)
Wenn nicht IsNull(fString) dann
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replacement(fString, CHR(32), " ") '
fString = Replacement(fString, CHR(9), " ") '
fString = Ersetzen(fString, CHR(34), """)
fString = Replacement(fString, CHR(39), "'") '过滤单引号
fString = Ersetzen(fString, CHR(13), "")
fString = Replacement(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replacement(fString, CHR(10), "<BR> ")
fString=ChkBadWords(fString)
HTMLEncode = fString
Ende wenn
Funktion beenden
'用于论坛本身的过滤，不带脏话过滤
Öffentliche Funktion iHTMLEncode(fString)
Wenn nicht IsNull(fString) dann
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Ersetzen(fString, CHR(32), " ")
fString = Ersetzen(fString, CHR(9), " ")
fString = Ersetzen(fString, CHR(34), """)
fString = Ersetzen(fString, CHR(39), "'")
fString = Ersetzen(fString, CHR(13), "")
fString = Replacement(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replacement(fString, CHR(10), "<BR> ")
iHTMLEncode = fString
Ende wenn
Funktion beenden
Öffentliche Funktion strLength(str)
Wenn isNull(str) oder Str = "" Dann
StrLength = 0
Exit-Funktion
Ende wenn
Dimmen Sie WINNT_CHINESE
WINNT_CHINESE=(len("例子")=2)
Wenn WINNT_CHINESE Dann
Dim l,t,c
Dim ich
l=len(str)
t=l
Für i=1 bis l
c=asc(mid(str,i,1))
Wenn c<0, dann ist c=c+65536
Wenn c>255, dann ist t=t+1
Nächste
strLength=t
Anders
strLength=len(str)
Ende wenn
Funktion beenden
Öffentliche Funktion ChkBadWords(Str)
Wenn IsNull(Str), dann Funktion beenden
Dim ich
Für i = 0 bis Ubound(BadWords)
Wenn i > UBound(rBadWord) Dann
Str = Ersetzen(Str,BadWords(i),"*")
Anders
Str = Ersetzen(Str,BadWords(i),rBadWord(i))
Ende wenn
Nächste
ChkBadWords = Str
Funktion beenden
Öffentliche Funktion Checkstr(Str)
Wenn Isnull(Str) Dann
CheckStr = ""
Exit-Funktion
Ende wenn
CheckStr = Ersetzen(Str,"'","''")
Funktion beenden
'取得带端口的URL，推荐使用
Eigenschaft Get Get_ScriptNameUrl()
Wenn request.servervariables("SERVER_PORT")="80" Dann
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
Anders
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&"&"&request.servervariables("SERVER_PORT")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
Ende wenn
End Property
'检查Email地址有效性
Funktion IsValidEmail(email)
dunkle Namen, Name, i, c
IsValidEmail = true
Namen = Split(E-Mail, „@“)
wenn UBound(names) <> 1 dann
IsValidEmail = false
Exit-Funktion
Ende wenn
für jeden Namen in Namen
wenn Len(name) <= 0 dann
IsValidEmail = false
Exit-Funktion
Ende wenn
für i = 1 zu Len(name)
c = Lcase(Mid(name, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 und nicht IsNumeric(c), dann
IsValidEmail = false
Exit-Funktion
Ende wenn
nächste
if Left(name, 1) = "." oder Right(name, 1) = "." Dann
IsValidEmail = false
Exit-Funktion
Ende wenn
nächste
wenn InStr(names(1), ".") <= 0 dann
IsValidEmail = false
Exit-Funktion
Ende wenn
i = Len(names(1)) - InStrRev(names(1), ".")
wenn i <> 2 und i <> 3 dann
IsValidEmail = false
Exit-Funktion
Ende wenn
wenn InStr(email, "..") > 0 dann
IsValidEmail = false
end if
end function
function strLength(str)
BEI FEHLER WEITERFAHREN
dimmen Sie WINNT_CHINESE
WINNT_CHINESE = (len("论坛")=2)
wenn WINNT_CHINESE dann
dim l,t,c
dim ich
l=len(str)
t=l
für i=1 bis l
c=asc(mid(str,i,1))
wenn c<0, dann c=c+65536
wenn c>255 dann
t=t+1
Ende wenn
nächste
strLength=t
anders
strLength=len(str)
Ende wenn
Wenn err.number<>0, dann err.clear
Endfunktion
Funktion cutStr(str,strlen)
dim l,t,c
l=len(str)
t=0
für i=1 bis l
c=Abs(Asc(Mid(str,i,1)))
wenn c>255 dann
t=t+2
anders
t=t+1
Ende wenn
wenn t>=strlen dann
cutStr=left(str,i)&"..."
Ausgang für
anders
cutStr=str
Ende wenn
nächste
cutStr=replace(cutStr,chr(10),"")
Endfunktion
Funktion fixjs(Str)
Wenn Str <>"" Dann
str = ersetzen(str,"", "\")
Str = replace(str, chr(34), """")
Str = replace(str, chr(39),"'")
Str = Ersetzen(str, chr(13), "n")
Str = Ersetzen(str, chr(10), "r")
str = ersetzen(str,"'", "'")
Ende wenn
fixjs=Str
Funktion beenden
Funktion enfixjs(Str)
Wenn Str <>"" Dann
Str = ersetzen(str,"'", "'")
Str = replace(str,"""" , chr(34))
Str = replace(str, "'",chr(39))
Str = Ersetzen(str, "r", chr(10))
Str = Ersetzen(str, "n", chr(13))
Str = ersetzen(str,"\", "")
Ende wenn
enfixjs=Str
Funktion beenden
Klasse Cls_Browser
Öffentlicher Browser, Version, Plattform
Private Sub Class_Initialize()
Browser="unbekannt"
version="unbekannt"
Plattform="unbekannt"
Schwacher Agent
Agent=Request.ServerVariables("HTTP_USER_AGENT")
Agent=Split(Agent,";")
Wenn InStr(Agent(1),"MSIE")>0 Dann
Browser="Microsoft Internet Explorer "
version=Trim(Left(Replace(Agent(1),"MSIE",""),6))
ElseIf InStr(Agent(4),"Netscape")>0 Then
Browser="Netscape "
Tmpstr dimmen
tmpstr=Split(Agent(4),"/")
version=tmpstr(UBound(tmpstr))
Ende wenn
Wenn InStr(Agent(2),"NT 5.2")>0 Dann
platform="Windows 2003"
ElseIf InStr(Agent(2),"NT 5.1")>0 Then
platform="Windows XP"
ElseIf InStr(Agent(2),"NT 5.0")>0 Then
platform="Windows 2000"
ElseIf InStr(Agent(2),"9x")>0 Then
platform="Windows ME"
ElseIf InStr(Agent(2),"98")>0 Then
platform="Windows 98"
ElseIf InStr(Agent(2),"95")>0 Then
platform="Windows 95"
Ende wenn
'记录未知Agent
Wenn Browser = „unbekannt“ oder Version = „unbekannt“ oder Plattform = „unbekannt“, dann
Agent=Dvbbs.checkStr(Request.ServerVariables("HTTP_USER_AGENT"))
Dimmen Sie lConnStr,lConn,ldb
ldb = "data/DvSQLLOG.mdb"
lConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(ldb)
Setze lConn = Server.CreateObject("ADODB.Connection")
lConn.Open lConnStr
lConn.Execute("insert into [Agent](UserAgent)Values('" & Agent & "')")
lConn.Close
Setzen Sie lConn = Nothing
Ende wenn
Sub beenden
Klasse beenden
%>