Code:
<%
'Used by the check form functions
dim forms
dim errors
'Used to store SQL errors
dim sqlerr
set sqlerr = Server.CreateObject("Scripting.Dictionary")
'When false sql errors will be displayed only by manual request
'When true sql errors will be displayed when they occur
dim AUTO_SQL_ERROR
AUTO_SQL_ERROR = false
function AddSlashes(str)
AddSlashes = replace(str,"'","''")
end function
'Checks the URL for ?debug=1 allows for setting up debug sections
function DebugMode()
if request.querystring("debug") = 1 then
DebugMode = true
else
DebugMode = false
end if
end function
'Runs an query does not use the global.asa but allows selection of any database.
'returns a 2 dementional array
' array(rownumber)("colname")
' ex: arr(0)("APTCODE")
'allows for all caps and all lowercase colnames all others will not be shown
'if an error occurs it will set the sqlerr variable with all of the information
function RunQuery(sql,database)
srv = "yourserver"
uid = "yourusername"
pwd = "yourpassword"
connect = "DRIVER={SQL Server};SERVER="&srv&";DATABASE="&database&";UID="&uid&";PWD="&pwd
sqlerr.RemoveAll
set RQRS = Server.CreateObject("ADODB.RecordSet")
on error resume next
RQRS.Open sql,connect
if err.number > 0 then
sqlerr.Add "err",true
sqlerr.Add "num",err.number
sqlerr.Add "desc",err.Description
sqlerr.Add "sql",sql
if AUTO_SQL_ERROR then
show = ShowSQLError()
end if
else
sqlerr.Add "err",false
end if
If Err.number <> 0 or temp = -1 Then
Err.Clear
RunQuery = false
else
RQArr = array()
do until RQRS.EOF
if UBOUND(RQArr) = -1 then
redim preserve RQArr(0)
else
redim preserve RQArr(UBOUND(RQArr)+1)
end if
set RQArr(UBOUND(RQArr)) = Server.CreateObject("Scripting.Dictionary")
for stlctr = 0 to RQRS.Fields.count - 1
key = replace(lcase(RQRS.Fields(stlctr).Name)," ","_")
val = RQRS.Fields(stlctr)
if not IsNumeric(key) then
RQArr(UBOUND(RQArr)).Add lcase(key),val
RQArr(UBOUND(RQArr)).Add ucase(key),val
else
RQArr(UBOUND(RQArr)).Add lcase(key),val
end if
next
RQRS.MoveNext
loop
RQRS.Close
set RQRS = nothing
RunQuery = RQArr
set RQArr = nothing
End If
On Error Goto 0
end function
'Displays a nice clean description of the error that occured when a query was run.
function ShowSQLError()
echo "<div style='background: #FFE6E6; border: 1px solid #FDA6A6; padding: 5px; font: 12px verdana; color: #000000;'>"
echo " <b>Number:</b> "&sqlerr("num")&"<br>"
echo " <b>Description:</b> "&sqlerr("desc")&"<br>"
echo " <b>SQL:</b> "&sqlerr("sql")
echo "</div>"
end function
'Runs the same as RunQuery but does not return anything
function RunNonQuery(sql,database)
srv = "yourserver"
uid = "yourusername"
pwd = "yourpassword"
connect = "DRIVER={SQL Server};SERVER="&srv&";DATABASE="&database&";UID="&uid&";PWD="&pwd
sqlerr.RemoveAll
set RQRS = Server.CreateObject("ADODB.RecordSet")
on error resume next
RQRS.Open sql,connect
if err.number > 0 then
sqlerr.Add "err",true
sqlerr.Add "num",err.number
sqlerr.Add "desc",err.Description
if AUTO_SQL_ERROR then
show = ShowSQLError()
end if
else
sqlerr.Add "err",false
end if
set RQRS = nothing
RunNonQuery = ""
set RQArr = nothing
on error goto 0
end function
'This will loop through the array supplied by RunQuery and will display a table of all the data that is in the array
function SqlDump(obj)
if IsArray(obj) = true then
response.write("<table border=1 cellpadding=3 cellspacing=0 bordercolor='#000000'><tr>")
for each stlctr2 in obj(0)
response.write("<td>"&stlctr2&"</td>")
next
response.write("</tr>")
for stlctr = 0 to Ubound(obj)
response.write("<tr>")
for each stlctr2 in obj(stlctr)
if len(obj(stlctr)(stlctr2)) < 100 then
response.write("<td nowrap> "&obj(stlctr)(stlctr2)&"</td>")
else
response.write("<td nowrap>Long Text</td>")
end if
next
response.write("</tr>")
next
response.write("</table>")
else
response.write("no data<br><br>")
end if
end function
'Outputs normally, but adds a line break at the end of the string to help formating
function echo(str)
response.write(str&vbcrlf)
end function
'Returns true if it is an array false if it is not
function IsArray(arr)
on error resume next
temp = ubound(arr)
If Err.number <> 0 or temp = -1 Then
IsArray = false
Err.Clear
else
IsArray = true
End If
On Error Goto 0
end function
'Adds a value to an array. This avoids the need for redim
function AddArray(byref arr,newval)
dim ctr
dim newarr
newarr = arr
if not IsArray(arr) then
redim arr(0)
arr(0) = newval
else
redim preserve arr(ubound(arr)+1)
arr(ubound(arr)) = newval
end if
end function
'Used by Print_r
function Echor(arr,tablevel)
if tablevel = 0 then
echo "Array"
echo "("
end if
dim ctr
if not IsDictionary(arr) and not IsArray(arr) then
else
if IsDictionary(arr) then
for each ctr in arr
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
if IsArray(arr(ctr)) = true then
echo "["&ctr&"] => Array("
x = Echor(arr(ctr),(tablevel+1))
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
echo ")"
else
if IsDictionary(arr(ctr)) then
echo "["&ctr&"] => dictionary("
x = Echor(arr(ctr),(tablevel+1))
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
echo ")"
else
echo "["&ctr&"] => {"&arr(ctr)&"}"
end if
end if
next
else
for ctr=0 to ubound(arr)
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
if IsArray(arr(ctr)) = true then
echo "["&ctr&"] => Array("
x = Echor(arr(ctr),(tablevel+1))
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
echo ")"
else
if IsDictionary(arr(ctr)) then
echo "["&ctr&"] => dictionary("
x = Echor(arr(ctr),(tablevel+1))
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
echo ")"
else
echo "["&ctr&"] => {"&arr(ctr)&"}"
end if
end if
next
end if
end if
if tablevel = 0 then
echo ")"
end if
end function
'Checks to see if the variable is a Scripting.Dictionary
'returns true if it is, false if it is not
function IsDictionary(dictionary)
on error resume next
for each i in dictionary
x = dictionary(i)
if err.number > 0 then
IsDictionary = false
on error goto 0
exit function
else
IsDictionary = true
on error goto 0
exit function
end if
next
on error goto 0
end function
'will display the contents of the supplied array. Used for debugging purposes
' Array(
' [0] = a
' [1] = b
' [2] = c
' [3] = Array (
' [0] = aa
' [1] = bb
' [2] = cc
' )
' }
function Print_r(arr)
x = echor(arr,0)
end function
'Returns a Unix Timestamp
function MakeTimestamp(datetime)
MakeTimestamp = DateDiff("s", "01/01/1970 00:00:00", datetime)
end function
'Returns a datetime
function UnMakeTimestamp(timestamp)
UnMakeTimestamp = DateAdd("s",timestamp, "01/01/1970 00:00:00")
end function
'used by DateFormat
function AddZeros(num,length)
str = num
if len(str) <> length then
while len(str) <> length
str = "0"&str
wend
end if
AddZeros = str
end function
'This function takes in a date or a timestamp as well as a format and will return the date in the specified format
' ex: DateFormat("1/1/2005","%M %j %Y") would return Jan 1 2005
function DateFormat(datetime,format)
if IsNumeric(datetime) then
datein = UnMakeTimestamp(datetime)
else
if IsDate(datetime) then
datein = datetime
else
DateFormat = "date invalid"
exit function
end if
end if
arr = split(datein," ")
arr2 = split(arr(0),"/")
arr3 = split(arr(1),":")
amlow = lcase(arr(2))
amup = ucase(arr(2))
m = AddZeros(arr2(0),2)
m2 = arr2(0)
mname = monthname(arr2(0))
mshortname = left(monthname(arr2(0)),3)
d = AddZeros(arr2(1),2)
d2 = arr2(1)
hsmall = AddZeros(arr3(0),2)
hsmall2 = arr3(0)
if amlow = "pm" then
hbig = AddZeros(arr3(0)+12,2)
hbig2 = arr3(0)+12
else
hbig = AddZeros(arr3(0),2)
hbig2 = arr3(0)
end if
mn = AddZeros(arr3(1),2)
mn2 = arr3(1)
s = AddZeros(arr3(2),2)
s2 = arr3(2)
y = right(arr2(2),2)
y2 = arr2(2)
format = replace(format,"%A",amlow) '%A - AM or PM
format = replace(format,"%a",amup) '%a - am or pm
format = replace(format,"%m",m) '%m - Month with leading zeroes (01 - 12)
format = replace(format,"%n",m2) '%n - Month without leading zeroes (1 - 12)
format = replace(format,"%F",mname) '%F - Month name (January - December)
format = replace(format,"%M",mshortname) '%M - Three letter month name (Jan - Dec)
format = replace(format,"%d",d) '$d - Day with leading zeroes (01 - 31)
format = replace(format,"%j",d2) '%j - Day without leading zeroes (1 - 31)
format = replace(format,"%H",hsmall) '%H - Hour with leading zeroes (12 hour)
format = replace(format,"%h",hbig) '%h - Hour with leading zeroes (24 hour)
format = replace(format,"%G",hsmall2) '%G - Hour without leading zeroes (12 hour)
format = replace(format,"%g",hbig2) '%g - Hour without leading zeroes (24 hour)
format = replace(format,"%i",mn) '%i - Minute with leading zeroes (01 to 60)
format = replace(format,"%I",mn2) '%I - Minute without leading zeroes (1 to 60)
format = replace(format,"%s",s) '%s - Second with leading zeroes (01 to 60)
format = replace(format,"%S",s2) '%S - Second without leading zeroes (1 to 60)
format = replace(format,"%y",y) '%y - Two digit year (03)
format = replace(format,"%Y",y2) '%Y - Four digit year (2003)
DateFormat = format
end function
'This function is used with CheckForm
'typein is a regex used to test the value
'fail is the message to display when the value fails the test
function RegisterForm(namein,test,errname,fail)
AddArray forms,array(namein,test,errname,fail)
end function
'This function is used with CheckForm
'namein is the name of the field
'fail is the message to display
function RegisterError(namein,errname,fail)
AddArray errors,array(namein,errname,fail)
end function
'This function builds an array full of the errors that were contained in the array
'created by RegisterForm. If the IsArray(errors) then the form contained errors.
function CheckForm()
set regex = new regexp
regex.Global = true
regex.IgnoreCase = true
if IsArray(forms) then
for frmctr = 0 to ubound(forms)
regex.Pattern = forms(frmctr)(1)
if not regex.Test(request.form(forms(frmctr)(0))) then
err = RegisterError(forms(frmctr)(0),forms(frmctr)(2),forms(frmctr)(3))
end if
next
end if
end function
%>
Reply With Quote
Originally Posted by hillsy
Bookmarks