Handy ASP stuff

Handy ASP stuff

--------------------------------------------------------------------------------

Description : This is a compilation of functions I use when working on ASP projects. There are functions to build HTML form elements (and whole forms), HTML tables, smart date drop down boxes, capitalization functions, date functions, a sql quote handler, a bunch of stuff.

<%
''''''DevinsHandyASPstuff'''''''''''''''
'
'purpose: This is just a compilation of numerous ASP function I have built and use. Each one should be
' commented.
'
'programmer: Devin Garlit dgarlit@hotmail.com
'
'write(strString)
'buildTextBox(strValue, strFieldName, intSize, intMaxSize, blnLabel, strLabel)
'buildPasswordBox(strValue, strFieldName, intSize, intMaxSize, blnLabel, strLabel)
'buildHidden(strValue, strFieldName, intSize, intMaxSize, blnDisplayValue, strDisplayValue)
'buildCheckBox(strValue, strFieldName, blnChecked, blnDisplayValue, strDisplayValue)
'buildRadioButton(strValue, strFieldName, blnDisplayValue, strDisplayValue)
'buildTextArea(strValue, strFieldName, intCols, intRows, strWrap)
'buildDropDownFromDB( objConnection, strSQL, strName)
'buildDropDownFromDBwithTitle( objConnection, strSQL, strName, strTitle)
'createAForm(RS, strFormName, strFormMethod, strFormAction)
'requestAndIncludeAsHidden()
'CheckQuotes (strValue)
'a cut and paste cache-control script
'write(strString) 'instead of response.write
'RemoveHTMLTags (strString)
'isOdd (strNum)
'Caps(strString) - capitalize the first letter of a string
'capAllWords (strString)
'GetYear (strDate)
'GetMonthNum (strDate)
'GetDayNum (strDate)
'GetDateWithDay (strDate) 'return day and date like this: Saturday, September 24, 1977
'GetLongDate (strDate)
'GetDateFromParts(strMonth, strDay, strYear) 'returns a date from the month, day and year, allows an empty String For day( but will pull the first of the month
'writeTable(intCols, intRows, arrValues, strTableAttributes, strRowAttributes, strCellAttributes )
'writeTable2(arrValues, strTableAttributes, strRowAttributes, strCellAttributes )
'createAForm2WHidden(RS, intColumnSplit, strFormName, strFormMethod, strFormAction, strButton)
'createAForm2(RS, intColumnSplit, strFormName, strFormMethod, strFormAction, strButton, strEditFlag)
'getDaysInMonth(strMonth,strYear)
'
'writeDropDowns()
' writeDropDowns is a way I used MonthDropDown, DayDropDown, and YearDropDown together
' basically, the point was that I didn't want someone To Select 30 For the month of february
' so it resubmits To the page(that could be costly depending on what Else is goin on) With the selected
' day,month,year and it sets/resets the days according To the month and year so the user cannot Select
' day 30 For month 2
'MonthDropDown(strName, blnNum, strSelected, strSelfLink)
'YearDropDown(strName, intStartYear, intEndYear, strSelected, strSelfLink)
'DayDropDown(strName, intStartDay, intEndDay, strSelected )
'beginDoc (strTitle)
'endDoc()

'''instead of writing out response.write
' all the time
Sub Write(strString)
Response.Write strString
End Sub

'**************************************************************
'Function: buildTextBox(strValue, strFieldName, intSize, intMaxSize, blnLabel, strLabel)
'
'Returns: an String of an HTML input field
'
'Inputs:
' strValue = a String of the value For the input field
' strFieldName = a String of the name of the input field
' intSize = an Integer of the size of the input field
' intMaxsize = an Integer of the maxlength of the input field
' blnLabel = a true/false To determine if a label will be placed in front of the input field
' strLabel = the label To be used if blnLabel is True
'
'Notes:
'
'Programmer: Devin Garlit dgarlit@hotmail.com. 4/01/01
'**************************************************************
Function buildTextBox(strValue, strFieldName, intSize, intMaxSize, blnLabel, strLabel)
If CBool(blnLabel) Then
buildTextBox = strLabel & " " & "<INPUT type='text' name='" & strFieldName & "' value='" & strValue & "' size='" & intSize & "' maxlength='"& intMaxSize & "'>"
Else
buildTextBox = "<INPUT type='text' name='" & strFieldName & "' value='" & strValue & "' size='" & intSize & "' maxlength='"& intMaxSize & "'>"
End If
End Function

Function buildPasswordBox(strValue, strFieldName, intSize, intMaxSize, blnLabel, strLabel)
If CBool(blnLabel) Then
buildPasswordBox = strLabel & " " & "<INPUT type='Password' name='" & strFieldName & "' value='" & strValue & "' size='" & intSize & "' maxlength='"& intMaxSize & "'>"
Else
buildPasswordBox = "<INPUT type='Password' name='" & strFieldName & "' value='" & strValue & "' size='" & intSize & "' maxlength='"& intMaxSize & "'>"
End If
End Function

'**************************************************************
'Function: buildHidden(strValue, strFieldName, intSize, intMaxSize, blnDisplayValue, strDisplayValue)
'
'Returns: an String of an HTML hidden field
'
'Inputs:
' strValue = a String of the value For the input field
' strFieldName = a String of the name of the input field
' blnDisplayValue = a true/false To determine if a value will be displayed
' strDisplayValue = the value To be displayed if blnDisplayValue is True
'
'Notes:
'
'Programmer: Devin Garlit dgarlit@hotmail.com. 4/01/01
'**************************************************************
Function buildHidden(strValue, strFieldName, blnDisplayValue, strDisplayValue)
If CBool(blnDisplayValue) Then
buildHidden = strDisplayValue & " " & "<INPUT type='hidden' name='" & strFieldName & "' value='" & strValue & "'>"
Else
buildHidden = "<INPUT type='hidden' name='" & strFieldName & "' value='" & strValue & "'>"
End If
End Function

'**************************************************************
'Function: buildCheckBox(strValue, strFieldName, blnChecked, blnDisplayValue, strDisplayValue)
'
'Returns: an String of an HTML checkbox
'
'Inputs:
' strValue = a String of the value For the checkbox
' strFieldName = a String of the name of the checkbox
' blnChecked = a true/false whether the box is checked(true) or uncheck(false)
' blnDisplayValue = a true/false To determine if a value will be displayed
' strDisplayValue = the value To be displayed if blnDisplayValue is True
'
'Notes: if True the display value is displayed after the checkbox
'
'Programmer: Devin Garlit dgarlit@hotmail.com. 4/01/01
'**************************************************************
Function buildCheckBox(strValue, strFieldName, blnChecked, blnDisplayValue, strDisplayValue)
Dim strChecked
If CBool(blnChecked) Then
strChecked = "CHECKED"
Else
strChecked = ""
End If

If CBool(blnDisplayValue) Then
buildCheckBox = "<INPUT type='checkbox' name='" & strFieldName & "' value='" & strValue &"' " & strChecked & ">" & " " & strDisplayValue
Else
buildCheckBox = "<INPUT type='checkbox' name='" & strFieldName & "' value='" & strValue &"'" & strChecked & ">"
End If
End Function

'**************************************************************
'Function: buildRadioButton(strValue, strFieldName, blnDisplayValue, strDisplayValue)
'
'Returns: an String of an HTML radio button
'
'Inputs:
' strValue = a String of the value For the radio button
' strFieldName = a String of the name of the radio button
' blnDisplayValue = a true/false To determine if a value will be displayed
' strDisplayValue = the value To be displayed if blnDisplayValue is True
'
'Notes: if True the display value is displayed after the radio button
'
'Programmer: Devin Garlit dgarlit@hotmail.com. 4/01/01
'**************************************************************
Function buildRadioButton(strValue, strFieldName, blnDisplayValue, strDisplayValue)
If CBool(blnDisplayValue) Then
buildRadioButton = "<INPUT type='radio' name='" & strFieldName & "' value='" & strValue &"'>" & " " & strDisplayValue
Else
buildRadioButton = "<INPUT type='radio' name='" & strFieldName & "' value='" & strValue &"'>"
End If
End Function

'**************************************************************
'Function: buildTextArea(strValue, strFieldName, intCols, intRows, strWrap)
'
'Returns: an String of an HTML textarea
'
'Inputs:
' strValue = a String of the value For the textarea
' strFieldName = a String of the name of the textarea
' intCols = an Integer For the cols attribute
' intRows = an Integer For the rows attribute
' strWrap = a String For the wrap attribute i.e. "virtual"
'
'Notes:
'
'Programmer: Devin Garlit dgarlit@hotmail.com. 4/01/01
'**************************************************************
Function buildTextArea(strValue, strFieldName, intCols, intRows, strWrap)
Dim strTemp
strTemp = "<TEXTAREA cols=" & intCols & " rows=" & intRows & " name='" & strFieldName & "' wrap=" & strWrap & ">"
strTemp = strTemp & buildTextArea & vbCrLf & strValue & vbCrLf & "</TEXTAREA>"
buildTextArea = strTemp
End Function

'**************************************************************
'Function: buildDropDownFromDB( objConnection, strSQL, strName)
'
'Returns: an String of an HTML checkbox
'
'Inputs:
' objConnection = a connection object
' strSQL = a String of a SQL statement
' strName = a String of the name attribute of the Select box
'
'Notes:
'
'Programmer: Devin Garlit dgarlit@hotmail.com. 4/01/01
'**************************************************************
Function buildDropDownFromDB( objConnection, strSQL, strName)
Dim RS 'recordset
Dim strTemp

Set RS = objConnection.execute(strSQL)

strTemp = "<Select name='" & strName& "'>" & vbCrLf

Do While Not RS.EOF
strTemp = strTemp & "<OPTION value='" & RS.fields(0) & "'>" & RS.fields(0) & "</OPTION>" & vbCrLf
RS.MoveNext
Loop

Set RS = Nothing

strTemp = strTemp & "</Select>"

buildDropDownFromDB = strTemp

End Function

'**************************************************************
'Function: buildDropDownFromDBwithTitle( objConnection, strSQL, strName, strTitle)
'
'Returns: an String of an HTML checkbox
'
'Inputs:
' objConnection = a connection object
' strSQL = a String of a SQL statement
' strName = a String of the name attribute of the Select box
' strTitle = a String For the value of the first option of the Select box i.e. "Select"
'
'Notes:
'
'Programmer: Devin Garlit dgarlit@hotmail.com. 4/01/01
'**************************************************************
Function buildDropDownFromDBwithTitle( objConnection, strSQL, strName, strTitle)
Dim RS 'recordset
Dim strTemp

Set RS = objConnection.execute(strSQL)

strTemp = "<Select name='" & strName& "'>" & vbCrLf
strTemp = strTemp & "<OPTION value='" & strTitle & "'>" & strTitle & "</OPTION>" & vbCrLf

Do While Not RS.EOF
strTemp = strTemp & "<OPTION value='" & RS.fields(0) & "'>" & RS.fields(0) & "</OPTION>" & vbCrLf
RS.MoveNext
Loop

Set RS = Nothing

strTemp = strTemp & "</Select>"

buildDropDownFromDBwithTitle = strTemp

End Function

'**************************************************************
'Function: createAForm(RS, strFormName, strFormMethod, strFormAction)
'
'Returns: creates a simple html form of text boxes using buildTextBox from a recordset
'
'Inputs:
' RS = a recordset object
' strFormName = a String of the name of the form
' strFormMethod = a String of the forms method i.e. "post"
' strFormAction = a String of the forms action
'
'Notes: real simple, just lines them up in a simple table and gives a simple submit button
'
'Programmer: Devin Garlit dgarlit@hotmail.com. 4/01/01
'**************************************************************
Function createAForm(RS, strFormName, strFormMethod, strFormAction)
Dim x

Response.Write "<FORM method='" & strFormMethod & "' name='" & strFormName & "' action='" & strFormAction & "'>" & vbCrLf
Response.Write "<TABLE>" & vbCrLf

For x = 0 To RS.Fields.Count-1
Response.Write "<TR><TD>"
Response.Write RS.Fields(x).Name & "</TD><TD>"
Response.Write buildTextBox("", RS.Fields(x).Name, 25, RS.Fields(x).DefinedSize, False, "") & "<BR>"
Response.Write "</TD></TR>" & vbCrLf
Next

Response.Write "<TR><TD> </TD><TD><INPUT type=submit name=Submit value=Submit></TD></TR>" & vbCrLf
Response.Write "</TABLE>" & vbCrLf

Response.Write "</FORM>"
End Function
Function requestAndIncludeAsHidden()
Dim field
For Each Field In Request.Form
buildHidden request(field), field.name, True, request(field)
Next
End Function
'a classic to take care of those pesky q
' uotes when working with SQL
Function CheckQuotes(strValue)
If Not IsNull(strValue) And strValue <> "" Then
CheckQuotes = Replace(strValue,"'","''")
Else
CheckQuotes = strValue
End If
End Function

''''cachecontrol
'''included right after Option Explicit
'Response.Buffer=TRUE
'Response.Expires = 0
'Response.AddHeader "Pragma","no-cache"
'Response.AddHeader "cache-control","no-
' store"

'capitilize first letter
Function Caps(strString)
Caps = UCase(Left(strString,1)) & LCase(Mid(strString,2))
End Function

'capitializ all words In a String
'write capAllWords("we actually Do listen To our users once In a while")
Function capAllWords(strString)
Dim arrTemp, strTemp, i
arrTemp = Split(strString, " ")
For i = 0 To UBound(arrTemp)
strTemp = strTemp & " " & UCase(Left(arrTemp(i),1)) & LCase(Mid(arrTemp(i),2))
Next
capAllWords = strTemp
End Function

'write GetYear("09/24/1977")
'return a simple year # from a String in format of yyyy
Function GetYear(strDate)
GetYear = DatePart("yyyy",strDate)
End Function

'return a month #
Function GetMonthNum(strDate)
GetMonthNum = DatePart("m",strDate)
End Function
'return a day #
Function GetDayNum(strDate)
GetDayNum = DatePart("d",strDate)
End Function

'return day and Date like this: Saturday, September 24, 1977
Function GetDateWithDay(strDate)
GetDateWithDay = FormatDateTime(strDate,1)
End Function

'return Long Date like 9/24/1977
Function GetLongDate(strDate)
GetLongDate = FormatDateTime(strDate,2)
End Function

'returns a Date from the month, day and year, allows an empty String For day( but will pull the first of the month
'write GetDateFromParts("9", "", "77")
'write GetDateFromParts("9", "24", "77")
Function GetDateFromParts(strMonth, strDay, strYear)
If strDay <> "" Then
GetDateFromParts = FormatDateTime(strMonth & "/" & strDay & "/" & strYear)
Else
GetDateFromParts = FormatDateTime(strMonth & "/" & strYear)
End If
End Function

'''''''''''
''''vbs function FormatDateTime formats'''
'd Short Date
'D Long Date
'f Full (long Date + short time)
'F Full (long Date + long time)
'g General (short Date + short time)
'G General (short Date + Long time)
'm, M Month/Day Date
'r, R RFC Standard
's Sortable without TimeZone info
't Short Time
'T Long Time
'u Universal With sort able format
'U Universal With Full (long Date + long time) format
'y, Y Year/Month Date

'returns a true if the number (an int or
' string) is odd, a false otherwise
Function isOdd(strNum)
If CInt(strNum) Mod 2 = 0 Then
isOdd = False
Else
isOdd = True
End If
End Function

'remove HTML tags from a string, note, t
' his won't handle html encoding.
'write RemoveHTMLTags("<B>BOB</
' B> rules")
Function RemoveHTMLTags(strString)
Dim nCharPos, sOut, bInTag, sChar
sOut = ""
bInTag = False
For nCharPos = 1 To Len(strString)
sChar = Mid(strString, nCharPos, 1)
If sChar = "<" Then
bInTag = True
End If
If Not bInTag Then sOut = sOut & sChar
If sChar = ">" Then
bInTag = False
End If
Next
RemoveHTMLTags = sOut
End Function
'''''''''''''''''''''''''''''''''''sorta
' ble table
'dim objConn
'Set objConn = server.CreateObject("ADODB.Connection")
'objConn.Open "passwordlist"
'strSQL = "Select * From passwords"
'createSortableList objConn,strSQL, "id", request("sort"),request("page"),"sort.asp",5, "border=1 bgcolor=steelblue"

'creates a sortable html table
Sub createSortableList(objConn,strSQL, strDefaultSort, strSort, intCurrentPage, strPageName, intPageSize, strLinkedColumnName,strLink,strTableAttributes)
Dim RS 'recordset
Dim strTemp, field, strMoveFirst, strMoveNext, strMovePrevious, strMoveLast
Dim i, intTotalPages, intCurrentRecord, intTotalRecords
i = 0

If strSort = "" Then
strSort = strDefaultSort
End If

If intCurrentPage = "" Then
intCurrentPage = 1
End If

Set RS = Server.CreateObject("adodb.recordset")

With RS
.CursorLocation=3
.Open strSQL & " order by " & Replace(strSort,"desc"," desc"), objConn,adOpenStatic
If Not rs.EOF Then
.PageSize = CInt(intPageSize)
intTotalPages = .PageCount
intCurrentRecord = .AbsolutePosition
.AbsolutePage = intCurrentPage
intTotalRecords = .RecordCount
End If
End With
Response.Write "<TABLE " & strTableAttributes & " >" & vbCrLf
Response.Write "<TR>" & vbCrLf
'if Not rs.EOF Then
For Each field In RS.Fields
Response.Write "<TD>" & vbCrLf
If InStr(strSort, "desc") Then
Response.Write "<A href=" & strPageName & "?sort="& field.name &"&page="&intCurrentPage&">" & field.name & "</A>" & vbCrLf
Else
Response.Write "<A href=" & strPageName & "?sort="& field.name &"desc&page="&intCurrentPage&">" & field.name & "</A>" & vbCrLf
End If
Response.Write "<TD>" & vbCrLf
Next
'end if
Response.Write "<TR>"

For i = intCurrentRecord To RS.PageSize
If Not RS.eof Then
Response.Write "<TR>" & vbCrLf
For Each field In RS.Fields
Response.Write "<TD>" & vbCrLf
If LCase(strLinkedColumnName) = LCase(field.name) Then
Response.Write "<A href=" & strLink & "?sort="& strSort &"&page="&intCurrentPage&">" & field.value & "</A>" & vbCrLf
Else
Response.Write field.value
End If
Response.Write "<TD>" & vbCrLf
Next
Response.Write "<TR>" & vbCrLf
RS.MoveNext
End If
Next
Response.Write "<TABLE>" & vbCrLf

'Response.Write intTotalPages & "" & intCurrentPage
Select Case CInt(intCurrentPage)
Case CInt(intTotalPages) 'last page
strMoveFirst = "<A href=" & strPageName & "?sort="& strSort &"&page=1 >"& "first" &"</A>"
strMoveNext = ""
strMovePrevious = "<A href=" & strPageName & "?sort="& strSort &"&page=" & intCurrentPage - 1 & " >"& "Prev" &"</A>"
strMoveLast = "" '"<A href=" & strPageName & "?sort="& strSort &"&page=" & intTotalPages & " >"
Case 1 'first page
strMoveFirst = "" '"<A href=" & strPageName & "?sort="& strSort &"&page=1 >"
strMoveNext = "<A href=" & strPageName & "?sort="& strSort &"&page=" & intCurrentPage + 1 & " >"& "next" &"</A>"
strMovePrevious = "" '"<A href=" & strPageName & "?sort="& strSort &"&page=" & intCurrentPage - 1 & " >"
strMoveLast = "<A href=" & strPageName & "?sort="& strSort &"&page=" & intTotalPages & " >"& "last" &"</A>"
Case Else
strMoveFirst = "<A href=" & strPageName & "?sort="& strSort &"&page=1 >"& "first" &"</A>"
strMoveNext = "<A href=" & strPageName & "?sort="& strSort &"&page=" & intCurrentPage + 1 & " >"& "next" &"</A>"
strMovePrevious = "<A href=" & strPageName & "?sort="& strSort &"&page=" & intCurrentPage - 1 & " >"& "Prev" &"</A>"
strMoveLast = "<A href=" & strPageName & "?sort="& strSort &"&page=" & intTotalPages & " >"& "last" &"</A>"
End Select

With response
.Write strMoveFirst & " "
.Write strMovePrevious
.Write " " & intCurrentPage & " of " & intTotalPages & " "
.Write strMoveNext & " "
.Write strMoveLast
End With

If RS.State = &H00000001 Then 'its open
RS.Close
End If
Set RS = Nothing
End Sub

'**************************************************************
'Function: writeTable(intCols, intRows, strTableAttributes, strRowAttributes, arrValues)
'
'Returns: writes a html table
'
'Inputs:
' intCols = # of column
' intRows = # of rows
' strTableAttributes = String of table attributes seperated by a space i.e. "border=1 bgcolor=steelblue"
' strRowAttriutes = String of row attributes seperated by a space i.e. "valign=top"
' arrValues = a multidimensional array In format of arr(rows,cols)
'
'Notes:
'
'Programmer: Devin Garlit dgarlit@hotmail.com. 4/01/01
'**************************************************************
Function writeTable(intCols, intRows, arrValues, strTableAttributes, strRowAttributes, strCellAttributes )
Dim i, j
Write "<TABLE " & strTableAttributes & " >" & vbCrLf
For i = 0 To intRows - 1
Write "<TR " & strRowAttributes & " >" & vbCrLf
For j = 0 To intCols - 1
Write "<TD " & strCellAttributes & " >" & vbCrLf
Write arrValues(i,j)
Write "</TD>" & vbCrLf
Next
Write "</TR>" & vbCrLf
Next
Write "</TABLE>" & vbCrLf
End Function

Function writeTable2(arrValues, strTableAttributes, strRowAttributes, strCellAttributes )
Dim i, j
'write ubound(arrValues,1)
'write ubound(arrValues,1)
'Response.end
Write "<TABLE " & strTableAttributes & " >" & vbCrLf
For i = 0 To UBound(arrValues)-1
Write "<TR " & strRowAttributes & " >" & vbCrLf
For j = 0 To UBound(arrValues,1)-1
Write "<TD " & strCellAttributes & " >" & vbCrLf
Write arrValues(i,j)
Write "</TD>" & vbCrLf
Next
Write "</TR>" & vbCrLf
Next
Write "</TABLE>" & vbCrLf
End Function

'***************************************
' ***********************
'Function: createAForm2WHidden(RS, strFo
' rmName, strFormMethod, strFormAction, st
' rButton)
'
'Returns: creates a simple html form of
' hidden fields from a recordset
'
'Inputs:
' RS = a recordset object
' intColumnSplit = the number at which t
' o stop the first column, the rest of the
' fields will go to the next
' strFormName = a string of the name of
' the form
' strFormMethod = a string of the forms
' method i.e. "post"
' strFormAction = a string of the forms
' action
' strButton = a string of html for the
' submit and other action type buttons
'
'Notes: real simple, just lines them up
' in a simple table and gives a simple sub
' mit button
'
'Programmer: Devin Garlit dgarlit@hotmai
' l.com. 4/01/01
'***************************************
' ***********************
Function createAForm2WHidden(RS, intColumnSplit, strFormName, strFormMethod, strFormAction, strButton)
Dim x
Write "<FORM method='" & strFormMethod & "' name='" & strFormName & "' action='" & strFormAction & "'>" & vbCrLf
Write "<TABLE>" & vbCrLf
Write "<TR>" & vbCrLf
Write "<TD valign=top >" & vbCrLf

Write "<TABLE border=1>" & vbCrLf
For x = 0 To intColumnSplit
Write "<TR><TD>" & vbCrLf
Write RS.Fields(x).Name & "</TD><TD>"
Write buildHidden(request(CStr(RS.Fields(x).Name)), RS.Fields(x).Name,True, request(CStr(RS.Fields(x).Name)) )
Write "</TD></TR>" & vbCrLf
Next
Write "</TABLE>" & vbCrLf

Write "</TD>"
Write "<TD valign=top >"

Write "<TABLE border=1>" & vbCrLf
For x = intColumnSplit + 1 To RS.Fields.Count-1
Write "<TR><TD>" & vbCrLf
Write RS.Fields(x).Name & "</TD><TD>"
Write buildHidden(request(CStr(RS.Fields(x).Name)), RS.Fields(x).Name,True, request(CStr(RS.Fields(x).Name)) )
Write "</TD></TR>" & vbCrLf
Next
Write "</TABLE>" & vbCrLf

Write "</TD>" & vbCrLf
Write "</TR>" & vbCrLf
Write "</TABLE>" & vbCrLf
Write strButton & vbCrLf
Write "</FORM>"
End Function

'***************************************
' ***********************
'Function: createAForm2(RS, intColumnSpl
' it, strFormName, strFormMethod, strFormA
' ction, strButton, strEditFlag)
'
'Returns: creates a simple html form of
' hidden fields from a recordset
'
'Inputs:
' RS = a recordset object
' intColumnSplit = the number at which t
' o stop the first column, the rest of the
' fields will go to the next
' strFormName = a string of the name of
' the form
' strFormMethod = a string of the forms
' method i.e. "post"
' strFormAction = a string of the forms
' action
' strButton = a string of html for the
' submit and other action type buttons
' strEditFlag = a string of whether to f
' ill the txtboxes with requested false, t
' rue or false
'
'Notes: real simple, just lines them up
' in a simple table and gives a simple sub
' mit button
'
'Programmer: Devin Garlit dgarlit@hotmai
' l.com. 4/01/01
'***************************************
' ***********************
Function createAForm2(RS, intColumnSplit, strFormName, strFormMethod, strFormAction, strButton, strEditFlag)
Dim x

Write "<FORM method='" & strFormMethod & "' name='" & strFormName & "' action='" & strFormAction & "'>" & vbCrLf
Write "<TABLE>" & vbCrLf
Write "<TR>" & vbCrLf
Write "<TD valign=top >" & vbCrLf

Write "<TABLE border=1>" & vbCrLf
For x = 0 To intColumnSplit
Write "<TR><TD>" & vbCrLf
Write RS.Fields(x).Name & "</TD><TD>"
If CBool(strEditFlag) Then
Write buildTextBox(request(CStr(RS.Fields(x).Name)), RS.Fields(x).Name, 25, RS.Fields(x).DefinedSize, False, "") & "<BR>"
Else
Write buildTextBox("", RS.Fields(x).Name, 25, RS.Fields(x).DefinedSize, False, "") & "<BR>"
End If
Write "</TD></TR>" & vbCrLf
Next
Write "</TABLE>" & vbCrLf

Write "</TD>"
Write "<TD valign=top >"

Write "<TABLE border=1>" & vbCrLf
For x = intColumnSplit + 1 To RS.Fields.Count-1
Write "<TR><TD>" & vbCrLf
Write RS.Fields(x).Name & "</TD><TD>"
If CBool(strEditFlag) Then
Write buildTextBox(request(CStr(RS.Fields(x).Name)), RS.Fields(x).Name, 25, RS.Fields(x).DefinedSize, False, "") & "<BR>"
Else
Write buildTextBox("", RS.Fields(x).Name, 25, RS.Fields(x).DefinedSize, False, "") & "<BR>"
End If
Write "</TD></TR>" & vbCrLf
Next
Write "</TABLE>" & vbCrLf

Write "</TD>" & vbCrLf
Write "</TR>" & vbCrLf
Write "</TABLE>" & vbCrLf
Write strButton & vbCrLf
Write "</FORM>"
End Function
Function getDaysInMonth(strMonth,strYear)
Dim strDays
Select Case CInt(strMonth)
Case 1,3,5,7,8,10,12:
strDays = 31
Case 4,6,9,11:
strDays = 30
Case 2:
If ( (CInt(strYear) Mod 4 = 0 And CInt(strYear) Mod 100 <> 0) Or ( CInt(strYear) Mod 400 = 0) ) Then
strDays = 29
Else
strDays = 28
End If
'Case Else:
End Select
getDaysInMonth = strDays
End Function
'''writeDropDowns is a way I used MonthD
' ropDown, DayDropDown, and YearDropDown t
' ogether
'basically, the point was that I didn't
' want someone to select 30 for the month
' of february
'so it resubmits to the page(that could
' be costly depending on what else is goin
' on) with the selected
'day,month,year and it sets/resets the d
' ays according to the month and year so t
' he user cannot select
'day 30 for month 2
Sub writeDropDowns()
Dim strSelfLink
strSelfLink = "InvoiceList.asp?sort=" & request("sort") & "&page=" & request("page")
Write "<FORM name=dates method=post>" & vbCrLf
Write MonthDropDown("month1",True,request("month1"),strSelfLink) & " " & DayDropDown("day1", "",getDaysInMonth(request("month1"),request("year1")),request("day1")) & " " & YearDropDown("year1","","", request("year1"),strSelfLink) & _
" To " & MonthDropDown("month2",True, request("month2"),strSelfLink) & " " & DayDropDown("day2", "",getDaysInMonth(request("month2"),request("year2")),request("day2")) & " " & YearDropDown("year2","","", request("year2"),strSelfLink) & vbCrLf

Write "<A href='javascript: fnSubmit(" & Chr(34) & strSelfLink& "&datechange=true" & Chr(34) & ",1)'>Submit</A>"
Write "</FORM>" & vbCrLf
End Sub

'write MonthDropDown("Month1",true)
Function MonthDropDown(strName, blnNum, strSelected, strSelfLink) 'if blnNUM is true, Then show as numbers
Dim strTemp, i, strSelectedString
strTemp = "<Select name='" & strName& "' onchange='javascript: fnSubmit(" & Chr(34) & strSelfLink & Chr(34) & ",0)'>" & vbCrLf
strTemp = strTemp & "<OPTION value='" & 0 & "'>" & "Month" & "</OPTION>" & vbCrLf
For i = 1 To 12
If strSelected = CStr(i) Then
strSelectedString = "Selected"
Else
strSelectedString = ""
End If

If blnNum Then
strTemp = strTemp & "<OPTION value='" & i & "' " & strSelectedString & " >" & i & "</OPTION>" & vbCrLf
Else
strTemp = strTemp & "<OPTION value='" & i & "' " & strSelectedString & " >" & MonthName(i) & "</OPTION>" & vbCrLf
End If
Next
strTemp = strTemp & "</Select>" & vbCrLf
MonthDropDown = strTemp
End Function
'write YearDropDown("Year1", 2001, 2010)
Function YearDropDown(strName, intStartYear, intEndYear, strSelected, strSelfLink)

Dim strTemp, i, strSelectedString

If intStartYear = "" Then
intStartYear = Year(Now())
End If

If intEndYear = "" Then
intEndYear = Year(Now()) + 9
End If

strTemp = "<Select name='" & strName& "' onchange='javascript: fnSubmit(" & Chr(34) & strSelfLink & Chr(34) & ",0)'>" & vbCrLf
strTemp = strTemp & "<OPTION value='" & 0 & "'>" & "Year" & "</OPTION>" & vbCrLf
For i = intStartYear To intEndYear
If strSelected = CStr(i) Then
strSelectedString = "Selected"
Else
strSelectedString = ""
End If
strTemp = strTemp & "<OPTION value='" & i & "' " & strSelectedString & " >" & i & "</OPTION>" & vbCrLf
Next
strTemp = strTemp & "</Select>" & vbCrLf
YearDropDown = strTemp
End Function
'write DayDropDown("Day1",1,getDaysInMonth(2,2001) )
Function DayDropDown(strName, intStartDay, intEndDay, strSelected )
Dim strTemp, i, strSelectedString
If intStartDay = "" Then
intStartDay = 1
End If

If intEndDay = "" Then
intEndDay = getDaysInMonth(Month(Now()),Year(Now()))
End If

strTemp = "<Select name='" & strName& "'>" & vbCrLf
strTemp = strTemp & "<OPTION value='" & 0 & "'>" & "Day" & "</OPTION>" & vbCrLf
For i = intStartDay To intEndDay
If strSelected = CStr(i) Then
strSelectedString = "Selected"
Else
strSelectedString = ""
End If
strTemp = strTemp & "<OPTION value='" & i & "' " & strSelectedString & " >" & i & "</OPTION>" & vbCrLf
Next
strTemp = strTemp & "</Select>" & vbCrLf
DayDropDown = strTemp
End Function
Sub beginDoc(strTitle)
Write "<HTML>" & vbCrLf
Write "<HEAD>" & vbCrLf
Write "<TITLE>" & strTitle & "</TITLE>" & vbCrLf
Write "</HEAD>" & vbCrLf
Write "<BODY>" & vbCrLf
End Sub

Sub endDoc()
Write "</BODY>" & vbCrLf
Write "</HTML>" & vbCrLf
End Sub

Const KERMITTHEFROGGREEN = "#beff43"
%>