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 &copy; 2002 Caelan"
' Useful for: converting returned db data into safe html
function PrepStringFromDB(strString)
 strString = Replace(strString, "<", "&lt;") 
 strString = Replace(strString, ">", "&gt;")
 strString = Replace(strString, "(c)", "&copy;")
 strString = Replace(strString, VbCrlf, "<BR>")
 strString = Replace(strString, """", "&quot;")
 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

%>