home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the Windows Gam…ming Gurus (2nd Edition) / Disc2.iso / ie4 / ieak4.cab / corpact.asp < prev    next >
Text File  |  1998-02-09  |  25KB  |  728 lines

  1. <%@ LANGUAGE="VBScript" %>
  2. <%
  3. '-------------------------------------------------------------------------------
  4. ' Microsoft Visual InterDev - Data Form Wizard
  5. ' Action Page
  6. '
  7. ' (c) 1997 Microsoft Corporation.  All Rights Reserved.
  8. '
  9. ' This file is an Active Server Page that contains the server script that 
  10. ' handles filter, update, insert, and delete commands from the form view of a 
  11. ' Data Form. It can also echo back confirmation of database operations and 
  12. ' report errors. Some commands are passed through and redirected. Microsoft 
  13. ' Internet Information Server 3.0 is required.
  14. '
  15. '-------------------------------------------------------------------------------
  16.  
  17. Dim strDFName
  18. Dim strErrorAdditionalInfo
  19. strDFName = "rsCorpAdminIEGroup"
  20. %>
  21.  
  22. <SCRIPT RUNAT=Server LANGUAGE="VBScript">
  23.  
  24. '---- FieldAttributeEnum Values ----
  25. Const adFldUpdatable = &H00000004
  26. Const adFldUnknownUpdatable = &H00000008
  27. Const adFldIsNullable = &H00000020
  28.  
  29. '---- CursorTypeEnum Values ----
  30. Const adOpenForwardOnly = 0
  31. Const adOpenKeyset = 1
  32. Const adOpenDynamic = 2
  33. Const adOpenStatic = 3
  34.  
  35. '---- DataTypeEnum Values ----
  36. Const adUnsignedTinyInt = 17
  37. Const adBoolean = 11
  38. Const adDate = 7
  39. Const adDBDate = 133
  40. Const adDBTimeStamp = 135
  41. Const adBSTR = 8
  42. Const adChar = 129
  43. Const adVarChar = 200
  44. Const adLongVarChar = 201
  45. Const adWChar = 130
  46. Const adVarWChar = 202
  47. Const adLongVarWChar = 203
  48. Const adBinary = 128
  49. Const adVarBinary = 204
  50. Const adLongVarBinary = 205
  51.  
  52. '---- Error Values ----
  53. Const errInvalidPrefix = 20001        'Invalid wildcard prefix
  54. Const errInvalidOperator = 20002    'Invalid filtering operator
  55. Const errInvalidOperatorUse = 20003    'Invalid use of LIKE operator
  56. Const errNotEditable = 20011        'Field not editable
  57. Const errValueRequired = 20012        'Value required
  58.  
  59. '-------------------------------------------------------------------------------
  60. ' Purpose:  Substitutes Null for Empty
  61. ' Inputs:   varTemp    - the target value
  62. ' Returns:    The processed value
  63. '-------------------------------------------------------------------------------
  64.  
  65. Function RestoreNull(varTemp)
  66.     If Trim(varTemp) = "" Then
  67.         RestoreNull = Null
  68.     Else
  69.         RestoreNull = varTemp
  70.     End If
  71. End Function
  72.  
  73. Sub RaiseError(intErrorValue, strFieldName)
  74.     Dim strMsg    
  75.     Select Case intErrorValue
  76.         Case errInvalidPrefix
  77.             strMsg = "Wildcard characters * and % can only be used at the end of the criteria"
  78.         Case errInvalidOperator
  79.             strMsg = "Invalid filtering operators - use <= or >= instead."
  80.         Case errInvalidOperatorUse
  81.             strMsg = "The 'Like' operator can only be used with strings."
  82.         Case errNotEditable
  83.             strMsg = strFieldName & " field is not editable."
  84.         Case errValueRequired
  85.             strMsg = "A value is required for " & strFieldName & "."
  86.     End Select
  87.     Err.Raise intErrorValue, "DataForm", strMsg
  88. End Sub
  89.  
  90. '-------------------------------------------------------------------------------
  91. ' Purpose:  Converts to subtype of string - handles Null cases
  92. ' Inputs:   varTemp    - the target value
  93. ' Returns:    The processed value
  94. '-------------------------------------------------------------------------------
  95.  
  96. Function ConvertToString(varTemp)
  97.     If IsNull(varTemp) Then
  98.         ConvertToString = Null
  99.     Else
  100.         ConvertToString = CStr(varTemp)
  101.     End If
  102. End Function
  103.  
  104. '-------------------------------------------------------------------------------
  105. ' Purpose:  Tests to equality while dealing with Null values
  106. ' Inputs:   varTemp1    - the first value
  107. '            varTemp2    - the second value
  108. ' Returns:    True if equal, False if not
  109. '-------------------------------------------------------------------------------
  110.  
  111. Function IsEqual(ByVal varTemp1, ByVal varTemp2)
  112.     IsEqual = False
  113.     If IsNull(varTemp1) And IsNull(varTemp2) Then
  114.         IsEqual = True
  115.     Else
  116.         If IsNull(varTemp1) Then Exit Function
  117.         If IsNull(varTemp2) Then Exit Function
  118.     End If
  119.     If varTemp1 = varTemp2 Then IsEqual = True
  120. End Function
  121.  
  122. '-------------------------------------------------------------------------------
  123. ' Purpose:  Tests whether the field in the recordset is required
  124. ' Assumes:     That the recordset containing the field is open
  125. ' Inputs:   strFieldName    - the name of the field in the recordset
  126. ' Returns:    True if updatable, False if not
  127. '-------------------------------------------------------------------------------
  128.  
  129. Function IsRequiredField(strFieldName)
  130.     IsRequiredField = False
  131.     If (rsCorpAdminIEGroup(strFieldName).Attributes And adFldIsNullable) = 0 Then 
  132.         IsRequiredField = True
  133.     End If
  134. End Function
  135.  
  136. '-------------------------------------------------------------------------------
  137. ' Purpose:  Tests whether the field in the recordset is updatable
  138. ' Assumes:     That the recordset containing the field is open
  139. ' Effects:    Sets Err object if field is not updatable
  140. ' Inputs:   strFieldName    - the name of the field in the recordset
  141. ' Returns:    True if updatable, False if not
  142. '-------------------------------------------------------------------------------
  143.  
  144. Function CanUpdateField(strFieldName)
  145.     Dim intUpdatable
  146.     intUpdatable = (adFldUpdatable Or adFldUnknownUpdatable)
  147.     CanUpdateField = True
  148.     If (rsCorpAdminIEGroup(strFieldName).Attributes And intUpdatable) = False Then
  149.         CanUpdateField = False
  150.     End If
  151. End Function
  152.  
  153. '-------------------------------------------------------------------------------
  154. ' Purpose:  Insert operation - updates a recordset field with a new value 
  155. '            during an insert operation.
  156. ' Assumes:     That the recordset containing the field is open
  157. ' Effects:    Sets Err object if field is not set but is required
  158. ' Inputs:   strFieldName    - the name of the field in the recordset
  159. ' Returns:    True if successful, False if not
  160. '-------------------------------------------------------------------------------
  161.  
  162. Function InsertField(strFieldName)
  163.     InsertField = True
  164.     If IsEmpty(Request(strFieldName)) Then Exit Function
  165.     Select Case rsCorpAdminIEGroup(strFieldName).Type
  166.          Case adBinary, adVarBinary, adLongVarBinary        'Binary
  167.         Case Else
  168.             If CanUpdateField(strFieldName) Then
  169.                 If IsRequiredField(strFieldName) And IsNull(RestoreNull(Request(strFieldName))) Then
  170.                     RaiseError errValueRequired, strFieldName
  171.                     InsertField = False
  172.                     Exit Function
  173.                 End If                
  174.                 rsCorpAdminIEGroup(strFieldName) = RestoreNull(Request(strFieldName))
  175.             End If
  176.     End Select
  177. End Function
  178.  
  179. '-------------------------------------------------------------------------------
  180. ' Purpose:  Update operation - updates a recordset field with a new value 
  181. ' Assumes:     That the recordset containing the field is open
  182. ' Effects:    Sets Err object if field is not set but is required
  183. ' Inputs:   strFieldName    - the name of the field in the recordset
  184. ' Returns:    True if successful, False if not
  185. '-------------------------------------------------------------------------------
  186.  
  187. Function UpdateField(strFieldName)
  188.     UpdateField = True
  189.     If IsEmpty(Request(strFieldName)) Then Exit Function
  190.     Select Case rsCorpAdminIEGroup(strFieldName).Type
  191.          Case adBinary, adVarBinary, adLongVarBinary        'Binary
  192.         Case Else
  193.             ' Only update if the value has changed
  194.             If Not IsEqual(ConvertToString(rsCorpAdminIEGroup(strFieldName)), RestoreNull(Request(strFieldName))) Then
  195.                 If CanUpdateField(strFieldName) Then                        
  196.                     If IsRequiredField(strFieldName) And IsNull(RestoreNull(Request(strFieldName))) Then
  197.                         RaiseError errValueRequired, strFieldName
  198.                         UpdateField = False
  199.                         Exit Function
  200.                     End If                
  201.                     rsCorpAdminIEGroup(strFieldName) = RestoreNull(Request(strFieldName))
  202.                 Else
  203.                     RaiseError errNotEditable, strFieldName
  204.                     UpdateField = False
  205.                 End If
  206.             End If
  207.     End Select
  208. End Function
  209.  
  210. '-------------------------------------------------------------------------------
  211. ' Purpose:  Criteria handler for a field in the recordset. Determines
  212. '            correct delimiter based on data type
  213. ' Effects:    Appends to strWhere and strWhereDisplay variables
  214. ' Inputs:   strFieldName    - the name of the field in the recordset
  215. '            avarLookup        - lookup array - null if none
  216. '-------------------------------------------------------------------------------
  217.  
  218. Sub FilterField(ByVal strFieldName, avarLookup)
  219.     Dim strFieldDelimiter
  220.     Dim strDisplayValue
  221.     Dim strValue
  222.     Dim intRow
  223.     strValue = Request(strFieldName)
  224.     strDisplayValue = Request(strFieldName)
  225.     
  226.     ' If empty then exit right away
  227.     If Request(strFieldName) = "" Then Exit Sub
  228.     
  229.     ' Concatenate the And boolean operator
  230.     If strWhere <> "" Then strWhere = strWhere & " And"
  231.     If strWhereDisplay <> "" Then strWhereDisplay = strWhereDisplay & " And"
  232.     
  233.     ' If lookup field, then use lookup value for display
  234.     If Not IsNull(avarLookup) Then
  235.         For intRow = 0 to UBound(avarLookup, 2)
  236.             If CStr(avarLookup(0, intRow)) = Request(strFieldName) Then
  237.                 strDisplayValue = avarLookup(1, intRow)
  238.                 Exit For
  239.             End If
  240.         Next
  241.     End If
  242.     
  243.     ' Set delimiter based on data type
  244.     Select Case rsCorpAdminIEGroup(strFieldName).Type
  245.         Case adBSTR, adChar, adWChar, adVarChar, adVarWChar    'string types
  246.             strFieldDelimiter = "'"
  247.         Case adLongVarChar, adLongVarWChar                    'long string types
  248.             strFieldDelimiter = "'"                
  249.         Case adDate, adDBDate, adDBTimeStamp                'date types
  250.             strFieldDelimiter = "#"
  251.         Case Else
  252.             strFieldDelimiter = ""
  253.     End Select
  254.     
  255.     ' Modifies script level variables
  256.     strWhere = strWhere & " " & PrepFilterItem(strFieldName, strValue, strFieldDelimiter)
  257.     strWhereDisplay = strWhereDisplay & " " & PrepFilterItem(strFieldName, strDisplayValue, strFieldDelimiter)
  258.  
  259. End Sub
  260.  
  261. '-------------------------------------------------------------------------------
  262. ' Purpose:  Constructs a name/value pair for a where clause
  263. ' Effects:    Sets Err object if the criteria is invalid
  264. ' Inputs:   strFieldName    - the name of the field in the recordset
  265. '            strCriteria        - the criteria to use
  266. '            strDelimiter    - the proper delimiter to use
  267. ' Returns:    The name/value pair as a string
  268. '-------------------------------------------------------------------------------
  269.  
  270. Function PrepFilterItem(ByVal strFieldName, ByVal strCriteria, ByVal strDelimiter)
  271.     Dim strOperator
  272.     Dim intEndOfWord
  273.     Dim strWord
  274.  
  275.     ' Char, VarChar, and LongVarChar must be single quote delimited.
  276.     ' Dates are pound sign delimited.
  277.     ' Numerics should not be delimited.
  278.     ' String to Date conversion rules are same as VBA.
  279.     ' Only support for ANDing.
  280.     ' Support the LIKE operator but only with * or % as suffix.
  281.     
  282.     strCriteria = Trim(strCriteria)    'remove leading/trailing spaces
  283.     strOperator = "="                'sets default
  284.     strValue = strCriteria            'sets default
  285.  
  286.     ' Get first word and look for operator
  287.     intEndOfWord = InStr(strCriteria, " ")
  288.     If intEndOfWord Then
  289.         strWord = UCase(Left(strCriteria, intEndOfWord - 1))
  290.         ' See if the word is an operator
  291.         Select Case strWord
  292.             Case "=", "<", ">", "<=", ">=",  "<>", "LIKE"
  293.                 strOperator = strWord
  294.                 strValue = Trim(Mid(strCriteria, intEndOfWord + 1))
  295.             Case "=<", "=>"
  296.                 RaiseError errInvalidOperator, strFieldName
  297.         End Select
  298.     Else
  299.         strWord = UCase(Left(strCriteria, 2))
  300.         Select Case strWord
  301.             Case "<=", ">=", "<>"
  302.                 strOperator = strWord
  303.                 strValue = Trim(Mid(strCriteria, 3))
  304.             Case "=<", "=>"
  305.                 RaiseError errInvalidOperator, strFieldName
  306.             Case Else
  307.                 strWord = UCase(Left(strCriteria, 1))
  308.                 Select Case strWord
  309.                     Case "=", "<", ">"
  310.                         strOperator = strWord
  311.                         strValue = Trim(Mid(strCriteria, 2))
  312.                 End Select
  313.         End Select
  314.     End If
  315.  
  316.     ' Make sure LIKE is only used with strings
  317.     If strOperator = "LIKE" and strDelimiter <> "'" Then
  318.         RaiseError errInvalidOperatorUse, strFieldName
  319.     End If        
  320.  
  321.     ' Strip any extraneous delimiters because we add them anyway
  322.     ' Single Quote
  323.     If Left(strValue, 1) = Chr(39) Then strValue = Mid(strValue, 2)
  324.     If Right(strValue, 1) = Chr(39) Then strValue = Left(strValue, Len(strValue) - 1)
  325.  
  326.     ' Double Quote - just in case
  327.     If Left(strValue, 1) = Chr(34) Then strValue = Mid(strValue, 2)
  328.     If Right(strValue, 1) = Chr(34) Then strValue = Left(strValue, Len(strValue) - 1)
  329.  
  330.     ' Pound sign - dates
  331.     If Left(strValue, 1) = Chr(35) Then strValue = Mid(strValue, 2)
  332.     If Right(strValue, 1) = Chr(35) Then strValue = Left(strValue, Len(strValue) - 1)
  333.     
  334.     ' Check for leading wildcards
  335.     If Left(strValue, 1) = "*" Or Left(strValue, 1) = "%" Then
  336.         RaiseError errInvalidPrefix, strFieldName
  337.     End If
  338.     
  339.     PrepFilterItem = "[" & strFieldName & "]" & " " & strOperator & " " & strDelimiter & strValue & strDelimiter
  340. End Function
  341.  
  342. '-------------------------------------------------------------------------------
  343. ' Purpose:  Display field involved in a database operation for feedback.
  344. ' Assumes:     That the recordset containing the field is open
  345. ' Inputs:   strFieldLabel    - the label to be used for the field
  346. '            strFieldName    - the name of the field in the recordset
  347. '-------------------------------------------------------------------------------
  348.  
  349. Sub FeedbackField(strFieldLabel, strFieldName, avarLookup)
  350.     Dim strBool
  351.     Dim intRow
  352.     Response.Write "<TR VALIGN=TOP>"
  353.     Response.Write "<TD ALIGN=Left><FONT SIZE=-1><B>  " & strFieldLabel & "</B></FONT></TD>"
  354.     Response.Write "<TD BGCOLOR=White WIDTH=100% ALIGN=Left><FONT SIZE=-1>"
  355.     
  356.     ' Test for lookup
  357.     If Not IsNull(avarLookup) Then
  358.         For intRow = 0 to UBound(avarLookup, 2)
  359.             If CStr(avarLookup(0, intRow)) = Request(strFieldName) Then
  360.                 Response.Write Server.HTMLEncode(avarLookup(1, intRow))
  361.                 Exit For
  362.             End If
  363.         Next
  364.         Response.Write "</FONT></TD></TR>"
  365.         Exit Sub
  366.     End If
  367.     
  368.     ' Test for empty
  369.     If Request(strFieldName) = "" Then
  370.         Response.Write " "
  371.         Response.Write "</FONT></TD></TR>"
  372.         Exit Sub
  373.     End If
  374.     
  375.     ' Test the data types and display appropriately    
  376.     Select Case rsCorpAdminIEGroup(strFieldName).Type
  377.         Case adBoolean, adUnsignedTinyInt                'Boolean
  378.             strBool = ""
  379.             If Request(strFieldName) <> 0 Then
  380.                 strBool = "True"
  381.             Else
  382.                 strBool = "False"
  383.             End If
  384.             Response.Write strBool
  385.         Case adBinary, adVarBinary, adLongVarBinary        'Binary
  386.             Response.Write "[Binary]"
  387.         Case adLongVarChar, adLongVarWChar                'Memo
  388.             Response.Write Server.HTMLEncode(Request(strFieldName))
  389.         Case Else
  390.             If Not CanUpdateField(strFieldName) Then
  391.                 Response.Write "[AutoNumber]"
  392.             Else
  393.                 Response.Write Server.HTMLEncode(Request(strFieldName))
  394.             End If
  395.     End Select
  396.     Response.Write "</FONT></TD></TR>"
  397. End Sub
  398.  
  399. </SCRIPT>
  400.  
  401.  
  402. <% 
  403. If Not IsEmpty(Request("DataAction")) Then
  404.     strDataAction = Trim(Request("DataAction"))
  405. Else
  406.     Response.Redirect "CorpAdminForm.asp?FormMode=Edit"
  407. End If
  408.  
  409. '------------------
  410. ' Action handler
  411. '------------------
  412. Select Case strDataAction
  413.     
  414.     Case "List View"
  415.         
  416.         Response.Redirect "CorpAdminList.asp"
  417.  
  418.     Case "Cancel"
  419.  
  420.         Response.Redirect "CorpAdminForm.asp?FormMode=Edit"
  421.  
  422.     Case "Filter"
  423.     
  424.         On Error Resume Next
  425.         Session("rsCorpAdminIEGroup_Filter") = ""
  426.         Session("rsCorpAdminIEGroup_FilterDisplay") = ""
  427.         Session("rsCorpAdminIEGroup_Recordset").Filter = ""
  428.         Response.Redirect "CorpAdminForm.asp?FormMode=" & strDataAction
  429.  
  430.     Case "New"
  431.     
  432.         On Error Resume Next
  433.         Session("rsCorpAdminIEGroup_Filter") = ""
  434.         Session("rsCorpAdminIEGroup_FilterDisplay") = ""
  435.         Session("rsCorpAdminIEGroup_Recordset").Filter = ""
  436.         Response.Redirect "CorpAdminForm.asp?FormMode=" & strDataAction
  437.  
  438.     Case "Find"
  439.  
  440.         Session("rsCorpAdminIEGroup_PageSize") = 1 'So we don't do standard page conversion
  441.         Session("rsCorpAdminIEGroup_AbsolutePage") = CLng(Request("Bookmark"))
  442.         Response.Redirect "CorpAdminForm.asp"
  443.  
  444.     Case "All Records"
  445.     
  446.         On Error Resume Next
  447.         Session("rsCorpAdminIEGroup_Filter") = ""
  448.         Session("rsCorpAdminIEGroup_FilterDisplay") = ""
  449.         Session("rsCorpAdminIEGroup_Recordset").Filter = ""
  450.         Session("rsCorpAdminIEGroup_AbsolutePage") = 1
  451.         Response.Redirect "CorpAdminForm.asp"
  452.  
  453.     Case "Apply"
  454.  
  455.         On Error Resume Next
  456.         
  457.         ' Make sure we exit and re-process the form if session has timed out
  458.         If IsEmpty(Session("rsCorpAdminIEGroup_Recordset")) Then
  459.             Response.Redirect "CorpAdminForm.asp?FormMode=Edit"
  460.         End If
  461.         
  462.         Set rsCorpAdminIEGroup = Session("rsCorpAdminIEGroup_Recordset")
  463.  
  464.         strWhere = ""
  465.         strWhereDisplay = ""
  466.         FilterField "GroupID", Null
  467.         FilterField "GroupName", Null
  468.         FilterField "INSFile", Null
  469.         
  470.         ' Filter the recordset
  471.         If strWhere <> "" Then
  472.             Session("rsCorpAdminIEGroup_Filter") = strWhere
  473.             Session("rsCorpAdminIEGroup_FilterDisplay") = strWhereDisplay
  474.             Session("rsCorpAdminIEGroup_AbsolutePage") = 1
  475.         Else
  476.             Session("rsCorpAdminIEGroup_Filter") = ""
  477.             Session("rsCorpAdminIEGroup_FilterDisplay") = ""
  478.         End If
  479.  
  480.         ' Jump back to the form
  481.         If Err.Number = 0 Then Response.Redirect "CorpAdminForm.asp"
  482.  
  483.     Case "Insert"
  484.  
  485.         On Error Resume Next        
  486.  
  487.         ' Make sure we exit and re-process the form if session has timed out
  488.         If IsEmpty(Session("rsCorpAdminIEGroup_Recordset")) Then
  489.             Response.Redirect "CorpAdminForm.asp?FormMode=Edit"
  490.         End If
  491.         
  492.         Set rsCorpAdminIEGroup = Session("rsCorpAdminIEGroup_Recordset")
  493.         rsCorpAdminIEGroup.AddNew
  494.         
  495.         Do
  496.             If Not InsertField("GroupID") Then Exit Do
  497.             If Not InsertField("GroupName") Then Exit Do
  498.             If Not InsertField("INSFile") Then Exit Do
  499.  
  500.             rsCorpAdminIEGroup.Update
  501.             Exit Do
  502.         Loop
  503.  
  504.         If Err.Number <> 0 Then
  505.             If rsCorpAdminIEGroup.EditMode Then rsCorpAdminIEGroup.CancelUpdate
  506.         Else
  507.             If IsEmpty(Session("rsCorpAdminIEGroup_AbsolutePage")) Or Session("rsCorpAdminIEGroup_AbsolutePage") = 0 Then
  508.                 Session("rsCorpAdminIEGroup_AbsolutePage") = 1
  509.             End If
  510.             ' Requery static cursor so inserted record is visible
  511.             If rsCorpAdminIEGroup.CursorType = adOpenStatic Then rsCorpAdminIEGroup.Requery
  512.             Session("rsCorpAdminIEGroup_Status") = "Record has been inserted"
  513.         End If
  514.  
  515.     Case "Update"
  516.  
  517.         On Error Resume Next        
  518.  
  519.         ' Make sure we exit and re-process the form if session has timed out
  520.         If IsEmpty(Session("rsCorpAdminIEGroup_Recordset")) Then
  521.             Response.Redirect "CorpAdminForm.asp?FormMode=Edit"
  522.         End If
  523.         
  524.         Set rsCorpAdminIEGroup = Session("rsCorpAdminIEGroup_Recordset")
  525.         If rsCorpAdminIEGroup.EOF and rsCorpAdminIEGroup.BOF Then Response.Redirect "CorpAdminForm.asp"
  526.         
  527.         Do
  528.  
  529.             If Not UpdateField("GroupID") Then Exit Do
  530.             If Not UpdateField("GroupName") Then Exit Do
  531.             If Not UpdateField("INSFile") Then Exit Do
  532.  
  533.             If rsCorpAdminIEGroup.EditMode Then rsCorpAdminIEGroup.Update
  534.             Exit Do
  535.         Loop
  536.  
  537.         If Err.Number <> 0 Then
  538.             If rsCorpAdminIEGroup.EditMode Then rsCorpAdminIEGroup.CancelUpdate
  539.         End If
  540.  
  541.     Case "Delete"
  542.  
  543.         On Error Resume Next
  544.         
  545.         ' Make sure we exit and re-process the form if session has timed out
  546.         If IsEmpty(Session("rsCorpAdminIEGroup_Recordset")) Then
  547.             Response.Redirect "CorpAdminForm.asp?FormMode=Edit"
  548.         End If
  549.         
  550.         Set rsCorpAdminIEGroup = Session("rsCorpAdminIEGroup_Recordset")
  551.         If rsCorpAdminIEGroup.EOF and rsCorpAdminIEGroup.BOF Then Response.Redirect "CorpAdminForm.asp"
  552.         
  553.         rsCorpAdminIEGroup.Delete
  554.  
  555.         ' Proceed if no error
  556.         If Err.Number = 0 Then
  557.             ' Requery static cursor so deleted record is removed
  558.             If rsCorpAdminIEGroup.CursorType = adOpenStatic Then rsCorpAdminIEGroup.Requery
  559.             
  560.             ' Move off deleted rec
  561.             rsCorpAdminIEGroup.MoveNext
  562.             
  563.             ' If at EOF then jump back one and adjust AbsolutePage
  564.             If rsCorpAdminIEGroup.EOF Then
  565.                 rsCorpAdminIEGroup.MovePrevious
  566.                 Session("rsCorpAdminIEGroup_AbsolutePage") = Session("rsCorpAdminIEGroup_AbsolutePage") - 1                
  567.                 If rsCorpAdminIEGroup.BOF And rsCorpAdminIEGroup.EOF Then rsCorpAdminIEGroup.Requery
  568.             End If
  569.         End If
  570.  
  571. End Select
  572. %>
  573. <%
  574. '<!----------------------------- Error Handler --------------------------------->
  575.  
  576.    If Err Then %>
  577.     <%
  578.     ' Add additional error information to clarify specific errors
  579.     Select Case Err.Number
  580.         Case -2147467259
  581.             strErrorAdditionalInfo = "  This may be caused by an attempt to update a non-primary table in a view."
  582.         Case Else
  583.             strErrorAdditionalInfo = ""
  584.     End Select
  585.     %>
  586.     <HTML>
  587.     <HEAD>
  588.         <META NAME="GENERATOR" CONTENT="Microsoft Visual InterDev">
  589.         <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
  590.         <META NAME="keywords" CONTENT="Microsoft Data Form, IEAK CorpAdmin Form">
  591.         <TITLE>IEAK CorpAdmin Form</TITLE>
  592.     </HEAD>
  593.     <BASEFONT FACE="Arial, Helvetica, sans-serif">
  594.     <LINK REL=STYLESHEET HREF="./Stylesheets/Grid/Style2.css">
  595.     <BODY BACKGROUND="./Images/Grid/Background/Back2.jpg" BGCOLOR=White>
  596.     <TABLE WIDTH=100% CELLSPACING=0 CELLPADDING=0 BORDER=0>
  597.         <TR>
  598.             <TH COLSPAN=2 NOWRAP ALIGN=Left BGCOLOR=Silver BACKGROUND="./Images/Grid/Navigation/Nav1.jpg">
  599.                 <FONT SIZE=6> Message: </FONT>
  600.             </TH>
  601.         </TR>
  602.         <TR>
  603.             <TD BGCOLOR=#FFFFCC COLSPAN=2>
  604.             <FONT SIZE=3><B>
  605.             <% 
  606.             Select Case strDataAction
  607.                 Case "Insert"
  608.                     Response.Write("Unable to insert the record into IEGroup.")
  609.                 Case "Update"
  610.                     Response.Write("Unable to post the updated record to IEGroup.")
  611.                 Case "Delete"
  612.                     Response.Write("Unable to delete the record from IEGroup.")
  613.             End Select
  614.             %>
  615.             </B></FONT>
  616.             </TD>
  617.         </TR>
  618.     </TABLE>
  619.     <TABLE WIDTH=100% CELLSPACING=1 CELLPADDING=2 BORDER=0>
  620.         <TR>
  621.             <TD ALIGN=Left BGCOLOR=Silver><FONT SIZE=-1><B>  Item</B></FONT></TD>
  622.             <TD WIDTH=100% ALIGN=Left BGCOLOR=Silver><FONT SIZE=-1><B>Description</B></FONT></TD>
  623.         </TR>
  624.         <TR>
  625.             <TD><FONT SIZE=-1><B>  Source:</B></FONT></TD>
  626.             <TD BGCOLOR=White><FONT SIZE=-1><%= Err.Source %></TD>
  627.         </TR>
  628.         <TR>
  629.             <TD NOWRAP><FONT SIZE=-1><B>  Error Number:</B></FONT></TD>
  630.             <TD BGCOLOR=White><FONT SIZE=-1><%= Err.Number %></FONT></TD>
  631.         </TR>
  632.         <TR>
  633.             <TD><FONT SIZE=-1><B>  Description:</B></FONT></TD>
  634.             <TD BGCOLOR=White><FONT SIZE=-1><%= Server.HTMLEncode(Err.Description & strErrorAdditionalInfo) %></FONT></TD>
  635.         </TR>
  636.         <TR>
  637.             <TD COLSPAN=2><HR></TD>
  638.         </TR>
  639.         <TR>
  640.             <TD>
  641.             <% Response.Write "<FORM ACTION=""CorpAdminForm.asp"" METHOD=""POST"">" %>
  642.             <INPUT TYPE="Hidden" NAME="FormMode" VALUE="Edit">
  643.             <INPUT TYPE="SUBMIT" VALUE="Form View">
  644.             </FORM>
  645.             </TD>
  646.             <TD>
  647.             <FONT SIZE=-1>
  648.             To return to the form view with the previously entered 
  649.             information intact, use your browsers "back" button
  650.             </FONT>
  651.             </TD>
  652.         </TR>
  653.     </TABLE>
  654.     </BODY>
  655.     </HTML>
  656.  
  657. <% Else %>
  658. <!-- Action feedback -->
  659.     <HTML>
  660.     <HEAD>
  661.         <META NAME="GENERATOR" CONTENT="Microsoft Visual InterDev">
  662.         <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
  663.         <META NAME="keywords" CONTENT="Microsoft DataForm, IEAK CorpAdmin Form">
  664.         <TITLE>IEAK CorpAdmin Form</TITLE>
  665.     </HEAD>
  666.     <BASEFONT FACE="Arial, Helvetica, sans-serif">
  667.     <LINK REL=STYLESHEET HREF="./Stylesheets/Grid/Style2.css">
  668.     <BODY BACKGROUND="./Images/Grid/Background/Back2.jpg" BGCOLOR=White>
  669.     <TABLE WIDTH=100% CELLSPACING=0 CELLPADDING=0 BORDER=0>
  670.         <TR>
  671.             <TH COLSPAN=2 NOWRAP ALIGN=Left BGCOLOR=#CCCCFF BACKGROUND="./Images/Grid/Navigation/Nav1.jpg">
  672.                 <FONT SIZE=6> Feedback: </FONT>
  673.             </TH>
  674.         </TR>
  675.         <TR>
  676.             <TD BGCOLOR=#FFFFCC COLSPAN=2>  
  677.             <FONT SIZE=-1>
  678.             <% 
  679.             Select Case strDataAction
  680.                 Case "Insert"
  681.                     Response.Write("The following record has been inserted into CorpAdminIEGroup.")
  682.                 Case "Update"
  683.                     Response.Write("The following updated record has been posted to CorpAdminIEGroup.")
  684.                 Case "Delete"
  685.                     Response.Write("The following record has been deleted from CorpAdminIEGroup.")
  686.             End Select
  687.             %>
  688.             </FONT>
  689.             </TD>
  690.         </TR>
  691.     </TABLE>
  692.     <TABLE WIDTH=100% CELLSPACING=1 CELLPADDING=2 BORDER=0>
  693.         <TR>
  694.             <TD ALIGN=Left BGCOLOR=Silver><FONT SIZE=-1><B>  Field</B></FONT></TD>
  695.             <TD WIDTH=100% ALIGN=Left BGCOLOR=Silver><FONT SIZE=-1><B>Value</B></FONT></TD>
  696.         </TR>
  697.         <%
  698.             FeedbackField "GroupID", "GroupID", Null
  699.             FeedbackField "GroupName", "GroupName", Null
  700.             FeedbackField "INSFile", "INSFile", Null
  701.         %>
  702.         <TR>
  703.             <TD COLSPAN=2><HR></TD>
  704.         </TR>
  705.         <TR>
  706.             <TD COLSPAN=2>
  707.             <% Response.Write "<FORM ACTION=""CorpAdminForm.asp"" METHOD=""POST"">" %>
  708.                 <% If strDataAction = "Insert" Then %>
  709.                     <INPUT TYPE="SUBMIT" NAME="FormMode" VALUE="New">
  710.                     <INPUT TYPE="SUBMIT" NAME="FormMode" VALUE="Form View">
  711.                 <% Else %>
  712.                     <INPUT TYPE="Hidden" NAME="FormMode" VALUE="Edit">
  713.                     <INPUT TYPE="SUBMIT" VALUE="Form View">
  714.                 <% End If %>
  715.             </FORM>
  716.             </TD>
  717.         </TR>
  718.     </TABLE>
  719. </BODY>
  720. </HTML>
  721.  
  722. <% 
  723. End If 
  724. Set rsCorpAdminIEGroup = Nothing
  725. %>
  726.  
  727.