ASP常用程序段

<%
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 ""
Response.write Rs(""&title&"")
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

上一篇: ASP漏洞大全
下一篇: 通用分页程序带限制功能
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
相关日志: