'可修改设置一：========================定义数据库类别，1为SQL数据库，0为Access数据库=============================
Const IsSqlDataBase = 0
'================================================================================================================
If IsSqlDataBase = 1 Then
'必修改设置二：========================SQL数据库设置=============================================================
'sql数据库连接参数：数据库名(SqlDatabaseName)、用户密码(SqlPassword)、用户名(SqlUsername)、
'连接名(SqlLocalName)（本地用local，外地用IP）
Const SqlDatabaseName = "dgesw"
Const SqlPassword = "dgesw"
Const SqlUsername = "dgesw"
Const SqlLocalName = "(local)"
'================================================================================================================
SqlNowString = "GetDate()"
Else
'必修改设置三：========================Access数据库设置==========================================================
Db = "data/data.mdb"
'================================================================================================================
SqlNowString = "Now()"
End If
Sub ConnectionDatabase
Dim ConnStr
If IsSqlDataBase = 1 Then
ConnStr = "Provider = Sqloledb; User ID = " & SqlUsername & "; Password = " & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source = " & SqlLocalName & ";"
Else
ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(MyDbPath & db)
End If
On Error Resume Next
Set conn =server.createobject("ADODB.Connection")
conn.open ConnStr
If Err Then
err.Clear
Set Conn = Nothing
Response.Write "system error"
Response.End
End If
End Sub
set rs=server.CreateObject("adodb.recordset")
Sub CloseDatabase()
If IsObject(Conn) Then Conn.Close
Set Conn = Nothing
End Sub
Public Function Checkstr(Str)
If Isnull(Str) Then
CheckStr = ""
Exit Function
End If
Str = Replace(Str,Chr(0),"")
CheckStr = Replace(Str,"'","''")
End Function
Private Function getIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
actforip=Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
actforip=Request.ServerVariables("REMOTE_ADDR")
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
actforip=Request.ServerVariables("REMOTE_ADDR")
End If
getIP = CheckStr(Trim(Mid(strIPAddr, 1, 30)))
End Function
Rem 判断发言是否来自外部
Public Function ChkPost()
Dim server_v1,server_v2
Chkpost=False
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 Chkpost=True
End Function
Public Function Createpass()'系统分配随机密码
Dim Ran,i,LengthNum
LengthNum=16
Createpass=""
For i=1 To LengthNum
Randomize
Ran = CInt(Rnd * 2)
Randomize
If Ran = 0 Then
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)
End If
Next
End Function
'去掉HTML标记
Public Function Replacehtml(Textstr)
Dim Str,re
Str=Textstr
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="<(.[^>]*)>"
Str=re.Replace(Str, "")
Set Re=Nothing
Replacehtml=Str
End Function
Public Function iHTMLEncode(fString)
If Not IsNull(fString) Then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
'fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "
")
fString = Replace(fString, CHR(10), "
")
iHTMLEncode = fString
End If
End Function
Public Function CheckNumeric(Byval CHECK_ID)
If CHECK_ID<>"" and IsNumeric(CHECK_ID) Then _
CHECK_ID = cCur(CHECK_ID) _
Else _
CHECK_ID = 0
CheckNumeric = CHECK_ID
End Function
Public Function strLength(str)
If isNull(str) Or Str = "" Then
StrLength = 0
Exit Function
End If
Dim WINNT_CHINESE
WINNT_CHINESE=(len("例子")=2)
If WINNT_CHINESE Then
Dim l,t,c
Dim i
l=len(str)
t=l
For i=1 To l
c=asc(mid(str,i,1))
If c<0 Then c=c+65536
If c>255 Then t=t+1
Next
strLength=t
Else
strLength=len(str)
End If
End Function
Function strCut(str,strlen)
Dim l,t,c,i
'On Error Resume Next
str = Replacehtml(str) Rem 去掉HTML标记
l=len(str):t=0
For i=1 To l
c=Abs(Asc(Mid(str,i,1)))
If c>255 Then
t=t+2
Else
t=t+1
End If
If t>=strlen Then
strCut=left(str,i)&"..."
Exit Function
Else
strCut=str
End If
Next
strCut=Left(str,strlen)
End Function
'取得带端口的URL
Property Get Get_ScriptNameUrl()
If request.servervariables("SERVER_PORT")="80" Then
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
Else
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
End If
End Property
'是否真正的搜索引擎
Public Function IsWebSearch()
IsWebSearch = False
Dim Botlist,i
BotList = "Google,Isaac,SurveyBot,Baiduspider,yahoo,yisou,3721,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir"
Botlist = Split(Botlist,",")
For i = 0 To Ubound(Botlist)
If InStr(Lcase(Request.ServerVariables("HTTP_USER_AGENT")),Lcase(Botlist(i))) > 0 Then
IsWebSearch = True
Exit For
End If
Next
End Function
'------------------检查某一目录是否存在-------------------
Function CheckDir(FolderPath)
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso1 = CreateObject("Scripting.FileSystemObject")
If fso1.FolderExists(FolderPath) then
'存在
CheckDir = True
Else
'不存在
CheckDir = False
End if
Set fso1 = nothing
End Function
'-------------根据指定名称生成目录-----------------------
Function MakeNewsDir(foldername)
dim f
MakeNewsDir = False
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set f = fso1.CreateFolder(foldername)
MakeNewsDir = True
Set fso1 = nothing
End Function
下一篇：了解CSS挂马及相应防范方法
