Add to Favorites    Make Home Page 28218 Online  
 Language Categories  
 Our Services  

Home » ASP Home » Misc. Home » Handy ASP stuff

A D V E R T I S E M E N T

Search Projects & Source Codes:

Title Handy ASP stuff
Author Devin Garlit
Author Email dgarlit [at] hotmail.com
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.
Category ASP » Misc.
Hits 4687
Code Select and Copy the Code
<% ''''''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" %>

Related Source Codes

Script Name Author
ııııııııııııııııııııı VyomWorld
Resistor color code reader A.Chermarajan.
Telephone Directory dhivya
card swapping game (Mini Project) nityanand
simple hangman-pascalsource Seabert
college dirtectory (Mini Project) msridhar
Poll Application John van Meter
ASP Daily Hit Counter. Tejaskumar Gandhi
To avoid null in asp environment using sql Sami
Maklumbalas webmaster
poll John van Meter
EasyASP Template Engine. TjoekBezoer
Basic Calculator using HTML & Javascript. Patrick M. D Souza
What servers support ASP ? VyomWorld
What is ASP? VyomWorld

A D V E R T I S E M E N T




Google Groups Subscribe to SourceCodesWorld - Techies Talk
Email:

Free eBook - Interview Questions: Get over 1,000 Interview Questions in an eBook for free when you join JobsAssist. Just click on the button below to join JobsAssist and you will immediately receive the Free eBook with thousands of Interview Questions in an ebook when you join.

New! Click here to Add your Code!


ASP Home | C Home | C++ Home | COBOL Home | Java Home | Pascal Home
Source Codes Home Page

 Advertisements  

Google Search

Google

Source Codes World.com is a part of Vyom Network.

Vyom Network : Web Hosting | Dedicated Server | Free SMS, GRE, GMAT, MBA | Online Exams | Freshers Jobs | Software Downloads | Interview Questions | Jobs, Discussions | Placement Papers | Free eBooks | Free eBooks | Free Business Info | Interview Questions | Free Tutorials | Arabic, French, German | IAS Preparation | Jokes, Songs, Fun | Free Classifieds | Free Recipes | Free Downloads | Bangalore Info | Tech Solutions | Project Outsourcing, Web Hosting | GATE Preparation | MBA Preparation | SAP Info | Software Testing | Google Logo Maker | Freshers Jobs

Sitemap | Privacy Policy | Terms and Conditions
Copyright ©2003-2019 SourceCodesWorld.com, All Rights Reserved.
Page URL: http://www.sourcecodesworld.com/source/show.asp?ScriptID=270


Download Yahoo Messenger | Placement Papers | Free SMS | C Interview Questions | C++ Interview Questions | Quick2Host Review