ASP常用程序段
作者:wang 日期:2009-10-12
<%
Dim Moonpotato
Set Moonpotato=New Moonpotato_Cls
Class Moonpotato_Cls
Public Badwords,Badwordr
'================================================
'过程名:Writefile
'作 用:导出Excel
'================================================
Public Sub Excel()
Response.Buffer = True
Response.ContentType = "application/vnd.ms-excel"
Response.AddHeader "content-disposition", "inline; filename = "& Session("CompanyName")&Date()&".xls"
End Sub
'================================================
'过程名:Writefile
'作 用:写入文件
'================================================
Public Sub Tclass(id,title,table,choose)
Set Rs=HK.ExeCute ("Select "& id &","& title &" from "& table &" "& choose &"")
Do while not Rs.eof
Response.write ""
Rs.movenext
Loop
Rs.close
Set rs=Nothing
End Sub
'================================================
'过程名:Writefile
'作 用:写入文件
'================================================
Public Sub Readfile(writefile,fileStr)
Dim Fso,F
Set Fso=Server.Createobject("Scripting.FileSystemObject")
Set F=fso.CreateTextFile(Server.MapPath(writefile),true)
F.WriteLine fileStr
F.close
Set F = Nothing
Set Fso = Nothing
End Sub
'================================================
'过程名:Readfile
'作 用:读取文件
'================================================
Public Sub Readfilea(filename)
Dim Fso,F
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
Set F=fso.OpenTextFile(Server.MapPath(filename))
strOut=F.ReadAll
F.close
Set F = Nothing
Set Fso = Nothing
End Sub
'================================================
'过程名:Readfolder
'作 用:读取文件夹
'================================================
Public Sub Readfolder()
Set MyFileObject=Server.CreateObject("Scripting.FileSystemObject")
Set MyFolder=MyFileObject.GetFolder("\")
For Each thing in MyFolder.files
Response.Write thing & "
"
Next
End Sub
'================================================
'过程名:RemoveCookies
'作 用:移除本站Cookies
'================================================
Public Sub RemoveCookies()
Dim Cookie, Subkey
For Each Cookie in Request.Cookies
if Not(Request.Cookies(Cookie).HasKeys) then
Response.Cookies(Cookie) = Empty
else
For Each Subkey in Request.Cookies(Cookie)
Response.Cookies(Cookie)(Subkey) = Empty
Next
end if
Next
End Sub
'================================================
'函数名:IsValidStr
'作 用:判断字符串中是否含有非法字符
'参 数:str ----原字符串
'返回值:False,True -----布尔值
'================================================
Public Function IsValidStr(ByVal str)
IsValidStr = False
On Error Resume Next
If IsNull(str) Then Exit Function
If Trim(str) = Empty Then Exit Function
Dim ForbidStr, i
ForbidStr = "and|chr|:|=|%|&|$|#|@|+|-|*|/|\|<|>|;|,|^|" & Chr(32) & "|" & Chr(34) & "|" & Chr(39) & "|" & Chr(9)
ForbidStr = Split(ForbidStr, "|")
For i = 0 To UBound(ForbidStr)
If InStr(1,str, ForbidStr(i),1) > 0 Then
IsValidStr = False
Exit Function
End If
Next
IsValidStr = True
End Function
'================================================
'函数名:IsValidPassword
'作 用:判断密码中是否含有非法字符
'参 数:str ----原字符串
'返回值:False,True -----布尔值
'================================================
Public Function IsValidPassword(ByVal str)
IsValidPassword = False
On Error Resume Next
If IsNull(str) Then Exit Function
If Trim(str) = Empty Then Exit Function
Dim ForbidStr, i
ForbidStr = Chr(32) & "|" & Chr(34) & "|" & Chr(39) & "|" & Chr(9)
ForbidStr = Split(ForbidStr, "|")
For i = 0 To UBound(ForbidStr)
If InStr(1, str, ForbidStr(i), 1) > 0 Then
IsValidPassword = False
Exit Function
End If
Next
IsValidPassword = True
End Function
'================================================
'函数名:IsValidChar
'作 用:判断字符串中是否含有非法字符和中文
'参 数:str ----原字符串
'返回值:False,True -----布尔值
'================================================
Public Function IsValidChar(ByVal str)
IsValidChar = False
On Error Resume Next
If IsNull(str) Then Exit Function
If Trim(str) = Empty Then Exit Function
Dim ValidStr
Dim i, l, s, c
ValidStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.-_:~\/0123456789"
l = Len(str)
s = UCase(str)
For i = 1 To l
c = Mid(s, i, 1)
If InStr(ValidStr, c) = 0 Then
IsValidChar = False
Exit Function
End If
Next
IsValidChar = True
End Function
'================================================
'函数名:FormatDate
'作 用:格式化日期
'参 数:DateAndTime ----原日期和时间
' para ----日期格式
'返回值:格式化后的日期
'================================================
Public Function FormatDate(DateAndTime, para)
On Error Resume Next
Dim y, m, d, h, mi, s, strDateTime
FormatDate = DateAndTime
If Not IsNumeric(para) Then Exit Function
If Not IsDate(DateAndTime) Then Exit Function
y = CStr(Year(DateAndTime))
m = CStr(Month(DateAndTime))
If Len(m) = 1 Then m = "0" & m
d = CStr(Day(DateAndTime))
If Len(d) = 1 Then d = "0" & d
h = CStr(Hour(DateAndTime))
If Len(h) = 1 Then h = "0" & h
mi = CStr(Minute(DateAndTime))
If Len(mi) = 1 Then mi = "0" & mi
s = CStr(Second(DateAndTime))
If Len(s) = 1 Then s = "0" & s
Select Case para
Case "1":strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case "2":strDateTime = y & "-" & m & "-" & d
Case "3":strDateTime = y & "/" & m & "/" & d
Case "4":strDateTime = y & "年" & m & "月" & d & "日"
Case "5":strDateTime = m & "-" & d
Case "6":strDateTime = m & "/" & d
Case "7":strDateTime = m & "月" & d & "日"
Case "8":strDateTime = y & "年" & m & "月"
Case "9":strDateTime = y & "-" & m
Case "10":strDateTime = y & "/" & m
Case Else
strDateTime = DateAndTime
End Select
FormatDate = strDateTime
End Function
'================================================
'函数名:CheckInfuse
'作 用:防止SQL注入
'参 数:str ----原字符串
' strLen ----提交字符串长度
'================================================
Public Function CheckInfuse(ByVal str, ByVal strLen)
Dim strUnsafe, arrUnsafe
Dim i
If Trim(str) = "" Then
CheckInfuse = ""
Exit Function
End If
str = Left(str, strLen)
On Error Resume Next
strUnsafe = "'|^|;|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
If Trim(str) <> "" Then
If Len(str) > strLen Then
Response.Write ""
CheckInfuse = ""
Response.End
End If
arrUnsafe = Split(strUnsafe, "|")
For i = 0 To UBound(arrUnsafe)
If InStr(1, str, arrUnsafe(i), 1) > 0 Then
Response.Write ""
CheckInfuse = ""
Response.End
End If
Next
End If
CheckInfuse = Trim(str)
Exit Function
If Err.Number <> 0 Then
Err.Clear
Response.Write ""
CheckInfuse = ""
Response.End
End If
End Function
Public Sub PreventInfuse()
On Error Resume Next
Dim SQL_Nonlicet, arrNonlicet
Dim PostRefer, GetRefer, Sql_DATA
SQL_Nonlicet = "'|;|^|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
arrNonlicet = Split(SQL_Nonlicet, "|")
If Request.Form <> "" Then
For Each PostRefer In Request.Form
For Sql_DATA = 0 To UBound(arrNonlicet)
If InStr(1, Request.Form(PostRefer), arrNonlicet(Sql_DATA), 1) > 0 Then
Response.Write ""
Response.End
End If
Next
Next
End If
If Request.QueryString <> "" Then
For Each GetRefer In Request.QueryString
For Sql_DATA = 0 To UBound(arrNonlicet)
If InStr(1, Request.QueryString(GetRefer), arrNonlicet(Sql_DATA), 1) > 0 Then
Response.Write ""
Response.End
End If
Next
Next
End If
End Sub
'================================================
'函数名:ChkQueryStr
'作 用:过虑查询的非法字符
'参 数:str ----原字符串
'返回值:过滤后的字符
'================================================
Public Function ChkQueryStr(ByVal str)
On Error Resume Next
If IsNull(str) Then
ChkQueryStr = ""
Exit Function
End If
str = Replace(str, "!", "")
str = Replace(str, "]", "")
str = Replace(str, "[", "")
str = Replace(str, ")", "")
str = Replace(str, "(", "")
str = Replace(str, "|", "")
str = Replace(str, "+", "")
str = Replace(str, "=", "")
str = Replace(str, "'", "''")
str = Replace(str, "%", "")
str = Replace(str, "&", "")
str = Replace(str, "@", "")
str = Replace(str, "#", "")
str = Replace(str, "^", "")
str = Replace(str, "《", "")
str = Replace(str, "》", "")
str = Replace(str, " ", " ")
str = Replace(str, Chr(37), "")
str = Replace(str, Chr(0), "")
ChkQueryStr = str
End Function
'=================================================
'函数名:isInteger
'作 用:判断数字是否整型
'参 数:para ----参数
'=================================================
Public Function isInteger(ByVal para)
On Error Resume Next
Dim str
Dim l, i
If IsNull(para) Then
isInteger = False
Exit Function
End If
str = CStr(para)
If Trim(str) = "" Then
isInteger = False
Exit Function
End If
l = Len(str)
For i = 1 To l
If Mid(str, i, 1) > "9" or Mid(str, i, 1) < "0" Then
isInteger = False
Exit Function
End If
Next
isInteger = True
If Err.Number <> 0 Then Err.Clear
End Function
'=============================================================
'函数名:ChkBadWords
'函数作用:带脏话过滤
'=============================================================
Public Function ChkBadWords(ByVal str)
If IsNull(str) Then Exit Function
Dim i, Bwords, Bwordr
Bwords = Split(Badwords, "|")
Bwordr = Split(Badwordr, "|")
For i = 0 To UBound(Bwords)
If i > UBound(Bwordr) Then
str = Replace(str, Bwords(i), "*")
Else
str = Replace(str, Bwords(i), Bwordr(i))
End If
Next
ChkBadWords = str
End Function
'=============================================================
'函数名:HTMLEncode
'函数作用:过滤HTML代码,带脏话过滤
'=============================================================
Public Function HTMLEncode(ByVal 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, " ", " ")
fString = Replace(fString, Chr(10), "
")
fString = ChkBadWords(fString)
HTMLEncode = fString
End If
End Function
'=============================================================
'函数名:HTMLEncodes
'函数作用:过滤HTML代码,不带脏话过滤
'=============================================================
Public Function HTMLEncodes(ByVal fString)
If Not IsNull(fString) Then
fString = Replace(fString, "'", "'")
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), "
")
fString = Replace(fString, " ", " ")
HTMLEncodes = fString
End If
End Function
'=============================================================
'函数名:CheckPost
'函数作用:判断发言是否来自外部
'=============================================================
Public Function CheckPost()
On Error Resume Next
Dim server_v1, server_v2
CheckPost = 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
CheckPost = True
End If
End Function
'=============================================================
'函数名:CheckOuterUrl
'函数作用:判断来源URL是否来自外部
'=============================================================
Public Function CheckOuterUrl()
On Error Resume Next
Dim server_v1, server_v2
server_v1 = Replace(LCase(Trim(Request.ServerVariables("HTTP_REFERER"))), "http://", "")
server_v2 = LCase(Trim(Request.ServerVariables("SERVER_NAME")))
If server_v1 <> "" And Left(server_v1, Len(server_v2)) <> server_v2 Then
CheckOuterUrl = False
Else
CheckOuterUrl = True
End If
End Function
'================================================
'函数名:ChkKeyWord
'作 用:过滤关键字
'参 数:keyword ----关键字
'================================================
Public Function ChkKeyWord(ByVal keyword)
Dim FobWords, i
On Error Resume Next
FobWords = Array(91, 92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65339, 65340)
For i = 1 To UBound(FobWords, 1)
If InStr(keyword, ChrW(FobWords(i))) > 0 Then
keyword = Replace(keyword, ChrW(FobWords(i)), "")
End If
Next
keyword = Left(keyword, 100)
FobWords = Array("~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "=", "`", "[", "]", "{", "}", ";", ":", """", "'", ",", "<", ">", ".", "/", "\", "?", "--")
For i = 0 To UBound(FobWords, 1)
If InStr(keyword, FobWords(i)) > 0 Then
keyword = Replace(keyword, FobWords(i), "")
End If
Next
ChkKeyWord = keyword
End Function
'================================================
'函数名:FilesDelete
'作 用:FSO删除文件
'参 数:filepath ----文件路径
'返回值:False ---- True
'================================================
Public Function FileDelete(ByVal FilePath)
On Error Resume Next
FileDelete = False
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If FilePath = "" Then Exit Function
If InStr(FilePath, ":") = 0 Then FilePath = Server.MapPath(FilePath)
If fso.FileExists(FilePath) Then
fso.DeleteFile FilePath, True
FileDelete = True
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
'================================================
'函数名:FolderDelete
'作 用:FSO删除目录
'参 数:folderpath ----目录路径
'回值:False ---- True
'================================================
Public Function FolderDelete(ByVal FolderPath)
FolderDelete = False
On Error Resume Next
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If FolderPath = "" Then Exit Function
If InStr(FolderPath, ":") = 0 Then FolderPath = Server.MapPath(FolderPath)
If fso.FolderExists(FolderPath) Then
fso.DeleteFolder FolderPath, True
FolderDelete = True
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
'================================================
'函数名:CopyToFile
'作 用:复制文件
'参 数:SoureFile ----原文件路径
' NewFile ----目标文件路径
'================================================
Public Function CopyToFile(ByVal SoureFile, ByVal NewFile)
On Error Resume Next
If SoureFile = "" Then Exit Function
If NewFile = "" Then Exit Function
If InStr(SoureFile, ":") = 0 Then SoureFile = Server.MapPath(SoureFile)
If InStr(NewFile, ":") = 0 Then NewFile = Server.MapPath(NewFile)
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If fso.FileExists(SoureFile) Then
fso.CopyFile SoureFile, NewFile
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
'================================================
'函数名:CopyToFolder
'作 用:复制文件夹
'参 数:SoureFolder ----原路径
' NewFolder ----目标路径
'================================================
Public Function CopyToFolder(ByVal SoureFolder, ByVal NewFolder)
On Error Resume Next
If SoureFolder = "" Then Exit Function
If NewFolder = "" Then Exit Function
If InStr(SoureFolder, ":") = 0 Then SoureFolder = Server.MapPath(SoureFolder)
If InStr(NewFolder, ":") = 0 Then NewFolder = Server.MapPath(NewFolder)
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If fso.FolderExists(SoureFolder) Then
fso.CopyFolder SoureFolder, NewFolder
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
'================================================
'函数名:CreatedTextFile
'作 用:创建文本文件
'参 数:filename ----文件名
' body ----主要内容
'================================================
Public Function CreatedTextFile(ByVal fromPath, ByVal body)
On Error Resume Next
Dim fso,fff
If InStr(fromPath, ":") = 0 Then fromPath = Server.MapPath(fromPath)
Set fso = Server.CreateObject(FSO_ScriptName)
Set fff = fso.OpenTextFile(fromPath, 2, True)
fff.Write body
fff.Close
Set fff = Nothing
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
Public Function CreatedTextFiles(ByVal FileName, ByVal body)
On Error Resume Next
If InStr(FileName, ":") = 0 Then FileName = Server.MapPath(FileName)
Dim oStream
Set oStream = CreateObject("ADODB.Stream")
oStream.Type = 2 '设置为可读可写
oStream.Mode = 3 '设置内容为文本
oStream.Charset = "GB2312"
oStream.Open
oStream.Position = oStream.Size
oStream.WriteText body
oStream.SaveToFile FileName, 2
oStream.Close
Set oStream = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
Dim Moonpotato
Set Moonpotato=New Moonpotato_Cls
Class Moonpotato_Cls
Public Badwords,Badwordr
'================================================
'过程名:Writefile
'作 用:导出Excel
'================================================
Public Sub Excel()
Response.Buffer = True
Response.ContentType = "application/vnd.ms-excel"
Response.AddHeader "content-disposition", "inline; filename = "& Session("CompanyName")&Date()&".xls"
End Sub
'================================================
'过程名:Writefile
'作 用:写入文件
'================================================
Public Sub Tclass(id,title,table,choose)
Set Rs=HK.ExeCute ("Select "& id &","& title &" from "& table &" "& choose &"")
Do while not Rs.eof
Response.write ""
Rs.movenext
Loop
Rs.close
Set rs=Nothing
End Sub
'================================================
'过程名:Writefile
'作 用:写入文件
'================================================
Public Sub Readfile(writefile,fileStr)
Dim Fso,F
Set Fso=Server.Createobject("Scripting.FileSystemObject")
Set F=fso.CreateTextFile(Server.MapPath(writefile),true)
F.WriteLine fileStr
F.close
Set F = Nothing
Set Fso = Nothing
End Sub
'================================================
'过程名:Readfile
'作 用:读取文件
'================================================
Public Sub Readfilea(filename)
Dim Fso,F
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
Set F=fso.OpenTextFile(Server.MapPath(filename))
strOut=F.ReadAll
F.close
Set F = Nothing
Set Fso = Nothing
End Sub
'================================================
'过程名:Readfolder
'作 用:读取文件夹
'================================================
Public Sub Readfolder()
Set MyFileObject=Server.CreateObject("Scripting.FileSystemObject")
Set MyFolder=MyFileObject.GetFolder("\")
For Each thing in MyFolder.files
Response.Write thing & "
"
Next
End Sub
'================================================
'过程名:RemoveCookies
'作 用:移除本站Cookies
'================================================
Public Sub RemoveCookies()
Dim Cookie, Subkey
For Each Cookie in Request.Cookies
if Not(Request.Cookies(Cookie).HasKeys) then
Response.Cookies(Cookie) = Empty
else
For Each Subkey in Request.Cookies(Cookie)
Response.Cookies(Cookie)(Subkey) = Empty
Next
end if
Next
End Sub
'================================================
'函数名:IsValidStr
'作 用:判断字符串中是否含有非法字符
'参 数:str ----原字符串
'返回值:False,True -----布尔值
'================================================
Public Function IsValidStr(ByVal str)
IsValidStr = False
On Error Resume Next
If IsNull(str) Then Exit Function
If Trim(str) = Empty Then Exit Function
Dim ForbidStr, i
ForbidStr = "and|chr|:|=|%|&|$|#|@|+|-|*|/|\|<|>|;|,|^|" & Chr(32) & "|" & Chr(34) & "|" & Chr(39) & "|" & Chr(9)
ForbidStr = Split(ForbidStr, "|")
For i = 0 To UBound(ForbidStr)
If InStr(1,str, ForbidStr(i),1) > 0 Then
IsValidStr = False
Exit Function
End If
Next
IsValidStr = True
End Function
'================================================
'函数名:IsValidPassword
'作 用:判断密码中是否含有非法字符
'参 数:str ----原字符串
'返回值:False,True -----布尔值
'================================================
Public Function IsValidPassword(ByVal str)
IsValidPassword = False
On Error Resume Next
If IsNull(str) Then Exit Function
If Trim(str) = Empty Then Exit Function
Dim ForbidStr, i
ForbidStr = Chr(32) & "|" & Chr(34) & "|" & Chr(39) & "|" & Chr(9)
ForbidStr = Split(ForbidStr, "|")
For i = 0 To UBound(ForbidStr)
If InStr(1, str, ForbidStr(i), 1) > 0 Then
IsValidPassword = False
Exit Function
End If
Next
IsValidPassword = True
End Function
'================================================
'函数名:IsValidChar
'作 用:判断字符串中是否含有非法字符和中文
'参 数:str ----原字符串
'返回值:False,True -----布尔值
'================================================
Public Function IsValidChar(ByVal str)
IsValidChar = False
On Error Resume Next
If IsNull(str) Then Exit Function
If Trim(str) = Empty Then Exit Function
Dim ValidStr
Dim i, l, s, c
ValidStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.-_:~\/0123456789"
l = Len(str)
s = UCase(str)
For i = 1 To l
c = Mid(s, i, 1)
If InStr(ValidStr, c) = 0 Then
IsValidChar = False
Exit Function
End If
Next
IsValidChar = True
End Function
'================================================
'函数名:FormatDate
'作 用:格式化日期
'参 数:DateAndTime ----原日期和时间
' para ----日期格式
'返回值:格式化后的日期
'================================================
Public Function FormatDate(DateAndTime, para)
On Error Resume Next
Dim y, m, d, h, mi, s, strDateTime
FormatDate = DateAndTime
If Not IsNumeric(para) Then Exit Function
If Not IsDate(DateAndTime) Then Exit Function
y = CStr(Year(DateAndTime))
m = CStr(Month(DateAndTime))
If Len(m) = 1 Then m = "0" & m
d = CStr(Day(DateAndTime))
If Len(d) = 1 Then d = "0" & d
h = CStr(Hour(DateAndTime))
If Len(h) = 1 Then h = "0" & h
mi = CStr(Minute(DateAndTime))
If Len(mi) = 1 Then mi = "0" & mi
s = CStr(Second(DateAndTime))
If Len(s) = 1 Then s = "0" & s
Select Case para
Case "1":strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case "2":strDateTime = y & "-" & m & "-" & d
Case "3":strDateTime = y & "/" & m & "/" & d
Case "4":strDateTime = y & "年" & m & "月" & d & "日"
Case "5":strDateTime = m & "-" & d
Case "6":strDateTime = m & "/" & d
Case "7":strDateTime = m & "月" & d & "日"
Case "8":strDateTime = y & "年" & m & "月"
Case "9":strDateTime = y & "-" & m
Case "10":strDateTime = y & "/" & m
Case Else
strDateTime = DateAndTime
End Select
FormatDate = strDateTime
End Function
'================================================
'函数名:CheckInfuse
'作 用:防止SQL注入
'参 数:str ----原字符串
' strLen ----提交字符串长度
'================================================
Public Function CheckInfuse(ByVal str, ByVal strLen)
Dim strUnsafe, arrUnsafe
Dim i
If Trim(str) = "" Then
CheckInfuse = ""
Exit Function
End If
str = Left(str, strLen)
On Error Resume Next
strUnsafe = "'|^|;|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
If Trim(str) <> "" Then
If Len(str) > strLen Then
Response.Write ""
CheckInfuse = ""
Response.End
End If
arrUnsafe = Split(strUnsafe, "|")
For i = 0 To UBound(arrUnsafe)
If InStr(1, str, arrUnsafe(i), 1) > 0 Then
Response.Write ""
CheckInfuse = ""
Response.End
End If
Next
End If
CheckInfuse = Trim(str)
Exit Function
If Err.Number <> 0 Then
Err.Clear
Response.Write ""
CheckInfuse = ""
Response.End
End If
End Function
Public Sub PreventInfuse()
On Error Resume Next
Dim SQL_Nonlicet, arrNonlicet
Dim PostRefer, GetRefer, Sql_DATA
SQL_Nonlicet = "'|;|^|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
arrNonlicet = Split(SQL_Nonlicet, "|")
If Request.Form <> "" Then
For Each PostRefer In Request.Form
For Sql_DATA = 0 To UBound(arrNonlicet)
If InStr(1, Request.Form(PostRefer), arrNonlicet(Sql_DATA), 1) > 0 Then
Response.Write ""
Response.End
End If
Next
Next
End If
If Request.QueryString <> "" Then
For Each GetRefer In Request.QueryString
For Sql_DATA = 0 To UBound(arrNonlicet)
If InStr(1, Request.QueryString(GetRefer), arrNonlicet(Sql_DATA), 1) > 0 Then
Response.Write ""
Response.End
End If
Next
Next
End If
End Sub
'================================================
'函数名:ChkQueryStr
'作 用:过虑查询的非法字符
'参 数:str ----原字符串
'返回值:过滤后的字符
'================================================
Public Function ChkQueryStr(ByVal str)
On Error Resume Next
If IsNull(str) Then
ChkQueryStr = ""
Exit Function
End If
str = Replace(str, "!", "")
str = Replace(str, "]", "")
str = Replace(str, "[", "")
str = Replace(str, ")", "")
str = Replace(str, "(", "")
str = Replace(str, "|", "")
str = Replace(str, "+", "")
str = Replace(str, "=", "")
str = Replace(str, "'", "''")
str = Replace(str, "%", "")
str = Replace(str, "&", "")
str = Replace(str, "@", "")
str = Replace(str, "#", "")
str = Replace(str, "^", "")
str = Replace(str, "《", "")
str = Replace(str, "》", "")
str = Replace(str, " ", " ")
str = Replace(str, Chr(37), "")
str = Replace(str, Chr(0), "")
ChkQueryStr = str
End Function
'=================================================
'函数名:isInteger
'作 用:判断数字是否整型
'参 数:para ----参数
'=================================================
Public Function isInteger(ByVal para)
On Error Resume Next
Dim str
Dim l, i
If IsNull(para) Then
isInteger = False
Exit Function
End If
str = CStr(para)
If Trim(str) = "" Then
isInteger = False
Exit Function
End If
l = Len(str)
For i = 1 To l
If Mid(str, i, 1) > "9" or Mid(str, i, 1) < "0" Then
isInteger = False
Exit Function
End If
Next
isInteger = True
If Err.Number <> 0 Then Err.Clear
End Function
'=============================================================
'函数名:ChkBadWords
'函数作用:带脏话过滤
'=============================================================
Public Function ChkBadWords(ByVal str)
If IsNull(str) Then Exit Function
Dim i, Bwords, Bwordr
Bwords = Split(Badwords, "|")
Bwordr = Split(Badwordr, "|")
For i = 0 To UBound(Bwords)
If i > UBound(Bwordr) Then
str = Replace(str, Bwords(i), "*")
Else
str = Replace(str, Bwords(i), Bwordr(i))
End If
Next
ChkBadWords = str
End Function
'=============================================================
'函数名:HTMLEncode
'函数作用:过滤HTML代码,带脏话过滤
'=============================================================
Public Function HTMLEncode(ByVal 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, " ", " ")
fString = Replace(fString, Chr(10), "
")
fString = ChkBadWords(fString)
HTMLEncode = fString
End If
End Function
'=============================================================
'函数名:HTMLEncodes
'函数作用:过滤HTML代码,不带脏话过滤
'=============================================================
Public Function HTMLEncodes(ByVal fString)
If Not IsNull(fString) Then
fString = Replace(fString, "'", "'")
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), "
")
fString = Replace(fString, " ", " ")
HTMLEncodes = fString
End If
End Function
'=============================================================
'函数名:CheckPost
'函数作用:判断发言是否来自外部
'=============================================================
Public Function CheckPost()
On Error Resume Next
Dim server_v1, server_v2
CheckPost = 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
CheckPost = True
End If
End Function
'=============================================================
'函数名:CheckOuterUrl
'函数作用:判断来源URL是否来自外部
'=============================================================
Public Function CheckOuterUrl()
On Error Resume Next
Dim server_v1, server_v2
server_v1 = Replace(LCase(Trim(Request.ServerVariables("HTTP_REFERER"))), "http://", "")
server_v2 = LCase(Trim(Request.ServerVariables("SERVER_NAME")))
If server_v1 <> "" And Left(server_v1, Len(server_v2)) <> server_v2 Then
CheckOuterUrl = False
Else
CheckOuterUrl = True
End If
End Function
'================================================
'函数名:ChkKeyWord
'作 用:过滤关键字
'参 数:keyword ----关键字
'================================================
Public Function ChkKeyWord(ByVal keyword)
Dim FobWords, i
On Error Resume Next
FobWords = Array(91, 92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65339, 65340)
For i = 1 To UBound(FobWords, 1)
If InStr(keyword, ChrW(FobWords(i))) > 0 Then
keyword = Replace(keyword, ChrW(FobWords(i)), "")
End If
Next
keyword = Left(keyword, 100)
FobWords = Array("~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "=", "`", "[", "]", "{", "}", ";", ":", """", "'", ",", "<", ">", ".", "/", "\", "?", "--")
For i = 0 To UBound(FobWords, 1)
If InStr(keyword, FobWords(i)) > 0 Then
keyword = Replace(keyword, FobWords(i), "")
End If
Next
ChkKeyWord = keyword
End Function
'================================================
'函数名:FilesDelete
'作 用:FSO删除文件
'参 数:filepath ----文件路径
'返回值:False ---- True
'================================================
Public Function FileDelete(ByVal FilePath)
On Error Resume Next
FileDelete = False
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If FilePath = "" Then Exit Function
If InStr(FilePath, ":") = 0 Then FilePath = Server.MapPath(FilePath)
If fso.FileExists(FilePath) Then
fso.DeleteFile FilePath, True
FileDelete = True
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
'================================================
'函数名:FolderDelete
'作 用:FSO删除目录
'参 数:folderpath ----目录路径
'回值:False ---- True
'================================================
Public Function FolderDelete(ByVal FolderPath)
FolderDelete = False
On Error Resume Next
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If FolderPath = "" Then Exit Function
If InStr(FolderPath, ":") = 0 Then FolderPath = Server.MapPath(FolderPath)
If fso.FolderExists(FolderPath) Then
fso.DeleteFolder FolderPath, True
FolderDelete = True
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
'================================================
'函数名:CopyToFile
'作 用:复制文件
'参 数:SoureFile ----原文件路径
' NewFile ----目标文件路径
'================================================
Public Function CopyToFile(ByVal SoureFile, ByVal NewFile)
On Error Resume Next
If SoureFile = "" Then Exit Function
If NewFile = "" Then Exit Function
If InStr(SoureFile, ":") = 0 Then SoureFile = Server.MapPath(SoureFile)
If InStr(NewFile, ":") = 0 Then NewFile = Server.MapPath(NewFile)
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If fso.FileExists(SoureFile) Then
fso.CopyFile SoureFile, NewFile
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
'================================================
'函数名:CopyToFolder
'作 用:复制文件夹
'参 数:SoureFolder ----原路径
' NewFolder ----目标路径
'================================================
Public Function CopyToFolder(ByVal SoureFolder, ByVal NewFolder)
On Error Resume Next
If SoureFolder = "" Then Exit Function
If NewFolder = "" Then Exit Function
If InStr(SoureFolder, ":") = 0 Then SoureFolder = Server.MapPath(SoureFolder)
If InStr(NewFolder, ":") = 0 Then NewFolder = Server.MapPath(NewFolder)
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If fso.FolderExists(SoureFolder) Then
fso.CopyFolder SoureFolder, NewFolder
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
'================================================
'函数名:CreatedTextFile
'作 用:创建文本文件
'参 数:filename ----文件名
' body ----主要内容
'================================================
Public Function CreatedTextFile(ByVal fromPath, ByVal body)
On Error Resume Next
Dim fso,fff
If InStr(fromPath, ":") = 0 Then fromPath = Server.MapPath(fromPath)
Set fso = Server.CreateObject(FSO_ScriptName)
Set fff = fso.OpenTextFile(fromPath, 2, True)
fff.Write body
fff.Close
Set fff = Nothing
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
Public Function CreatedTextFiles(ByVal FileName, ByVal body)
On Error Resume Next
If InStr(FileName, ":") = 0 Then FileName = Server.MapPath(FileName)
Dim oStream
Set oStream = CreateObject("ADODB.Stream")
oStream.Type = 2 '设置为可读可写
oStream.Mode = 3 '设置内容为文本
oStream.Charset = "GB2312"
oStream.Open
oStream.Position = oStream.Size
oStream.WriteText body
oStream.SaveToFile FileName, 2
oStream.Close
Set oStream = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
评论: 0 | 引用: 0 | 查看次数: 2229
发表评论