Requires yStr
< %
<%
'#############
'#
'# ASP on Rails version 1.0
'# Questions? stephen@yeago.net
'# ...Yes, I know the name is cheesy.
'#
'#############
Class ySQL
Private i_id
Private i_Table '# "i_" = "internal"
Private i_TableRS
Private i_TableArray
Private i_Exclusions
Private i_Exceptions
Private i_Dependz '# Not the Adult diaper
Private i_debugMode
Private Conn
Private Sub Class_Initialize
set i_Exclusions = Server.CreateObject("Scripting.Dictionary")
set i_Exceptions = Server.CreateObject("Scripting.Dictionary")
set i_Dependz = Server.CreateObject("Scripting.Dictionary")
exclude("id")
set Conn = CreateObject("ADODB.Connection")
'DSNtest="DRIVER={SQL Server};SERVER=???;UID=???;PWD=???;DATABASE=???"
'Conn.open DSNtest
Conn.open(CleanConn)
End Sub
Public Function Combine(masterID,slaveID)
if i_Dependz.count = 0 then
Err.Raise vbObjectError, "Combine error" ,"No dependencies given!"
elseif masterID = slaveID then
Err.Raise vbObjectError, "Combine error" ,"Combine a record with itself?!"
end if
For Each d in i_Dependz
Execute(updateSQL(d,i_Dependz(d),masterID,i_Dependz(d),slaveID))
Next
Delete(slaveID)
End Function
Public Function clean(input)
'########
'# Attempts to strip any kind of ugliness from user input (bad characters and SQL injections).
'########
output = Replace(Replace(Replace(Replace(Replace(Replace(Replace(input,"‘","'"),"’","'"),Chr(148),""""),Chr(147),""""),Chr(133),"..."),Chr(150),"--"),Chr(151),"--")
output = Replace(output,"AMPERSAND","&")
output = Replace(output,"POUNDSIGN","#")
output = Replace(output,"COMMA",",")
output = Replace(output,"©","©")
output = Replace(output,"'","''")
clean = output
End Function
Public Sub debugMode()
if i_debugMode = true then
Response.write "Debug Mode OFF!”
i_debugMode = false
else
Response.write “Debug Mode ON! Queries not executed; sent to browser!”
i_debugMode = true
end if
End Sub
Public Function Delete(recordID)
For Each d in i_Dependz
sql = deleteSQL(d,i_Dependz(d),recordID)
Execute(sql)
Next
Execute(deleteSQL(i_Table,”id”,recordID))
End Function
Public Function deleteSQL(table,key,value)
deleteSQL = “DELETE FROM ” & table & ” WHERE ” & key & ” = ” & value
End Function
Public Function Depend(table,intersection)
if NOT i_Dependz.exists(lcase(table)) then
i_Dependz.Add table,intersection
end if
End Function
Public Function addMany()
dim count
count = 0
sep = “, ” ‘# Separator… This should probably *NOT* be changed, but it may vary I guess.
‘***
‘ We need to generate a ‘key’ above as a kind if placeholder, so we know how many times to Enumerate through the Querystring.
‘***
For Each field in i_TableArray
if NOT is_excepted(field) and NOT is_excluded(field) and key = “” then
if Request(field) <> “” OR Request(field) <> “” then
key = field
elseif right(field,4) = “Date” then
prefix = split(field,”Date”)(0)
if Request(prefix & “MM”) <> “” OR Request(prefix & “MM”) <> “” then
key = prefix & “MM”
end if
end if
end if
next
if key = “” then
‘ Err.Raise vbObjectError, “AddMany error” ,”No key generated for ” & i_Table & “!”
else
set previousExceptions = Server.CreateObject(”Scripting.Dictionary”)
For Each ex in i_Exceptions ‘####
previousExceptions.Add ex,true ‘# Necessary so previously given exceptions are not overwritten.
Next ‘####
For Each item in Request(key)
For Each field in i_TableArray
if NOT is_excluded(field) then
if right(field,4) = “Date” then
prefix = split(field,”Date”)(0)
MM = Request(prefix & “MM”)
DD = Request(prefix & “DD”)
YYYY = Request(prefix & “YYYY”)
if uBound(split(MM,”, “)) <> -1 then
value = split(MM,sep)(count) & “/” & split(DD,sep)(count) & “/” & split(YYYY,sep)(count)
else
value = MM & “/” & DD & “/” & YYYY
end if
else
values = split(Request(field),sep)
if UBound(values) <> -1 then
value = values(count)
else
value = Request(field)
end if
end if
if is_excepted(field) and NOT previousExceptions.exists(lcase(field)) then
i_Exceptions(lcase(field)) = value
else
exception field,value
end if
end if
next
if item <> “” then
call Add()
end if
count = count + 1
next
end if
end function
Public Function is_excluded(field)
if i_Exclusions.exists(lcase(field)) then
is_excluded = true
else
is_excluded = false
end if
End Function
Public Function is_excepted(field)
if i_Exceptions.exists(lcase(field)) then
is_excepted = true
else
is_excepted = false
end if
End Function
Public Sub Execute(sql)
Dim i
if i_debugMode = true then
response.write “Q: ” & sql & “”
set excp = new yStr
set excl = new yStr
For Each i in i_Exceptions
if excp.output() <> “” then
excp.App(”,”)
end if
excp.App(i & ” = ‘” & i_Exceptions(i) & “‘”)
Next
For Each i in i_Exclusions
if excl.output() <> “” then
excl.App(”,”)
end if
excl.App(i & ” = ‘” & i_Exclusions(i) & “‘”)
Next
‘response.write “Excepts: ” & excp.output() & “”
‘response.write “Exclude: ” & excl.output() & “”
else
Conn.Execute(sql)
end if
End Sub
Public Function exception(fieldName,value) ‘#########
if NOT i_Exceptions.exists(lcase(fieldName)) then ‘# Force field ‘x’ to have value ‘y’
i_Exceptions.Add lcase(fieldName),cstr(value) ‘# -Will override form-submitted values
end if ‘# -Will *not* override excluded fields (below)
End Function ‘#########
Public Function exclude(fieldName) ‘#########
if NOT i_Exclusions.exists(lcase(fieldName)) then ‘# Ignore field
i_Exclusions.Add lcase(fieldName),true ‘# -by default ignores ‘id’ (can’t change id!)
end if ‘#########
End Function
Public Function exists(fieldName)
if i_TableArray.exists(fieldName) = true then
exists = true
else
exists = false
end if
End Function
Public Function fieldsToSQL ‘##########
dim SQL ‘# Takes table and returns SQL-digestible
set SQL = new yStr
For Each name in i_TableArray
if not i_Exclusions.exists(lcase(name)) then
if SQL.output() <> “” then
SQL.App(”,”)
end if
SQL.App(name)
end if
Next
fieldsToSQL = SQL.output()
End Function
Public Function getDataType(ByVal strValue)
‘########
‘# Gets the data type (varchar, int, bit, etc) of a field.
‘# Quite handy inside and outside the class.
‘########
if i_TableArray.exists(strValue) then
getDataType = i_TableArray(strValue)
else
getDataType = False ‘Err.Raise vbObjectError, “getDataType function error” ,”No field ‘” & strValue & “‘ within ” & i_Table
end if
End Function
Public Function getValue(test)
if i_Exclusions.exists(lcase(test)) then
getValue = false ‘########
else ‘# Checks excludes, exceptions, GET variables
if i_Exceptions.exists(lcase(test)) then ‘# and returns a database-ready result.
value = i_Exceptions(lcase(test)) ‘# Internally used but useful for debugging.
elseif IsDate(ifDate(test)) then ‘########
value = ifDate(test)
elseif Request(test) <> false then
value = Request(test)
elseif Request(test) <> false then
value = Request(test)
else
value = false
end if
if getDataType(test) = “bit” and value <> false then
Select Case lcase(value)
case “yes”,”true”,”1″,”on”
value = “True”
case “no”,”false”,”0″,”off”
value = “False”
end Select
end if
if i_debugMode = true then
‘ response.write “” & test & “=’” & value & “‘ | ”
end if
getValue = value
end if
End Function
Public Function insertSQL
‘########
‘# Returns a tasty SQL insert query. Internally used but good for
‘# other things as well.
‘########
insertSQL = “INSERT INTO ” & i_Table & ” (” & fieldsToSQL() & “) VALUES (” & valuesToSQL() & “)”
End Function
Public Function toXML(id)
if i_id = “” then
i_id = id
end if
if i_id <> “” then
set i_rs = Conn.Execute(”SELECT * FROM ” & i_Table & ” WHERE id = ” & i_id)
Set toXML = Server.CreateObject(”MSXML2.DOMDocument.3.0″)
Set root = toXML.createNode(”element”, “Records”, “”)
toXML.setProperty “ServerHTTPRequest”,true
toXML.validateOnParse = False
toXML.resolveExternals = False
toXML.appendChild (root)
Do while not i_rs.EOF
Set onode = toXML.createNode(”element”, “Record”, “”)
toXML.documentElement.appendChild (onode)
for each x in i_rs.fields
Set inode = toXML.createNode(”element”, x.name , “”)
if(x <> “”) then
if x.type = “11″ then
if x = true then
value=”True”
else
value=”False”
end if
else
value = x.value
end if
inode.Text = value
end if
onode.appendChild (inode)
next
i_rs.movenext
Loop
else
toXML = false
end if
End Function
Public Sub Table(ByVal strValue)
‘########
‘# Declares what table we’re dealing with.
‘# Most of this class breaks if this isn’t set first! =)
‘########
i_Table = strValue
set i_TableRS = Conn.Execute(”SELECT COLUMN_NAME,DATA_TYPE FROM INFORMATION_SCHEMA.Columns WHERE TABLE_NAME = ‘” & i_Table & “‘”)
set i_TableArray = Server.CreateObject(”Scripting.Dictionary”)
While Not i_TableRS.EOF
i_TableArray.Add i_TableRS(”COLUMN_NAME”).value, i_TableRS(”DATA_TYPE”).value
i_TableRS.MoveNext
Wend
End Sub
Public Function valuesToSQL
‘########
‘# Makes a bunch of checks to create the VALUES(. . .) in an INSERT query
‘# Handles annoying quotes and stuff.
‘########
dim SQL
set SQL = new yStr
For Each name in i_TableArray
if not is_excluded(name) then
if SQL.output() <> “” then
SQL.App(”,”)
end if
value = getValue(name)
if value = false and exists(name) then
value = “NULL”
elseif getDataType(name) = “bit” then
if value = “False” then
value = “0″
elseif value = “True” then
value = “1″
end if
end if
value = clean(value & “”)
if NOT left(lcase(value),8) = “convert(” AND NOT left(lcase(value),5) = “cast(” AND NOT lcase(value) = “null”and NOT getDataType(name) = “int” then
value = “‘” & value & “‘”
end if
SQL.App(value)
end if
Next
valuesToSQL = SQL.output()
End Function
Public Function Update(recordID)
i_id = cstr(recordID)
dim insert ‘########
dim changes ‘# Updates a particular record with form-submitted values
dim Old ‘# and exceptions. Ignores excludes. Protects against SQL
‘# injections and handles datatypes correctly
‘########
dim f
if i_Table = “” then
Err.Raise vbObjectError, “Update error” ,”No table set!”
end if
if recordID = “” then
Err.Raise vbObjectError, “Update error” ,”Junk RecordID given! [” & recordID & “]”
end if
set Old = Conn.Execute(”SELECT * From ” & i_Table & ” WHERE id = ” & recordID)
if NOT Old.EOF then
for each f in Old.Fields
newValue = getValue(f.Name)
if exists(f.Name) then
if (newValue <> false ) OR (newValue = false and getDataType(f.Name) = “datetime” and f.value <> “” and (Request(f.Name) <> false OR Request(split(f.Name,”Date”)(0) & “MM”) <> false) ) then
fieldName = f.Name
if replace(clean(newValue),”””,”‘”) <> cstr(f.value & “”) then
call updateField(fieldName,newValue,recordID)
changes = “on”
else
‘Execute(”–Skipping ” & f.Name & ” (” & newValue & “|” & f.value & “)”)
end if
end if
end if
next
if getValue(”combine”) <> “” and getValue(”combine”) <> False then
call Combine(recordID,getValue(”combine”))
changes = “on”
end if
if changes = “on” then
Update = true
else
Update = false
end if
else
Err.Raise vbObjectError, “Update error” ,”Record ” & recordID & ” does not exist in ” & i_Table & “!”
end if
end function
Public Function updateField(field,value,recordID)
‘####
‘# field: Field name to match with input value of the same name
‘# insert: Value submitted by the form (If its different, we’re Update()ing it.
‘# recordID: Get Record [id] of table [tbl] and check [field] for [insert]
if getDataType(field) = “bit” then
if value = “False” then
value = “0″
elseif value = “True” then
value = “1″
end if
elseif getDataType(field) = “datetime” and value = False then
value = “NULL”
end if
value = clean(value)
if value <> “nil” then
if lcase(value) <> “null” then
value = “‘” & value & “‘”
end if
if i_debugMode = true then
set previous = Conn.Execute(”SELECT ” & field & ” FROM ” & i_Table & ” WHERE id = ” & recordID)
if NOT previous.EOF then
append = ” –was ‘” & Previous.Fields.Item(field) & “‘”
else
append = “”
end if
end if
Execute(updateSQL(i_Table,field,value,”id”,recordID) & append)
end if
End Function
Public Function updateSQL(table,field,newValue,key,value)
updateSQL = “UPDATE ” & table & ” SET ” & field & ” = ” & newValue & ” WHERE ” & key & ” = ” & value
End Function
Public Function Add()
if getValue(”addedBy”) = false then
call exception(”addedBy”,Session(”userID”))
end if
call exception(”timestamp”,NOW())
Execute(insertSQL())
i_id = lastInsertID()
Add = i_id
End Function
Public Function lastInsertID()
Set LastID = Conn.Execute(”SELECT Ident_Current(’” & i_Table & “‘) as LastID”)
if NOT LastID.EOF then
lastInsertID = LastID(”lastID”)
end if
End Function
Private function ifDate(name)
‘Name: Name of form input to be tested to contain ‘Date’.
‘ If it does match, we grab its components (MM + DD + YYYY) and return.
‘ Elsewise, we pass false and move on with our lives.
if right(name,4) = “Date” then
prefix = split(name,”Date”)(0)
if Request(prefix & “MM”) <> “” then
MM = Request(prefix & “MM”)
DD = Request(prefix & “DD”)
YYYY = Request(prefix & “YYYY”)
‘ elseif Request(prefix & “MM”) <> “” then
‘ MM = Request(prefix & “MM”)
‘ DD = Request(prefix & “DD”)
‘ YYYY = Request(prefix & “YYYY”)
end if
if MM <> “” then
ifDate = MM & “/” & DD & “/” & YYYY
elseif MM = “” then
ifDate = “NULL”
end if
else
ifDate = false
end if
End Function
End Class
Class yXSL
Private i_xsl
Private i_xml
Private i_rs
Private i_pass
Private Sub Class_Initialize
if Request(”xsl”) = “” then
i_xsl = “xsl/main.xsl”
else
i_xsl = “xsl/” & Request(”xsl”) & “.xsl”
end if
set i_pass = Server.CreateObject(”Scripting.Dictionary”)
set Conn = CreateObject(”ADODB.Connection”)
‘DSNtest=”DRIVER={SQL Server};SERVER=???;UID=???;PWD=???;DATABASE=???”
‘Conn.open DSNtest
Conn.open(CleanConn)
End Sub
Public Function xsl(xslFile)
i_xsl = “xsl/” & xslFile & “.xsl”
End Function
Public Function xml(xmlFile)
if isObject(xmlFile) then
set i_xml = xmlFile
else
i_xml = “”
end if
End Function
Public Function rs(passedRS)
if NOT IsObject(passedRS) then
Err.Raise vbObjectError, “RS error” ,”Junk recordset passed!”
else
set i_rs = passedRS
end if
End Function
Public Sub outputXML()
if IsObject(i_rs) then
response.ContentType=”application/xml”
response.write “< ?xml version='1.0' encoding='windows-1252'?>”
response.write toXML().xml
end if
End Sub
Public Function pass(fieldName)
if NOT i_pass.exists(lcase(fieldName)) then
i_pass.Add lcase(fieldName),true
end if
End Function
Public Function toXML()
Set toXML = Server.CreateObject(”MSXML2.DOMDocument.3.0″)
Set root = toXML.createNode(”element”, “Records”, “”)
toXML.setProperty “ServerHTTPRequest”,true
toXML.validateOnParse = False
toXML.resolveExternals = False
toXML.appendChild (root)
While not i_rs.EOF
Set onode = toXML.createNode(”element”, “Record”, “”)
toXML.documentElement.appendChild (onode)
for each x in i_rs.fields
Set inode = toXML.createNode(”element”, x.name , “”)
if(x <> “”) then
if x.type = “11″ then
if x = true then
value=”True”
else
value=”False”
end if
else
value = x.value
end if
inode.Text = value
end if
onode.appendChild (inode)
next
i_rs.movenext
Wend
End Function
Public Sub Transform
Set xmlDoc = server.CreateObject(”Msxml2.FreeThreadedDOMDocument.3.0″)
xmlDoc.async = false
if TypeName(i_xml) <> “DOMDocument” then
if i_xml = “null” or i_xml = “” then
Set root = xmlDoc.createNode(”element”, “Records”, “”)
xmlDoc.appendChild(root)
Set onode = xmlDoc.createNode(”element”, “Record”, “”)
xmlDoc.documentElement.appendChild (onode)
else
xmlDoc.load(Server.MapPath(i_xml))
end if
else
xmlDoc.load(i_xml)
end if
xmlDoc.setProperty “ServerHTTPRequest”,true
xmlDoc.validateOnParse = False
xmlDoc.resolveExternals = False
Set xslt = server.CreateObject(”MSXML2.XSLTemplate.3.0″)
Set xslDoc = server.CreateObject(”MSXML2.FreeThreadedDOMDocument.3.0″)
xslDoc.async = false
xslDoc.load(server.MapPath(i_xsl))
xslt.stylesheet = xslDoc
Set xslProc = xslt.createProcessor()
xslProc.input = xmlDoc
for each req in i_pass
value = i_pass(req)
xslProc.addParameter req, value
next
for each req in Session.Contents
value = Session(req)
xslProc.addParameter req, value
next
for each req in Request.QueryString
value = Request.QueryString(req)
xslProc.addParameter req, value
next
‘ xslProc.addObject Session, “urn:ASPSession”
‘ xmlDoc.save Server.MapPath(”saved.xml”)
xslProc.transform
response.write xslProc.output
End Sub
Public Sub toCSV(filename)
set output = new yStr
total = i_rs.Fields.Count
count = 0
for each x in i_rs.Fields
output.App “”"” & x.name & “”"”
if count < total then
output.App ","
end if
count = count + 1
next
output.App vbCrLf
While not i_rs.EOF
set record = new yStr
for each x in i_rs.fields
if(isNull(x)) or x = "" then
x = " "
end if
'x = Replace(x,",","\\,")
if record.output = "" then
record.App """" & x
else
record.App """,""" & x
end if
next
output.App record.output & """" & vbCrLf
i_rs.movenext
wend
Response.Clear()
Set userAgent=Server.CreateObject("MSWC.BrowserType")
if userAgent.browser = "IE" then
Response.AddHeader "Content-Disposition","attachment;filename=export.csv"
Response.ContentType = "text/csv"
else
Response.AddHeader "Content-Disposition","attachment;filename=" & Replace(filename," ","_") &".csv"
response.ContentType = "text/csv"
end if
response.write output.output
response.End
End Sub
End Class
%>
