Created
January 18, 2014 19:45
-
-
Save xaprb/8495202 to your computer and use it in GitHub Desktop.
Old ASP scripts from 2004 or so; forgot what they are even for.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<script Language="VBScript" RunAt="server"> | |
Class Logger | |
Private m_Name | |
Private m_Level | |
Private m_LoggerLevel | |
Private m_Destination | |
Private m_BufferOutput | |
Private m_Buffer | |
Public Sub Class_Initialize() | |
Set m_LoggerLevel = Server.CreateObject("Scripting.Dictionary") | |
m_LoggerLevel.Add "DEBUG", 1 | |
m_LoggerLevel.Add "INFO", 2 | |
m_LoggerLevel.Add "WARN", 3 | |
m_LoggerLevel.Add "ERROR", 4 | |
m_LoggerLevel.Add "FATAL", 5 | |
m_Destination = "HTML" | |
m_BufferOutput = False | |
m_Name = "" | |
m_Buffer = "" | |
End Sub | |
Public Sub Class_Terminate() | |
If m_BufferOutput Then | |
OutputMessage m_Buffer | |
End If | |
End Sub | |
Public Property Let Name(Value) | |
m_Name = Value | |
End Property | |
Public Property Let Destination(Value) | |
m_Destination = Value | |
End Property | |
Public Property Let BufferOutput(Value) | |
m_BufferOutput = Value | |
End Property | |
Public Property Let Level(Value) ' As String | |
m_Level = m_LoggerLevel.Item(Value) | |
End Property | |
Public Sub Debug(Message) | |
AppendMessage Message, "DEBUG" | |
End Sub | |
Public Sub Info(Message) | |
AppendMessage Message, "INFO" | |
End Sub | |
Public Sub Warn(Message) | |
AppendMessage Message, "WARN" | |
End Sub | |
Public Sub Error(Message) | |
AppendMessage Message, "ERROR" | |
End Sub | |
Public Sub Fatal(Message) | |
AppendMessage Message, "FATAL" | |
End Sub | |
Private Sub AppendMessage(Message, Level) | |
If m_Level <= m_LoggerLevel.Item(Level) Then | |
If m_BufferOutput Then | |
m_Buffer = m_Buffer & FormatMessage(Message, Level) | |
Else | |
OutputMessage FormatMessage(Message, Level) | |
End If | |
End If | |
End Sub | |
Private Function FormatMessage(Message, Level) | |
Select Case m_Destination | |
Case "HTML" | |
FormatMessage = "<tt>" & m_Name & " [" & Level & "] " & Server.HtmlEncode(Message) & "</tt><br>" & VbCrLf | |
End Select | |
End Function | |
Private Sub OutputMessage(Text) | |
Select Case m_Destination | |
Case "HTML" | |
Response.Write Text | |
End Select | |
End Sub | |
End Class | |
</script> |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<% | |
Class XmlForm | |
Private m_Doc | |
Private m_IsValid | |
Private m_FileName | |
Private m_Log | |
Public Sub Class_Initialize() | |
Set m_Doc = CreateObject("MSXML2.DOMDocument.4.0") | |
Set m_Log = New Logger : m_Log.Level = "ERROR" : m_Log.BufferOutput = True : m_Log.Name = "XmlForm" | |
m_IsValid = True | |
End Sub | |
' Loads the definition from an XML file. | |
Public Function Load(FileName) | |
m_FileName = Server.MapPath(FileName) | |
Load = m_Doc.Load(m_FileName) | |
If Not Load Then | |
Dim Error : Set Error = m_Doc.parseError | |
m_Log.Error "Xml parsing error at line " & Error.Line _ | |
& ", char " & Error.LinePos & ": " & Error.Reason _ | |
& "<br>" & Error.SrcText | |
End If | |
End Function | |
' Loads the definition from a string. | |
Public Function LoadXml(XmlString) | |
LoadXml = m_Doc.LoadXml(XmlString) | |
If Not LoadXml Then | |
Dim Error : Set Error = m_Doc.parseError | |
m_Log.Error "Xml parsing error at line " & Error.Line _ | |
& ", char " & Error.LinePos & ": " & Error.Reason _ | |
& "<br>" & Error.SrcText | |
End If | |
End Function | |
' Returns whether the form is valid or not. | |
Public Property Get IsValid | |
IsValid = m_IsValid | |
End Property | |
' Returns text that you can insert into a web page to display the form. | |
Public Function ToString() | |
Dim NewDoc, Hidden, Node, FormNode, Action | |
' If the form hasn't got an action, set the action to the current page. | |
Set FormNode = m_Doc.selectSingleNode("/form") | |
If FormNode.getAttribute("action") = "" Or IsNull(FormNode.getAttribute("action")) Then | |
Action = Request.ServerVariables("URL") | |
If FormNode.getAttribute("method") = "POST" Then | |
Action = Action & "?" & Request.QueryString | |
End If | |
FormNode.setAttribute "action", Action | |
End If | |
' Clone the document so we can remove elements that should be hidden, | |
' without modifying the original document | |
Set NewDoc = m_Doc.cloneNode(True) | |
Set Hidden = NewDoc.selectNodes("//node()[@hidden='1']") | |
For Each Node In Hidden | |
Node.parentNode.removeChild Node | |
Next | |
ToString = NewDoc.Xml | |
End Function | |
' Populates the form with data submitted by the browser. | |
Public Sub Grab() | |
Dim Config, Form, Method | |
' Get the element that describes the form, and the form itself. | |
Set Config = m_Doc.selectSingleNode("/form/config") | |
Set Form = m_Doc.selectSingleNode("/form") | |
If Form Is Nothing Or Config Is Nothing Then | |
m_IsValid = False | |
Else | |
Method = Form.getAttribute("method") | |
' See if the browser posted any form data. If not, then there is no | |
' point trying to set element values. | |
If GetBrowserData(Method, "formSanityCheck") = "" Then | |
m_IsValid = False | |
Else | |
' For each element described in the config element, get the element or | |
' list of elements in the form, and populate them with the browser's | |
' data. | |
Dim Node | |
For Each Node In m_Doc.DocumentElement.selectNodes("/form/config/element") | |
SetValue Node.getAttribute("name"), GetBrowserData(Method, Node.getAttribute("name")) | |
Next | |
End If | |
End If | |
End Sub | |
' Gets a value from the form, by name | |
Public Function GetValue(Name) | |
Dim Config, Node, Val, Options, Child, Result(), i | |
Set Config = m_Doc.selectSingleNode("/form/config/element[@name='" & Name & "']") | |
If Config Is Nothing Then | |
m_Log.Error "The form element '" & Name & "' is not defined in the config." | |
Exit Function | |
End If | |
' Get the element's value | |
If Config.getAttribute("type") = "array" Then | |
If Config.getAttribute("tag-name") = "input" Then ' It's a CheckBox | |
Set Options = m_Doc.selectNodes("//input[@type='checkbox' and @checked='1' and @name='" & Name & "']") | |
ReDim Result(Options.Length - 1) | |
For i = 0 To Options.Length - 1 | |
Result(i) = Options(i).Attributes.getNamedItem("value").Text | |
Next | |
GetValue = Result | |
ElseIf Config.getAttribute("tag-name") = "select" Then | |
Set Node = m_Doc.selectSingleNode("//select[@id='" & Config.getAttribute("element-id") & "']") | |
Set Options = Node.selectNodes("option[@selected='1']") | |
ReDim Result(Options.Length - 1) | |
For i = 0 To Options.Length - 1 | |
Result(i) = Options(i).Attributes.getNamedItem("value").Text | |
Next | |
GetValue = Result | |
End If | |
ElseIf Config.getAttribute("element-id") <> "" Then | |
' It's a scalar that's not a radio button or checkbox array | |
Set Node = m_Doc.selectSingleNode("//node()[@id='" & Config.getAttribute("element-id") & "']") | |
If Not Node Is Nothing Then | |
If Node.nodeName = "select" Then | |
' Find the correct child node of the element and get its value | |
For Each Child In Node.selectNodes("option") | |
If Child.getAttribute("selected") <> "" Then | |
GetValue = Child.getAttribute("value") | |
End If | |
Next | |
ElseIf Node.nodeName = "input" Then | |
' It's a TextBox, Password, Hidden, Button, Submit, or Reset | |
Select Case Node.getAttribute("type") | |
Case "checkbox" | |
If Not IsNull(Node.getAttribute("checked")) And Not IsNull(Node.getAttribute("value")) Then | |
If Node.getAttribute("checked") = "1" Then | |
GetValue = Node.getAttribute("value") | |
Else | |
GetValue = "" | |
End If | |
End If | |
Case Else | |
If Not IsNull(Node.getAttribute("value")) Then | |
GetValue = Node.getAttribute("value") | |
Else | |
GetValue = "" | |
End If | |
End Select | |
Else ' Textarea | |
GetValue = Node.Text | |
End If | |
End If | |
Else | |
' It's a scalar that's a radio button, or *scalar* checkbox array | |
Set Options = m_Doc.selectNodes("//input[@name='" & Name & "' and @checked='1']") | |
If Options.Length > 0 Then | |
GetValue = Options(0).Attributes.getNamedItem("value").Text | |
End If | |
End If | |
If IsArray(GetValue) Then | |
m_Log.Debug "Got value for " & Name & ". Result: ('" & Join(GetValue, "', '") & "')" | |
Else | |
m_Log.Debug "Got value for " & Name & ". Result: " & GetValue | |
End If | |
End Function | |
' Sets the value of a form element | |
Public Sub SetValue(Name, Value) | |
Dim Config, Node, Checkboxes, Child, OneVal, Radios, Options | |
' If the value isn't a string, stringify it | |
If Not IsArray(Value) Then | |
Value = CStr(Value) | |
End If | |
' If the element isn't defined in the config, quit | |
Set Config = m_Doc.selectSingleNode("/form/config/element[@name='" & Name & "']") | |
If Not Config Is Nothing Then | |
' There are two types of form elements: arrays and scalars. | |
If Config.getAttribute("type") = "array" Then | |
' An array means that there could be multiple values submitted | |
' for this element. Form elements that are arrays by nature | |
' are | |
' * CheckBox | |
' * SelectMultiple | |
' First array-ize the value | |
If Not IsArray(Value) Then | |
Value = Array(Value) | |
End If | |
' Find out what kind of form element it is | |
If Config.getAttribute("tag-name") = "input" Then | |
' It's a CheckBox array. Uncheck everything there's no data for, and | |
' check everything there is | |
Set Checkboxes = m_Doc.selectNodes("//input[@name='" & Name & "' and @type='checkbox']") | |
For Each Child In Checkboxes | |
If InArray(Value, Child.getAttribute("value")) Then | |
Child.SetAttribute ("checked"), 1 | |
Else | |
Child.RemoveAttribute ("checked") | |
End If | |
Next | |
Else | |
' It's a <select multiple> element. For this | |
' element, we need to get all child elements of type | |
' <option> and set the "selected" option on those that there's | |
' data for. | |
XPath = "//select[@id='" & Config.getAttribute("element-id") & "']" | |
Set Node = m_Doc.selectSingleNode(XPath) | |
If Not Node Is Nothing Then | |
' Unselect them all first | |
For Each Child In Node.selectNodes("option") | |
Child.RemoveAttribute ("selected") | |
Next | |
' Then set the ones we want to be set. | |
For Each OneVal In Value | |
Set Child = Node.selectSingleNode("option[@value='" & OneVal & "']") | |
If Not Child Is Nothing Then | |
Child.SetAttribute "selected", 1 | |
m_Log.Debug "Set child option with value " & OneVal | |
Else | |
m_Log.Debug "Couldn't find child option with value " & OneVal | |
End If | |
Next | |
Else | |
m_Log.Error "Could not find node with XPath " & XPath | |
End If | |
End If | |
Else ' Element is not an array, it's a scalar | |
' A scalar means that the browser submits a single value for | |
' the element. Form elements that are scalar by nature are | |
' * Radio | |
' * TextBox | |
' * Password | |
' * Hidden | |
' * Button | |
' * Submit | |
' * Reset | |
' * SelectOne | |
' * TextArea | |
' * A CheckBox can also be defined as scalar. | |
' If there's a tag-name attribute, the element needs to be | |
' identified by tag name (there might be multiples, as in a radio | |
' array). Otherwise, it needs to be identified by element-id. | |
If Config.getAttribute("tag-name") <> "" Then | |
' Assume it's a radio button array. | |
If Config.getAttribute("tag-name") = "input" Then | |
' Unselect everything there's no data for, select everything there is. | |
Set Radios = m_Doc.selectNodes("//input[@name='" & Name & "' and @type='radio']") | |
For Each Node In Radios | |
If Node.getAttribute("value") = Value Then | |
Node.SetAttribute "checked", "1" | |
Else | |
Node.RemoveAttribute ("checked") | |
End If | |
Next | |
End If | |
Else | |
' Need to identify the element by the element-id | |
Set Node = m_Doc.selectSingleNode("//node()[@id='" & Config.getAttribute("element-id") & "']") | |
If Not Node Is Nothing Then | |
' There are several kinds of elements in the scalar category: | |
' those whose value is contained in the "value" attribute, | |
' those whose value is in a Text node, and those who are one of | |
' several elements that must have their "selected" or "checked" | |
' attribute set to true to indicate which of them is actually | |
' the active element. | |
If Node.nodeName = "input" Then | |
Select Case Node.getAttribute("type") | |
Case "text", "password", "hidden", "button", "submit", "reset" | |
Node.SetAttribute "value", Value | |
Case "checkbox" | |
' This is a checkbox that's NOT an array | |
If Value <> "" Then | |
Node.SetAttribute "checked", "1" | |
Else | |
Node.RemoveAttribute "checked" | |
End If | |
Case Else | |
m_Log.Error "Node " & Name & " is an 'input' element but its 'type' " _ | |
& "attribute is '" & Node.getAttribute("type") & "'" | |
End Select | |
ElseIf Node.nodeName = "select" Then | |
' It's a <select> that's not multiple | |
' Find the correct child node of the element with a value | |
' of whatever value it is, and set its "selected" attribute | |
' to "1". All others get their "selected" attribute removed. | |
Set Options = Node.GetElementsByTagName("option") | |
For Each Child In Options | |
If Child.getAttribute("value") = Value Then | |
Child.SetAttribute "selected", "1" | |
Else | |
Child.RemoveAttribute "selected" | |
End If | |
Next | |
ElseIf Node.nodeName = "textarea" Then | |
Node.Text = Value | |
Else | |
m_Log.Error "Node " & Name & " has nodeName of '" & Node.nodeName & "'" | |
End If | |
End If | |
End If ' Not Node Is Nothing | |
End If ' Element is a scalar | |
End If | |
End Sub | |
' Returns true if a value exists in an array | |
Private Function InArray(Coll, Value) | |
InArray = False | |
Dim Item | |
For Each Item In Coll | |
If CStr(Item) = Value Then | |
InArray = True | |
Exit Function | |
End If | |
Next | |
End Function | |
' Gets the data that the browser sent | |
Private Function GetBrowserData(Method, Name) | |
Dim Result(), i | |
If LCase(Method) = "get" Then | |
If Request.QueryString(Name).Count > 1 Then | |
ReDim Result(Request.QueryString(Name).Count) | |
For i = 1 To Request.QueryString(Name).Count | |
Result(i) = Request.QueryString(Name)(i) | |
Next | |
GetBrowserData = Result | |
Else | |
GetBrowserData = Request.QueryString(Name) | |
End If | |
Else | |
If Request.Form(Name).Count > 1 Then | |
ReDim Result(Request.Form(Name).Count) | |
For i = 1 To Request.Form(Name).Count | |
Result(i) = Request.Form(Name)(i) | |
Next | |
GetBrowserData = Result | |
Else | |
GetBrowserData = Request.Form(Name) | |
End If | |
End If | |
End Function | |
' Validates a required element | |
Private Function ValidateRequired(ConfigNode) | |
Dim Node, Child, Options, XPath | |
ValidateRequired = False | |
m_Log.Debug "Validating for " & ConfigNode.getAttribute("name") | |
' First, discover whether it's an array or a scalar. If a value is | |
' required, a scalar must have a value; an array must have a value for | |
' at least one of its elements. | |
If ConfigNode.getAttribute("type") = "array" Then | |
m_Log.Debug ConfigNode.getAttribute("name") & " is an array" | |
If ConfigNode.getAttribute("element-id") <> "" Then | |
' It's a SelectMultiple. Requires that the element be identified by ID. | |
XPath = "//select[@id='" & ConfigNode.getAttribute("element-id") & "']" | |
Set Node = m_Doc.selectSingleNode(XPath) | |
If Not Node Is Nothing Then | |
If Node.selectNodes("option[@selected and @value != '']").length > 0 Then | |
ValidateRequired = True | |
End If | |
Else | |
m_Log.Error "Could not find node with XPath " & XPath | |
End If | |
Exit Function | |
Else | |
' It's a CheckBox array. Get an array of elements and check | |
' that at least one has the "checked" attribute. Find elements | |
' by getting all elements <input type="checkbox" name="{name}"> | |
' where {name} comes from the "name" attr of the <config> | |
' element. | |
For Each Node In m_Doc.selectNodes("//input[@name='" & ConfigNode.getAttribute("name") & "' and @type='checkbox']") | |
If Node.getAttribute("checked") <> "" Then | |
ValidateRequired = True | |
Exit Function | |
End If | |
Next | |
Exit Function | |
End If | |
Else ' type = "array" | |
m_Log.Debug ConfigNode.getAttribute("name") & " is a scalar" | |
' The type is scalar (this is the default). There are 3 kinds of | |
' scalar elements: <input>, <textarea> and <select> | |
If Not IsNull(ConfigNode.getAttribute("element-id")) And ConfigNode.getAttribute("element-id") <> "" Then | |
XPath = "//node()[@id='" & ConfigNode.getAttribute("element-id") & "']" | |
m_Log.Debug "XPath is " & XPath | |
Set Node = m_Doc.selectSingleNode(XPath) | |
If Not Node Is Nothing Then | |
If Node.nodeName = "input" Then | |
' There are two kinds of <input> elements: checkbox and | |
' everything else. There may be multiple HTML elements | |
' that we need to go through for a radio, but checkbox and | |
' others are going to be single and are identified by ID. | |
' Radio buttons are special: they are in an array of | |
' elements not identified by element-id (see below) | |
If Node.getAttribute("type") = "checkbox" Then | |
If Node.getAttribute("checked") = "1" Then | |
ValidateRequired = True | |
Exit Function | |
End If | |
Exit Function | |
Else ' text, password, hidden, button, submit, reset | |
' Only validate text, password; the user has no control | |
' over the others. | |
m_Log.Debug "Validating for " & Node.getAttribute("name") | |
If Node.getAttribute("type") = "text" Or Node.getAttribute("type") = "password" Then | |
If Trim(Node.getAttribute("value")) <> "" Then | |
ValidateRequired = True | |
Exit Function | |
End If | |
Exit Function | |
End If | |
End If | |
ElseIf Node.nodeName = "select" Then | |
' At least one of the element's childNodes needs to be | |
' selected. Elements with an empty value count as not | |
' selected. | |
If Node.selectNodes("option[@selected = '1' and @value != '']").Length > 0 Then | |
ValidateRequired = True | |
End If | |
Exit Function | |
Else ' <textarea> | |
If Trim(Node.firstChild.Data) <> "" Then | |
ValidateRequired = True | |
End If | |
Exit Function | |
End If | |
Else | |
m_Log.Error "Cannot find the element for " & ConfigNode.getAttribute("name") | |
End If | |
Else | |
' It's an <input type="radio"> and we look up its elements by | |
' name and type, not by ID | |
m_Log.Debug ConfigNode.getAttribute("name") & " is a radio collection" | |
If m_Doc.selectNodes("//input[@name='" & ConfigNode.getAttribute("name") & "' and @type='radio' and @checked='1']").Length > 0 Then | |
ValidateRequired = True | |
End If | |
Exit Function | |
End If | |
End If | |
End Function | |
' Validates an element by examining if its contents match its data type | |
Private Function ValidateDataType(ConfigNode) | |
Dim Node, Val | |
Dim Regex | |
Val = "" | |
Set Regex = New RegExp | |
ValidateDataType = False | |
Set Node = m_Doc.selectSingleNode("//node()[@id='" & ConfigNode.getAttribute("element-id") & "']") | |
If Node Is Nothing Then | |
Exit Function | |
End If | |
If Node.nodeName = "input" Then | |
Val = Node.getAttribute("value") | |
ElseIf Node.nodeName = "textarea" Then | |
Val = Node.firstChild.Data | |
End If | |
If Val = "" Then | |
ValidateDataType = True | |
Exit Function | |
End If | |
Select Case ConfigNode.getAttribute("data-type") | |
Case "number" | |
ValidateDataType = IsNumeric(Val) | |
Case "regexp" | |
If Not IsNull(ConfigNode.getAttribute("expression")) And ConfigNode.getAttribute("expression") <> "" Then | |
Regex.Pattern = ConfigNode.getAttribute("expression") | |
ValidateDataType = Regex.Test(Val) | |
Else | |
m_Log.Error "You did not specify an 'expression' attribute for " & ConfigNode.Xml | |
End If | |
Case "date", "datetime", "timestamp" | |
ValidateDataType = IsDate(Val) | |
Case "email" | |
Regex.Pattern = "^[\w-]+(?:\.[\w-]+)*@(?:[\w-]+\.)+[a-zA-Z]{2,7}$" | |
ValidateDataType = Regex.Test(Val) | |
Case "integer" | |
Regex.Pattern = "^\d+$" | |
ValidateDataType = Regex.Test(Val) | |
Case "words" | |
Regex.Pattern = "^[\w\d\t ]+$" | |
ValidateDataType = Regex.Test(Val) | |
End Select | |
End Function | |
' Validates an element by comparing it as defined. | |
Private Function ValidateComparison(ConfigNode) | |
ValidateComparison = False | |
Dim ThisNode, OtherNode, ThisValue, OtherValue | |
' As usual, advanced validation can only be done on textbox, password, | |
' and textarea | |
Set ThisNode = m_Doc.selectSingleNode("//node()[@id='" & ConfigNode.getAttribute("element-id") & "']") | |
Set OtherNode = m_Doc.selectSingleNode("//node()[@id='" & ConfigNode.getAttribute("compare-to-id") & "']") | |
If ThisNode Is Nothing Or OtherNode Is Nothing Then | |
ValidateComparison = False | |
Exit Function | |
End If | |
' Fetch the data from both elements | |
ThisValue = "" | |
OtherValue = "" | |
If ThisNode.nodeName = "input" Then | |
ThisValue = ThisNode.getAttribute("value") | |
Else ' textarea | |
ThisValue = ThisNode.firstChild.Text | |
End If | |
If OtherNode.nodeName = "input" Then | |
OtherValue = OtherNode.getAttribute("value") | |
Else ' textarea | |
OtherValue = OtherNode.firstChild.Text | |
End If | |
' There might be different types of data, such as numbers, strings, and | |
' dates, that have to be compared. These need to be converted into | |
' something that can compare. | |
Select Case ConfigNode.getAttribute("data-type") | |
Case "date", "datetime", "timestamp" | |
ThisValue = CDate(ThisValue) | |
OtherValue = CDate(OtherValue) | |
End Select | |
' Do the comparison | |
Select Case ConfigNode.getAttribute("compare-type") | |
Case "less" | |
ValidateComparison = ThisValue < OtherValue | |
Case "equal" | |
ValidateComparison = ThisValue = OtherValue | |
Case "greater" | |
ValidateComparison = ThisValue > OtherValue | |
Case "lessequal" | |
ValidateComparison = ThisValue <= OtherValue | |
Case "greaterequal" | |
ValidateComparison = ThisValue >= OtherValue | |
End Select | |
End Function | |
' Validates the form against its definition in the <config> element | |
Public Sub Validate() | |
Dim Config, FormNode, Node, Continue | |
' Get the configuration information for the form | |
Set Config = m_Doc.selectSingleNode("/form/config") | |
Set FormNode = m_Doc.selectSingleNode("/form") | |
' The form is not valid unless it has been submitted. | |
If GetBrowserData(FormNode.getAttribute("method"), "formSanityCheck") = "" Then | |
m_IsValid = False | |
Exit Sub | |
End If | |
' Check each element referenced by the config element | |
For Each Node In Config.selectNodes("element") | |
Continue = True | |
If Node.getAttribute("required") <> "" Then | |
If Not ValidateRequired(Node) Then | |
m_IsValid = False | |
Node.SetAttribute "failed-required", "1" | |
Continue = False | |
End If | |
End If | |
If Continue Then | |
If Node.getAttribute("required-unless") <> "" Then | |
If GetBrowserData(FormNode.getAttribute("method"), Node.getAttribute("required-unless")) = "" Then | |
If Not ValidateRequired(Node) Then | |
m_IsValid = False | |
Node.SetAttribute "failed-required", "1" | |
Continue = False | |
End If | |
End If | |
End If | |
End If | |
If Continue Then | |
If Node.getAttribute("required-if") <> "" Then | |
If GetBrowserData(FormNode.getAttribute("method"), Node.getAttribute("required-if")) <> "" Then | |
If Not ValidateRequired(Node) Then | |
m_IsValid = False | |
Node.SetAttribute "failed-required", "1" | |
Continue = False | |
End If | |
End If | |
End If | |
End If | |
If Continue Then | |
If Node.getAttribute("data-type") <> "" Then | |
If Not ValidateDataType(Node) Then | |
m_IsValid = False | |
Node.SetAttribute "failed-data-type", "1" | |
Continue = False | |
End If | |
End If | |
End If | |
If Continue Then | |
If Node.getAttribute("compare-to-id") <> "" Then | |
If Not ValidateComparison(Node) Then | |
m_IsValid = False | |
Node.SetAttribute "failed-comparison", "1" | |
End If | |
End If | |
End If | |
Next | |
If Not m_IsValid Then | |
EnableErrorMessages | |
End If | |
End Sub | |
' Unhides error elements | |
Private Sub EnableErrorMessages() | |
Dim Config, Node | |
Dim Default, ErrorElement, Failed, Overall | |
For Each Node In m_Doc.selectNodes("/form/config/element") | |
ErrorElement = "" | |
If Node.getAttribute("error-element") <> "" Then | |
Default = Node.getAttribute("error-element") | |
Else | |
Default = False | |
End If | |
' Then check if the element failed any validation checks; if so, | |
' get the name of the element to unhide | |
Failed = False | |
If Node.getAttribute("failed-required") <> "" Then | |
ErrorElement = Node.getAttribute("name") & "-error" | |
Failed = True | |
ElseIf Node.getAttribute("failed-data-type") <> "" Then | |
ErrorElement = Node.getAttribute("name") & "-data-error" | |
Failed = True | |
ElseIf Node.getAttribute("failed-comparison") <> "" Then | |
ErrorElement = Node.getAttribute("name") & "-comparison-error" | |
Failed = True | |
End If | |
If Failed Then | |
Dim ErrorNode | |
' Try to find the error element to unhide | |
If ErrorElement <> "" Then | |
Set ErrorNode = m_Doc.selectSingleNode("//node()[@id='" & ErrorElement & "']") | |
End If | |
If ErrorNode Is Nothing Then | |
' Try to find the explicitly specified default error element | |
If Default <> "" Then | |
Set ErrorNode = m_Doc.selectSingleNode("//node()[@id='" & Default & "']") | |
End If | |
End If | |
If ErrorNode Is Nothing Then | |
' Try to find an element that's named with the magical name | |
Set ErrorNode = m_Doc.selectSingleNode("//node()[@id='" & Node.getAttribute("name") & "-error']") | |
End If | |
If Not ErrorNode Is Nothing Then | |
ErrorNode.Attributes.removeNamedItem "hidden" | |
End If | |
End If | |
Next | |
' Look for an error element for the *whole form* and unhide that if it | |
' exists. | |
Set Config = m_Doc.selectSingleNode("/form/config") | |
If Not Config.Attributes.getNamedItem("error-element") Is Nothing Then | |
Set Overall = m_Doc.selectSingleNode("//node()[@id='" & Config.Attributes.getNamedItem("error-element").Text & "']") | |
If Not Overall Is Nothing Then | |
Overall.Attributes.removeNamedItem "hidden" | |
End If | |
End If | |
End Sub | |
' Adds children from a query result to a <select> menu. You must name the element, and | |
' specify which column in the recordset should go into the value and which the text of | |
' the resulting <option> elements. | |
Public Sub PopulateSelectMenu(Name, RecordSet, ValueCol, TextCol) | |
Dim ConfiNode, SelectNode, OptionNode, TextNode, XPath | |
Set ConfigNode = m_Doc.selectSingleNode("/form/config/element[@name='" & Name & "']") | |
If Not ConfigNode Is Nothing Then | |
' Find the <select> element | |
XPath = "//select[@id='" & ConfigNode.getAttribute("element-id") & "']" | |
m_Log.Debug XPath | |
Set SelectNode = m_Doc.selectSingleNode(XPath) | |
If Not SelectNode Is Nothing Then | |
Do While Not RecordSet.EOF | |
Set OptionNode = m_Doc.createElement("option") | |
Set TextNode = m_Doc.createTextNode(RecordSet(TextCol)) | |
OptionNode.setAttribute "value", RecordSet(ValueCol) | |
OptionNode.appendChild TextNode | |
SelectNode.appendChild OptionNode | |
RecordSet.MoveNext | |
Loop | |
End If | |
Else | |
m_Log.Error Name & " is not defined in the form's <config> section." | |
End If | |
End Sub | |
End Class | |
%> |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment