<%@ LANGUAGE="VBSCRIPT" %>
<%
'********************************************************************
' Name: Template.asp
'
' Purpose: Use this to briefly describe the purpose of the page.
'********************************************************************
Option Explicit
Response.Expires = 0
'********************************************************************
' Include Files
'********************************************************************
%>
<!--#includes virtual="ASPTips/adovbs.asp"-->
<%
'********************************************************************
' Global Variables
'********************************************************************
Const PAGE_NAME = "Template Page"
'********************************************************************
' Main
'********************************************************************
Main
'--------------------------------------------------------------------
' Function: Main
'
' Purpose: Entry point for the page.
'--------------------------------------------------------------------
Sub Main
%>
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
<head>
<meta http-equiv="Last Modified" content="27-mar-97 10:00:00 GMT">
<meta http-equiv="Content-Type"
content="text/html; charset=iso-8859-1">
<meta name="GENERATOR" content="Microsoft FrontPage 2.0">
<title><%= PAGE_NAME %></title>
</head>
<body bgcolor="#FFFF80">
<%
'Standard text for page
%>
<form method="POST" action="ErrorTest2.asp">
<div align="center"><center><table border="0" width="90%"
rules="none">
<tr>
<td><h1><%= PAGE_NAME %></h1></td>
</tr>
<tr>
<td>Data goes here</td>
</tr>
</table>
</center></div>
</form>
</body>
</html>
<%
End Sub
'********************************************************************
' Client-Side Functions
'********************************************************************
%>
<script language="VBSCRIPT">
Option Explicit
Sub Window_Onload()
End Sub
</script>
<%
'********************************************************************
' Server-Side Functions
'********************************************************************
%>
Figure 2 ClientValidationInc.asp
<%
'********************************************************************
' Name: ClientValidationInc.asp
'
' Purpose: Contains constants and functions to handle validation on
' the client side. To use any function, call the corresponding
' insert function from your server code. For instance, call
' InsertHandleClientErrorFunction to insert HandleClientError in
' your client code. This allows you to only include functions that
' you use in code that is returned to the client. Please note that
' the documentation for each function describes the client function
' that is embedded in the server function.
'********************************************************************
'********************************************************************
' Global Variables and Settings
'********************************************************************
Const APPLICATION_NAME = "Application"
'********************************************************************
' ASP Functions
'********************************************************************
'--------------------------------------------------------------------
' Function: HandleClientError
'
' Purpose: Displays a message with the application name sets the
' focus to the invalid field.
'
' strMsg: The error message to display.
'
' objField: The field that should get the focus.
'--------------------------------------------------------------------
'Displays error message (strMsg) and sets focus on field (objField)
Dim blnHandleClientErrorFunctionInserted
blnHandleClientErrorFunctionInserted = False
Sub InsertHandleClientErrorFunction
If Not blnHandleClientErrorFunctionInserted Then
%>
Sub HandleClientError(strMsg, objField)
MsgBox strMsg, vbOKOnly Or vbExclamation, _
APPLICATION_NAME
objField.Focus
End Sub
<%
blnHandleClientErrorFunctionInserted = True
End If
End Sub
%>
<%
'--------------------------------------------------------------------
' Function: IsDigit
'
' Purpose: Determines if a character is a digit.
'
' strDigit: Character to evaluate. This must be a string of 1
' character.
'
' Returns: True if a single digit.
'--------------------------------------------------------------------
Dim blnIsDigitFunctionInserted
blnIsDigitFunctionInserted = False
Sub InsertIsDigitFunction
If Not blnIsDigitFunctionInserted Then
%>
Function IsDigit(strDigit)
IsDigit = False
If Len(strDigit) = 1 Then
If strDigit >= "0" And strDigit <= "9" Then
IsDigit = True
End If
End If
End Function
<%
blnIsDigitFunctionInserted = True
End If
End Sub
%>
<%
'--------------------------------------------------------------------
' Function: IsAlpha
'
' Purpose: Determines if a character is an alphabetic character.
'
' strAlpha: Character to evaluate. This must be a string of 1
' character.
'
' Returns: True if a single alphabetic character.
'--------------------------------------------------------------------
Dim blnIsAlphaFunctionInserted
blnIsAlphaFunctionInserted = False
Sub InsertIsAlphaFunction
If Not blnIsAlphaFunctionInserted Then
%>
Function IsAlpha(strAlpha)
IsAlpha = False
If Len(strAlpha) = 1 Then
If (strAlpha >= "a" And strAlpha <= "z") _
Or (strAlpha >= "A" And strAlpha <= "Z") Then
IsAlpha = True
End If
End If
End Function
<%
blnIsAlphaFunctionInserted = True
End If
End Sub
%>
<%
'--------------------------------------------------------------------
' Function: IsAlphaNumeric
'
' Purpose: Determines if an entire string is alpha-numeric.
'
' strAlphaNum: The string to evaluate.
'
' Returns: True if all the characters in the string are
' alpha-numeric.
'--------------------------------------------------------------------
Dim blnIsAlphaNumericFunctionInserted
blnIsAlphaNumericFunctionInserted = False
Sub InsertIsAlphaNumericFunction
If Not blnIsAlphaNumericFunctionInserted Then
InsertIsAlphaFunction
InsertIsDigitFunction
%>
Function IsAlphaNumeric(strAlphaNum)
Dim blnOnlyAlphaNumFound
blnOnlyAlphaNumFound = True
Dim intCnt
intCnt = 1
While intCnt <= Len(strAlphaNum) _
And blnOnlyAlphaNumFound
Dim strAlphaNumChar
strAlphaNumChar = Mid(strAlphaNum, intCnt, 1)
If Not (IsDigit(strAlphaNumChar) _
Or IsAlpha(strAlphaNumChar)) Then
blnOnlyAlphaNumFound = False
End If
intCnt = intCnt + 1
Wend
IsAlphaNumeric = blnOnlyAlphaNumFound
End Function
<%
blnIsAlphaNumericFunctionInserted = True
End If
End Sub
%>
<%
'--------------------------------------------------------------------
' Function: IsValidTime
'
' Purpose: Determines a string is a valid time.
'
' strAlphaNum: The string to evaluate.
'
' Returns: True if string is a valid time.
'--------------------------------------------------------------------
Dim blnIsIsValidTimeFunctionInserted
blnIsIsValidTimeFunctionInserted = False
Sub InsertIsValidTimeFunction
If Not blnIsIsValidTimeFunctionInserted Then
%>
Function IsValidTime(strTime)
IsValidTime = False
Dim dtTime
On Error Resume Next
dtTime = TimeValue(strTime)
If Err.Number = 0 Then
If Not IsNull(dtTime) Then
IsValidTime = True
End If
End If
End Function
<%
blnIsIsValidTimeFunctionInserted = True
End If
End Sub
%>
Figure 3 Form Fields Demo
Figure 4 FormField1.asp
<%@ LANGUAGE="VBSCRIPT" %>
<%
'********************************************************************
' Name: FormField1.asp
'
' Purpose: Demonstrates the use of Form Field arrays and data
' conversion. This page allows the user to input his/her selections.
'********************************************************************
Option Explicit
Response.Expires = 0
'********************************************************************
' Global Variables
'********************************************************************
Const PAGE_NAME = "Form Fields Demo"
'********************************************************************
' Main
'********************************************************************
Main
'--------------------------------------------------------------------
' Function: Main
'
' Purpose: Entry point for the page.
'--------------------------------------------------------------------
Sub Main
%>
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
<head>
<meta http-equiv="Last Modified" content="27-mar-97 10:00:00 GMT">
<meta http-equiv="Content-Type"
content="text/html; charset=iso-8859-1">
<meta name="GENERATOR" content="Microsoft FrontPage 2.0">
<title><%= PAGE_NAME %></title>
</head>
<%
'Standard text for page
%>
<body bgcolor="#FFFF80">
<div align="center"><center>
<table border="0" width="90%" rules="none">
<tr>
<td><h1><%= PAGE_NAME %></h1></td>
</tr>
</table>
<form method="POST" action="FormField2.asp">
<table border="2" width="90%">
<tr>
<th align="center"
bgcolor="#C0C0C0">Natural Field Array</th>
</tr>
<%
Const TOTAL_ROWS = 3
Dim intRow
For intRow = 1 To TOTAL_ROWS
%>
<tr>
<td align="center">
<input type="text" size="3" name="txtData"
value="N<%= intRow%>"></td>
</tr>
<% Next %>
</table>
<p></p>
<table border="2" width="90%">
<tr>
<th align="center"
bgcolor="#C0C0C0">Artificial Field Array</th>
</tr>
<% For intRow = 1 To TOTAL_ROWS %>
<tr>
<td align="center">
<input type="text" size="3"
name="txtData<%= intRow%>"
value="A<%= intRow%>"></td>
</tr>
<% Next %>
<input type="hidden" name="hdnTotalRows"
value="<%= TOTAL_ROWS %>">
</table>
<p></p>
<table border="0" width="90%"
rules="none">
<tr>
<td>
<input type="text" size="3" name="txtOperand1"
value="2">
+
<input type="text" size="3" name="txtOperand2"
value="2">
= ?
</td>
</tr>
<tr>
<td><p><input type="checkbox" name="chkUseConversion"
value="1">Use Conversion</p></td>
</tr>
<tr>
<td><p><input type="submit" name="cmdSubmit"
value="Run Demo"></p></td>
</tr>
</table>
</center></div>
</form>
</body>
</html>
<%
End Sub
%>
Figure 5 FormField2.asp
<%@ LANGUAGE="VBSCRIPT" %>
<%
'********************************************************************
' Name: FormField2.asp
'
' Purpose: Demonstrates the use of Form Field arrays and data
' conversion. This page processes the user input.
'********************************************************************
Option Explicit
Response.Expires = 0
'********************************************************************
' Global Variables
'********************************************************************
Const PAGE_NAME = "Form Fields Demo"
'********************************************************************
' Main
'********************************************************************
Main
'--------------------------------------------------------------------
' Function: Main
'
' Purpose: Entry point for the page.
'--------------------------------------------------------------------
Sub Main
%>
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html>
<head>
<meta http-equiv="Last Modified" content="27-mar-97 10:00:00 GMT">
<meta http-equiv="Content-Type"
content="text/html; charset=iso-8859-1">
<meta name="GENERATOR" content="Microsoft FrontPage 2.0">
<title><%= PAGE_NAME %></title>
</head>
<%
'Standard text for page
%>
<body bgcolor="#FFFF80">
<div align="center"><center><table border="0" width="90%"
rules="none">
<tr>
<td><h1><%= PAGE_NAME %></h1>
</td>
</tr>
</table>
<form method="POST" action="FormField2.asp">
<table border="2" width="90%">
<tr>
<th align="center"
bgcolor="#C0C0C0">Natural Field Array</th>
</tr>
<%
Dim strData
'Process "Natural" field array
For Each strData In Request.Form("txtData")
%>
<tr>
<td align="center"><%= strData%></td>
</tr>
<% Next %>
</table>
<p></p>
<table border="2" width="90%">
<tr>
<th align="center"
bgcolor="#C0C0C0">Artificial Field Array</th>
</tr>
<% 'Process "Artificial" field array
Dim intTotalRows
intTotalRows = CInt(Request.Form("hdnTotalRows"))
Dim intRow
For intRow = 1 To intTotalRows
strData = Request.Form("txtData" & intRow)
%>
<tr>
<td align="center"><%= strData%>
</td>
</tr>
<% Next %>
</table>
<p></p>
<table border="0" width="90%" rules="none">
<tr>
<%
'Add the operands. This shows what can happen when you don't
'properly convert fields.
Dim blnUseConversion
blnUseConversion = CBool(Request.Form("chkUseConversion"))
Dim strUseConversion
If blnUseConversion Then
strUseConversion = "True"
Else
strUseConversion = "False"
End If
Dim intOperand1
Dim intOperand2
If blnUseConversion Then
intOperand1 = CInt(Request.Form("txtOperand1"))
intOperand2 = CInt(Request.Form("txtOperand2"))
Else
intOperand1 = Request.Form("txtOperand1")
intOperand2 = Request.Form("txtOperand2")
End If
Dim intSum
intSum = intOperand1 + intOperand2
%>
<td><%= intOperand1 %> + <%= intOperand2%> = <%= intSum %>
</td>
</tr>
<tr>
<td>
<p>Use Conversion = <%= strUseConversion %></p></td>
</tr>
</table>
</center></div>
</form>
</body>
</html>
<%
End Sub
%>
Figure 6 ErrorInc.asp
<%
'********************************************************************
' Name: ErrorInc.asp
'
' Purpose: Contains constants and functions to handle database
' and system errors.
'********************************************************************
'********************************************************************
' Global Variables and Settings
'********************************************************************
'We must buffer so that we can redirect if necessary.
Response.Buffer = True
'********************************************************************
' ASP Functions
'********************************************************************
'--------------------------------------------------------------------
' Function: ExecuteSQL
'
' Purpose: Executes SQL statement and returns result if no error.
' This function can be used to easily limit the scope of On Error
' Resume Next. THIS FUNCTION JUMPS TO AN ERROR PAGE IF THERE IS
' AN ERROR!
'
' objConnection: Connection object to use for executing SQL.
'
' strSQL: SQL string to execute.
'
' Returns: In the case of a select statement, return the recordset.
'--------------------------------------------------------------------
Function ExecuteSQL(objConnection, strSQL)
On Error Resume Next
Set ExecuteSQL = objConnection.Execute(strSQL,,adCmdText)
HandleSQLErrors objConnection, "ExecuteSQL", strSQL
End Function
'--------------------------------------------------------------------
' Function: AddNewRecord
'
' Purpose: Adds a new record to a recordset using ADO AddNew().
' This function can be used to easily limit the scope of
' On Error Resume Next. THIS FUNCTION JUMPS TO AN ERROR PAGE IF THERE
' IS AN ERROR!
'
' objRecSet: Valid recordset to use for adding new record.
'
' FieldArray: Array of fields to add.
'
' ValueArray: Array of values for the fields.
'--------------------------------------------------------------------
Sub AddNewRecord(objRecSet, FieldArray(), ValueArray())
' On Error Resume Next
objRecSet.AddNew FieldArray, ValueArray
HandleADOErrors objRecSet, "AddNewRecord", FieldArray, ValueArray
End Sub
'--------------------------------------------------------------------
' Function: HandleADOErrors
'
' Purpose: Handles database errors when using AddNew() and Update()
' ADO calls. Prints out arrays if error. THIS FUNCTION JUMPS TO AN
' ERROR PAGE IF THERE IS AN ERROR!
'
' objRecSet: The recordset that is being tested for errors.
'
' strProgFunc: The name of the function that is calling this routine.
'
' FieldArray: Array of fields used for ADO AddNew()/Update().
'
' ValueArray: Array of values used for ADO AddNew()/Update().
'--------------------------------------------------------------------
Sub HandleADOErrors(objRecSet, strProgFunc, FieldArray(), _
ValueArray())
Dim objConnection
Set objConnection = objRecSet.ActiveConnection
If IsObject(objConnection) Then
If objConnection.Errors.Count > 0 Or Err.Number <> 0 Then
Dim strSQLInfo
Dim intCnt
strSQLInfo = "Field Names/Values: <BR>"
For intCnt = 0 To UBound(FieldArray)
strSQLInfo = strSQLInfo & FieldArray(intCnt) & " = "
If intCnt <= UBound(ValueArray) Then
strSQLInfo = strSQLInfo & ValueArray(intCnt) _
& "<BR>"
Else
strSQLInfo = strSQLInfo _
& "Error - array out of bounds<BR>"
End If
Next
Dim strMsg
strMsg = FormatDBErrorMsg(objConnection, strProgFunc, _
strSQLInfo)
ErrorAbort strMsg, False
End If
Else
ErrorAbort "Not a valid objConnection in " & strProgFunc _
& ".", False
End If
End Sub
'--------------------------------------------------------------------
' Function: HandleSQLErrors
'
' Purpose: Handles errors when executing SQL string through ADO
' Execute. THIS FUNCTION JUMPS TO AN ERROR PAGE IF THERE IS AN ERROR!
'
' objConnection: The connection that was used for executing the SQL.
'
' strProgFunc: The name of the function that is calling this routine.
'
' strSQL: The SQL that was executed.
'--------------------------------------------------------------------
Sub HandleSQLErrors(objConnection, strProgFunc, strSQL)
If objConnection.Errors.Count > 0 Or Err.Number <> 0 Then
Dim strHTMLMsg
strHTMLMsg = FormatDBErrorMsg(objConnection, strProgFunc, _
strSQL)
ErrorAbort strHTMLMsg, False
End If
End Sub
'--------------------------------------------------------------------
' Function: ErrorAbort
'
' Purpose: Aborts the normal path of execution. THIS FUNCTION JUMPS
' TO SYSTEM ERROR PAGE. It displays a message in the error page.
'
' strErrorMsg: The error message to display on the error page.
'
' blnIncludeVariables: Set to True to include form, querystring, and
' session variables in the displayed error message.
'--------------------------------------------------------------------
Sub ErrorAbort(strErrorMsg, blnIncludeVariables)
Dim strFinalMsg
strFinalMsg = strErrorMsg & "<BR>"
If blnIncludeVariables Then
strFinalMsg = strFinalMsg & FormatVariables()
End If
Session("DBE_HTML_MSG") = strFinalMsg
Response.Redirect("Error.asp")
End Sub
'--------------------------------------------------------------------
' Function: FormatDBErrorMsg
'
' Purpose: Formats a database error message into HTML. The message is
' composed of general information and all Connection Object errors.
'
' objConnection: The Connection Object that contains the errors to
' be formatted.
'
' strProgFunc: The name of the function that is calling this routine.
'
' strSQLInfo: Information related to the SQL.
'
' Returns: An HTML string with the formatted information.
'--------------------------------------------------------------------
'Formats a database error message into HTML
Function FormatDBErrorMsg(objConnection, strProgFunc, strSQLInfo)
FormatDBErrorMsg = FormatErrorMsg(strProgFunc)
'Format connection object errors
FormatDBErrorMsg = FormatDBErrorMsg & "<BR>" _
& "SQL Information = " & strSQLInfo & "<BR>"
FormatDBErrorMsg = FormatDBErrorMsg & "<BR>" _
& "Number Of Errors = " & objConnection.Errors.Count & "<BR>"
Dim intCnt
intCnt = 0
While intCnt < objConnection.Errors.Count
FormatDBErrorMsg = FormatDBErrorMsg & "<BR>" _
& "SQL State = " & objConnection.Errors(intCnt).SQLState _
& "<BR>"
intCnt = intCnt + 1
Wend
End Function
'--------------------------------------------------------------------
' Function: FormatErrorMsg
'
' Purpose: Formats an error message composed of the script name,
' function name, and Error Object information.
'
' strProgFunc: The name of the function that is calling this routine.
'
' Returns: An HTML string with the formatted information.
'--------------------------------------------------------------------
'Formats an SQL error message into HTML.
Function FormatErrorMsg(strProgFunc)
'Format script name
Dim strSourceFile
strSourceFile = Request.ServerVariables("SCRIPT_NAME")
FormatErrorMsg = "<BR>" & "Source File = " & strSourceFile _
& "<BR>"
FormatErrorMsg = FormatErrorMsg & "<BR>" _
& "Program Function = " & strProgFunc & "<BR>"
'Format error object
FormatErrorMsg = FormatErrorMsg & "<BR>" & "Err Description = " _
& Err.Description & "<BR>"
FormatErrorMsg = FormatErrorMsg & "<BR>" & "Err Source = " _
& Err.Source & "<BR>"
FormatErrorMsg = FormatErrorMsg & FormatVariables
End Function
'--------------------------------------------------------------------
' Function: FormatVariables
'
' Purpose: Formats all form, querystring, and session variables.
'
' Returns: An HTML string that contains all variables.
'--------------------------------------------------------------------
'Formats and returns all form, query string and session variables.
Function FormatVariables
Dim strMsg
'Format all form variables
Dim strF
For Each strF In Request.Form
strMsg = strMsg & "<BR>" & strF & "= " _
& CStr(Request.Form(strF)) & "<BR>"
Next
'Format all querystring variables
Dim strQS
For Each strQS In Request.QueryString
strMsg = strMsg & "<BR>" & strQS & "= " _
& CStr(Request.QueryString(QS)) & "<BR>"
Next
FormatVariables = strMsg
End Function
%>
Figure 7: ErrorInc in use
Figure 8: ErrorInc output
Figure 9 ErrorTest2.asp
<%@ LANGUAGE="VBSCRIPT" %>
<%
'********************************************************************
' Name: ErrorTest2.asp
'
' Purpose: Makes calls to various error handling functions.
'********************************************************************
Option Explicit
Response.Expires = 0
%>
<!--#includes virtual="adovbs.asp"-->
<!--#includes virtual="ASPTips/ErrorInc.asp"-->
<%
'********************************************************************
' Global Variables
'********************************************************************
'********************************************************************
' Main
'********************************************************************
Main
'--------------------------------------------------------------------
' Function: Main
'
' Purpose: Entry point for the page.
'--------------------------------------------------------------------
Sub Main
Dim strFunction
strFunction = Request.Form("radFunction")
If strFunction = "ErrorAbort" Then
ErrorAbort "This is an ErrorAbort test.", True
Else
'Create database connection
Dim objConnection
Set objConnection = Server.CreateObject("ADODB.Connection")
objConnection.Open "DSN=NorthWind"
Dim objRecSet
Select Case strFunction
Case "ExecuteSQL", "ExecuteSQLError"
Dim strSQL
If strFunction = "ExecuteSQL" Then
strSQL = "Select * From Shippers"
Else
strSQL = "Select * From Junk"
End If
Set objRecSet = ExecuteSQL(objConnection, strSQL)
Case "AddNewRecord", "AddNewRecordError"
Dim strFieldArray(1)
strFieldArray(0) = "CompanyName"
strFieldArray(1) = "Phone"
Dim strValueArray(1)
strValueArray(0) = "Big Time Shipping"
If strFunction = "AddNewRecord" Then
strValueArray(1) = "(999) 999-9999"
Else
strValueArray(1) = _
"(999) 999-9999 This is a bad phone number"
End If
Set objRecSet = Server.CreateObject("ADODB.Recordset")
objRecSet.Open "Shippers", objConnection, _
adOpenForwardOnly, adLockOptimistic, adCmdTable
AddNewRecord objRecSet, strFieldArray, strValueArray
End Select
End If
Response.Redirect("ErrorTest1.asp")
End Sub
%>