ASP的一些常用函数！

<%
'===========================================================================
' HANDY ASP FUNCTIONS
' By: Dave Nicoll (dave@caelan.net) and Paul Roberts (paul@caelan.net)
' Web site: www.caelan.net
' Updated: 24/06/2002
' Abbreviations used: str:string, int:integer, b:boolean, csv:Comma seperated values
'===========================================================================
' Function name reference -
' CleanID
' CleanString
' IsValidEmail
' PrepStringFromDB
' AddLeadingZero
' highlightPhrase
' IsANumber
' DeleteFile
' FileExists
' ReverseFormatYear
' getAge
' newGUID
' containsBadWords
' removeBadWords
' CreateThumbnail
' rgbtohex
' NTUsername
'===========================================================================
' Input: "1055; DELETE FROM tblArticles" --the user tried to inject some sql
' Output: -1
' Useful for: checking an id passed through the querystring doesn't contain an SQL injection
function CleanID(intID)
on error resume next
CleanID = CLng(intID)
if err.number<>0 then
CleanID=-1 'return -1 as an error code
end if
on error goto 0
end function
' Input: "isn't this great?"
' Output: "isn''t this great?"
' Useful for: escaping characters before inserting in the database
'''' 添加到数据库中过滤
function CleanString(strString)
CleanString = Replace(strString, "'", "''")
CleanString = Replace(CleanString, "|", "/")
end function
' Input: "bob@bob.com"
' Output: true
' Useful for: making sure users enter a syntactically correct email address
function IsValidEmail(strEmailAddress)
if len(strEmailAddress)>=6 and instr(strEmailAddress,".") and instr(strEmailAddress,"@") then IsValidEmail=true else IsValidEmail = false
end function
' Input: "Copyright (c) 2002 Caelan"
' Output: "Copyright © 2002 Caelan"
' Useful for: converting returned db data into safe html
function PrepStringFromDB(strString)
strString = Replace(strString, "<", "<")
strString = Replace(strString, ">", ">")
strString = Replace(strString, "(c)", "©")
strString = Replace(strString, VbCrlf, "<BR>")
strString = Replace(strString, """", """)
strString = Replace(strString, "'", "&39;")
PrepStringFromDB = strString
end function
' Input: "7",2
' Output: "007"
' Useful for: inserting leading zeros before times and dates
function AddLeadingZero(strString, num)
if num=>Len(strString) then
For i = len(strString) to num -1
strString = "0" & strString
Next
end if
AddLeadingZero = strString
end function
' Input: "keyword","This is a body of text including keywords."
' Output: "This is a body of text including <strong>keyword</strong>s."
function highlightPhrase(searchString,strBody)
strarray = split(searchString,".")
set re = New RegExp
re.Global = True
re.IgnoreCase = True
're.MultiLine = True
for i = 0 to ubound(strarray)
re.Pattern = "(" & strarray(i) & "+)"
strBody = re.Replace(strBody,"<strong>$1</strong>")
next
highlightPhrase = strBody
end function
' Input: 542
' Output: true
' Useful for: checking if a value passed through the querystring is a number
function IsANumber(intNumber)
if isNull(intNumber) or intNumber ="" Then
IsANumber = False
elseif IsNumeric(intNumber) Then
if intNumber>999999999 or intNumber <-999999999 Then
IsANumber = False
else
IsANumber = True
end if
else
IsANumber = False
end if
end function
' Input: "/uploads/file23002.zip"
' Output: true/false
' Useful for: deleting files on the server
function DeleteFile(strFileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
strFileName = server.mappath(strFileName)
On Error Resume Next
FSO.DeleteFile(strFilename)
If Err.Number<>0 Then
DeleteFile = False
Else
DeleteFile= True
end if
On Error Goto 0
Set FSO = Nothing
end function
' Input: "/images/file23002.zip"
' Output: true/false
' Useful for: checking if a file exists on the server
function FileExists(strFileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
strFileName = server.mappath(strFileName)
If FSO.FileExists(strFilename) then FileExists = True Else FileExists = False
Set FSO = Nothing
end Function
' Input: 24/06/2002 15:55
' Output: 2002/6/24 15:55
' Useful for: reversing date formats so that it works in all language formats. REALLY HANDY!! :)
function ReverseFormatYear(inputdate)
minutenumber = minute(inputdate)
hournumber = hour(inputdate)
daynumber = day(inputdate)
monthnumber = month(inputdate)
yearnumber = year(inputdate)
outputdate = yearnumber & "/" & monthnumber & "/" & daynumber & " " & hournumber & ":" & minutenumber
ReverseFormatYear = outputdate
end Function
' Input: "05/10/1977"
' Output: "24"
' Useful for: working out someones age
function getAge(strDOB)
Dim strYears
strYears = Year(Date) - Year(strDOB)
If Month(strDOB) > Month(Date) Then
getAge = strYears - 1
ElseIf Month(strDOB) < Month(Date) Then
getAge = strYears
ElseIf Day(strDOB) <= Day(Date) Then
getAge = strYears
Else
getAge = strYears - 1
End If
end function
' Requires: GuidMakr (http://www.google.co.uk/search?q=guidmakr) to be installed on the server
' Output: {19522AF6-3E0C-475F-AAEA-474EC34C77A2} -- random every time obviously ;)
' Useful for: making a unique ID
function newGUID()
Set MyGuid = Server.CreateObject ("GuidMakr.GUID")
newGUID=(MyGuid.GetGUID)
Set MyGuid = Nothing
end function
' Input: "this is a test string containing no banned words"
' Output: false
' Useful for: detecting swear words
function containsBadWords(strInputString)
'Use sparingly as instr is a slow function
arrBadWords=split("fuck,shit,cunt,pussy,twat,penis,vagina,nazi,hitler,bastard,minge,whore,wank",",")
for i=0 to ubound(arrBadWords)
if instr(strInputString,arrBadWords(i)) then
containsBadWords=true
exit function
end if
next
containsBadWords=false
end function
' Input: "this fucking string contains the word fuck."
' Output: "this ****ing string contains the word ****."
' Useful for: filtering out swear words
function removeBadWords(strInputString)
arrBadWords=split("fuck,shit,cunt,pussy,twat,penis,vagina,nazi,hitler,bastard,minge,whore,wank",",")
for i = 0 to ubound(arrBadWords)
strInputString= replace(strInputString, arrBadWords(i), string(len(arrBadWords(i)),"*"), 1,-1,1)
next
removeBadWords = strInputString
end function
' Input: "c:/images", "c:/thumbnails", "filename.jpg", 120, 120
' Output: jpeg file
' Useful for: Creating a thumbnail of a larger image
' By: Dave Nicoll (used from ASPGallery under license)
' Requires: ASPImage from ServerObjects Inc (www.serverobjects.com)
function CreateThumbnail(strPath, strOutputPath, strFilename, maxX, maxY) 'Paths should be passed as mapped paths, i.e. c:/inetpub/wwwroot/mysite/images
Set image = server.createobject("aspimage.image")
if image.loadimage(strPath & "/" & strFilename) then
intWidth = image.MaxX
intHeight = image.MaxY
if intWidth>intHeight then
intRatio=(maxX/intWidth)
else
intRatio=(maxY/intHeight)
end if
image.resizeR intWidth*intRatio, intHeight*intRatio

Image.ImageFormat = 1
Image.PixelFormat = 6
strSfilename=split(strFilename,".")
Image.Filename=strOutputPath & "/" & strSfilename(0)
if Image.SaveImage then
Set Image = nothing
CreateThumbnail=true 'the operation was successful, return true
else
'Error while saving, abort
'response.write "Error: couldn't save image " & strOutputPath & "/" & strFilename & "<br>" & vbcrlf
CreateThumbnail = false 'operation failed, return false
Set Image = nothing
'response.end
end if
else
'Error while loading, abort
'response.write "Error: couldn't load image " & strPath & "/" & strFilename & "<br>" & vbcrlf
CreateThumbnail = false 'operation failed, return false
Set Image = nothing
'response.end
exit function
end if
end function
' Input: "150,60,120"
' Output: "78326E"
' Useful for: converting rgb values into their hex code
Function rgbtohex(csvColor)
rgbValues=split(csvColor,",")
for i = 0 to ubound(rgbValues)
If Len(Hex(rgbValues(i))) = 1 Then
rgbtohex = rgbtohex & "0" & Hex(rgbValues(i))
Else
rgbtohex = rgbtohex & Hex(rgbValues(i))
End If
next
End Function
' Output: "ntusername"
' Useful for: getting the NT username of the authenticated user
function NTUsername()
on error resume next
arrMyArray = split(Request.ServerVariables("LOGON_USER"),"/")
NTUsername = lcase(arrSomething(1))
if err.number<>0 then
NTUsername=-1 'return -1 as an error code
end if
on error goto 0
end function
%>