<% ' Copyright (C) 1998-2005 Cyberstrong Internet Services, Inc. All Rights Reserved ' ' This file has been seeded with unique information at point of sale and ' is traceable to its purchaser. ' ' Your license agreement forbids the removal of this notice. ' clsForm() - Generic form handling class ... Class clsForm Private mFormFields, mStoreName, mFormHasValues, mFormPostFlagged Private mXML, mMenuItemList, mStyle ' Constructor ----------------------------------------------------- Private Sub Class_Initialize() ReDim mMenuItemList(0) PageName = Replace(GetScriptName(), ".asp", "") mStoreName = PageName & "-FormFields" mStyle = "" End Sub ' Destructor ------------------------------------------------------ Private Sub Class_Terminate() End Sub ' Pubilc Properties ----------------------------------------------- Public PageName ' The name of the current script without file extension. Public Property Get ConfigurationName() ' Current configuration name ... ConfigurationName = GetTextBox("FormConfigurationName") End Property Public Property Get FieldNameList() ' Current form field list ... FieldNameList = mFormFields.Keys End Property Public Property Let DefaultStyleClass(argClassName) ' Apply this style class to all input boxes by default. mStyle = " class=""" & argClassName & """" End Property Public Property Let DefaultStyle(argStyleName) ' Apply this style to all imput boxes by default. mStyle = " style=""" & argStyleName & """" End Property ' Public Methods -------------------------------------------------- ' Init() - Initialze form object ... Public Sub Init() Dim FormFieldName If (mIsFormPost()) Then Set mFormFields = CreateObject("Scripting.Dictionary") For Each FormFieldName In Request.Form mFormFields(FormFieldName) = Trim(Request.Form(FormFieldName)) Next Set Session(mStoreName) = mFormFields Else If (IsObject(Session(mStoreName))) Then Set mFormFields = Session(mStoreName) Else Set mFormFields = CreateObject("Scripting.Dictionary") End If End If mFormHasValues = IsObject(Session(mStoreName)) mFormPostFlagged = False ' Add default menu items to list ... Call AddMenuItem("Load", "javascript:Go(""FormLoad"")") Call AddMenuItem("Save", "javascript:Go(""FormSave"")") Call AddMenuItem("Clear", "javascript:Go(""FormClear"")") Call AddMenuItem("Delete", "javascript:Go(""FormDelete"")") ' Process form save/load commands ... Call mProcessMenu() End Sub ' DisplayTextBox() - Display a one-line text box ... Public Function DisplayTextBox(ByVal argName, ByVal argSize, ByVal argMaxLength, ByVal argOptions) ' Note: argOptions reserved for future use ... DisplayTextBox = "" & mFlagFormPost() End Function ' GetTextBox() - Return the contents of the given text box ... Public Function GetTextBox(argName) GetTextBox = mFormField(argName) End Function ' DisplayTextArea() - Display a multi-line text box ... Public Function DisplayTextArea(ByVal argName, ByVal argRows, ByVal argCols, ByVal argOptions) ' Note: argOptions reserved for future use ... DisplayTextArea = "" & mFlagFormPost() End Function ' GetTextArea() - Return the contents of the given text area ... Public Function GetTextArea(argName) GetTextArea = mFormField(argName) End Function ' DisplayCheckBox() - Display a check box ... Public Function DisplayCheckBox(ByVal argName) Dim Checked Checked = IIF(GetCheckBox(argName), " checked", "") DisplayCheckBox = "" & mFlagFormPost() End Function ' GetCheckBox() - Returns True if the given check box is checked ... Public Function GetCheckBox(ByVal argName) GetCheckBox = CBool(mFormFields(argName) = "checked") End Function ' DisplayRadioButton() - Display a radio button. Returns argValue when selected ... Public Function DisplayRadioButton(ByVal argName, ByVal argValue) Dim Checked Checked = IIF(GetRadioButton(argName) = argValue, " checked", "") DisplayRadioButton = "" & mFlagFormPost() End Function ' GetRadioButton() - Returns the value of the given radio button ... Public Function GetRadioButton(ByVal argName) GetRadioButton = mFormFields(argName) End Function ' DisplayComboBox() - Display (emulated) combo box ... Public Sub DisplayComboBox(ByVal argName, ByVal argFillData, ByVal argSize, ByVal argMaxLength, ByVal argCaption) Dim rs, SQL, Selected, i Dim DocumentFieldName, DocumentSelectName, DocumentSelectIndex Dim ValueFieldName DocumentFieldName = "document.frmMain." & argName & ".value" DocumentSelectIndex = "document.frmMain." & argName & "Select.selectedIndex" DocumentSelectName = "document.frmMain." & argName & "Select[" & DocumentSelectIndex & "].value" ' JavaScript to move selected item into text box ... wl("") wl("") ' Set up drop down box ... wl("

") wl("
") ' Display user input text box here... wl("") & mFlagFormPost() wl("

") End Sub ' DisplaySelectBox() - Display HTML SELECT type input box... Public Function DisplaySelectBox(ByVal argName, ByVal argFillData, ByVal argSize, ByVal argMaxLength, ByVal argCaption) Dim ItemDelim, PairDelim, OptionPairs, OptionPair, OptionPairList, TokenList, Selected, s s = "" s = s & "" & mFlagFormPost() & vbCrLF DisplaySelectBox = s End Function ' GetSelectBox() - Get value from HTML SELECT input box... Public Function GetSelectBox(ByVal argName) GetSelectBox = mFormFields(argName) End Function ' SetDefault() - Establish a default value for the given field name ... Public Sub SetDefault(ByVal argName, ByVal argValue) If (Not mFormHasValues) Then mFormFields(argName) = argValue End If End Sub ' DisplayMenu() - Display export menu ... Public Sub DisplayMenu(ByVal argSize, ByVal argCaption) Dim MenuItem, First First = True wl("

") Call DisplayComboBox("FormConfigurationName", "SELECT DISTINCT FormConfigName FROM Forms WHERE FormPageName = '" & PageName & "'", argSize, 255, argCaption) For Each MenuItem In mMenuItemList If (Not First) Then wl(" ") wl("[ " & MenuItem.Name & " ]") First = False Next wl("

") End Sub ' LoadFromXML() - Reload all fields from XML string created by SaveToXML() ... Public Sub LoadFromXML(argXMLString) Dim FormField, FormFieldList Dim ChildNode, ChildNodeList Dim FieldName, FieldValue Dim XMLDoc ' Parse XML string using MSXML ... Set XMLDoc = Server.CreateObject("Msxml2.DOMDocument") XMLDoc.LoadXML(argXMLString) Set FormFieldList = XMLDoc.GetElementsByTagName("Field") For Each FormField in FormFieldList Set ChildNodeList = FormField.ChildNodes For Each ChildNode in ChildNodeList Select Case ChildNode.NodeName Case "Name" FieldName = ChildNode.Text Case "Value" FieldValue = ChildNode.Text End Select Next ' Save to internal form value dictionary ... mFormFields(FieldName) = FieldValue Next Set XMLDoc = Nothing Set FormFieldList = Nothing Set ChildNodeList = Nothing End Sub ' SaveToXML() - Save all fields in an XML string for recovery by LoadFromXML() ... Public Function SaveToXML() Dim FormField mXML = "" mAddToXML "" mAddToXML "" ' For debug only ... ' wl("

" & Server.HTMLEncode(mXML) & "

") SaveToXML = ReplaceRegEx(mXML, vbCrLf & " *", "", "") End Function ' AddMenuItem() - Add and item to form management configuration box ... Public Sub AddMenuItem(ByVal argName, ByVal argLink) Dim p Set p = New clsFormMenuItem p.Name = argName p.Link = argLink Call AddArray(mMenuItemList, p) End Sub ' Clear() - Clear all form fields ... Public Sub Clear() mFormFields.RemoveAll End Sub ' Dump() - Display the internal value of all form fields ... Public Sub Dump() Dim FormField wl("Stored Form Fields:" & "

") For Each FormField In mFormFields wl(FormField & " = <" & mFormFields(FormField) & ">
") Next wl("") End Sub ' Test() - Reserved for future use ... Public Sub Test() End Sub ' Private Functions/Subs ------------------------------------------ ' mProcessMenu() - Process commands in DisplayMenu() Private Sub mProcessMenu() Dim rs, SQL, FormConn Select Case UCase(GetFormAction()) Case "FORMSAVE" If (Not isOnlineDemo(FormErrorMsg)) Then Set FormConn = dbOpen("rw") Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM Forms WHERE " & _ "(FormConfigName = '" & GetTextBox("FormConfigurationName") & "') AND " & _ "(FormPageName = '" & PageName & "') " & _ "ORDER BY FormConfigName" rs.Open SQL, FormConn, adOpenKeyset, adLockOptimistic If (rs.RecordCount = 0) Then rs.AddNew End If rs("FormConfigName") = GetTextBox("FormConfigurationName") rs("FormPageName") = PageName rs("FormDefinition") = SaveToXML() rs("LastUpdated") = Now() rs.Update rs.Close : Set rs = Nothing End If Case "FORMLOAD" Set FormConn = dbOpen("rw") Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT * FROM Forms WHERE " & _ "(FormConfigName = '" & GetTextBox("FormConfigurationName") & "') AND " & _ "(FormPageName = '" & PageName & "') " & _ "ORDER BY FormConfigName" rs.Open SQL, FormConn, adOpenKeyset, adLockOptimistic If (rs.RecordCount <> 0) Then ' Clear all existing form fields then reload ... Call Clear() LoadFromXML(rs("FormDefinition")) End If rs.Close : Set rs = Nothing Case "FORMDELETE" If (Not isOnlineDemo(FormErrorMsg)) Then Set FormConn = dbOpen("rw") SQL = "DELETE FROM Forms WHERE " & _ "(FormConfigName = '" & GetTextBox("FormConfigurationName") & "') AND " & _ "(FormPageName = '" & PageName & "') " FormConn.Execute(SQL) Call Clear() End If Case "FORMCLEAR" mFormFields.RemoveAll End Select Call dbClose(FormConn) End Sub ' mFormField() - Returns the current falue of the named form field ... Private Function mFormField(ByVal argName) mFormField = IIF(mFormFields.Exists(argName), mFormFields(argName), "") End Function ' mFlagFormPost() - Inserts a hidden field for use with mIsFormPost() ... Private Function mFlagFormPost() If (Not mFormPostFlagged) Then mFlagFormPost = "" mFormPostFlagged = True Else mFlagFormPost = "" End If End Function ' mIsFormPost() - Returns True if this page load resulted from a form post ... Private Function mIsFormPost() mIsFormPost = CBool(Request.Form(PageName & "-isFormPost") = "True") End Function ' mAddXML() - Add value to XML string ... Private Sub mAddToXML(ByVal argValue) If (argValue <> "") Then mXML = mXML & argValue & vbCrLF End If End Sub End Class ' clsFormMenuItem() - Structure to hold data values for form menu commands ... Class clsFormMenuItem Public Name ' The visable name of the link Public Link ' The link for this item End Class ' Instantiate a default object from this class ... Dim Form : Set Form = New clsForm %>