" & vbNewLine
StrOut=strOut & "" & vbNewLine
ExpedientForm=strOut
end function
function LabelProcess(byval strIn)
'Gus Mueller, April 17 2000
'inserts space between case changes in a field name to improve readability
dim intLen, t, chrThis, chrThat, chrNext, intStart
if strIn<>"" then
intLen=len(strIn)
intStart=2
do until intStart>=intLen
for t=intStart to intLen
chrThis=mid(strIn, t, 1)
chrThat=mid(strIn, t-1, 1)
if lcase(chrNext)=chrNext and lcase(chrThis)<>chrThis and chrThat<>" " then 'new word!
strIn=left(strIn, t-1) & " " & mid(strIn, t)
exit for
end if
next
intStart=t+1
loop
end if
LabelProcess=strIn
end function
function RequestProcess(strExclude, strAdditional)
'Gus Mueller, April 17 2000
'comes back with the bulk of a SQL statement with the parameters from the request object
'strExclude contains a ^-delimited list of fields to avoid processing.
'you still need to come up with a stored procedure and any additional parameters
'to include
dim strSQLOut, objRequest, intCount, strValue, intSkip, strFieldPrefix, dtmThis
strExclude=strExclude & "^submit"
if request.form.count >0 then
set objRequest=request.form
else
set objRequest=request.querystring
end if
intCount=0
for each field in objRequest
if intSkip=0 then
if not inList(strExclude, field) then
if instr(field, "_month")<1 then
if intCount>0 then
strSQLOut = strSQLOut & ","
end if
strSQLOut = strSQLOut & "@" & field & "="
strValue=objRequest(field)
if isNumeric(strValue) then
strQuote=""
else
strQuote="'"
end if
strSQLOut = strSQLOut & strQuote & quote(objRequest(field)) & strQuote
else 'handle the special case of date drop downs (three different inputs!
'that need to be combined into a single date
intSkip=2
strFieldPrefix=split(field, "_")(0)
dtmThis=datehandle(objRequest(field) & "/" & objRequest(strFieldPrefix & "_day") & "/" & objRequest(strFieldPrefix & "_year"), "12/31/99")
if intCount>0 then
strSQLOut = strSQLOut & ","
end if
strSQLOut = strSQLOut & "@" & strFieldPrefix & "="
strSQLOut = strSQLOut & "'" & dtmThis & "'"
end if
intCount=intCount+1
end if
else
intSkip=intSkip-1 'skip the extra date fields, which are already read
end if
next
set objRequest=nothing
if strAdditional<>"" then
strSQLOut = strSQLOut & "," & strAdditional
end if
RequestProcess=strSQLOut
end function
function quote(strIn) 'escape single quotes for database
dim strOut
strOut=strIn
if not isnull(strOut) then
if strOut<>"" then
strOut=replace(cstr(strOut), "'", "''")
else
strOut=null
end if
else
strOut=null
end if
quote=strOut
end function
function inList(strIn, strPossibleBad)
'determines if strPossibleBad is within the ^-delimited list of strIn
dim bwlOut, intParseBan
bwlOut=false
intParseBan=0
if strIn<>"" then
if instr(strIn, "^") then
arrBan=split(strIn, "^")
do until intParseBan > ubound(arrBan) or bwlOut=true
strPossibleBan=trim(arrBan(intParseBan))
if strPossibleBan<>"" then
if lcase(strPossibleBan) = lcase(strPossibleBad) then
bwlOut=true
end if
end if
intParseBan=intParseBan+1
loop
else
if strPossibleBad<>"" then
if lcase(strPossibleBad)=lcase(strIn) then bwlOut=true
end if
end if
end if
inList = bwlOut
end function
function RecordList(rstIn, strIDField, strLabelField, strDescriptionField, strProcessForm, intPerPage, intStyle)
'Gus Mueller, April 19 2000
'comes back with an index list from an index recordset, displayed with checkboxes and hyperlinks
'for working with the individual records.
'intStyles: 0-simple (no table) 1-table with alternating colors 2-table single color
'3-table with the other single color
'strIDField is the primary key, used to identify a specific record
'strLabelField is the human-readable primary record identifier
'strDescriptionField is the record description
'strProcessForm is the URL of the form processor
dim strOut, strPreHTML, strPostHTML, strMidHTML, strHeaderHTML, strFooterHTML, strRowEnd, intRowCount
strOut=""
strHeaderHTML="