BDG Scenario 3

postIt_Old.asp

<%@ Language=VBScript EnableSessionState=False Transaction=Required%>
<% Option Explicit %>
<% Response.Buffer = True %>
<% ' to force authentication for connection to SQL Server
   If Request.ServerVariables("AUTH_USER") = "" Then
      Response.Status = "401 Access Denied"
      Response.End
   End If
%>
<SCRIPT language="vbScript">
   
   ' NOTE: This script will change the display value of DEBUG
   ' text that may appear in the IFRAME window.  It does not
   ' affect the charset or codepage of the data that is POSTed
   ' to the SQL Server.
   
   Dim item,NodeValue 
   For Each item in parent.document.all.tags("META")
      If UCase(item.httpEquiv)="CONTENT-TYPE" Then
         NodeValue = item.content
         NodeValue = Mid(NodeValue,InstrRev(NodeValue,"=")+1)
         document.defaultCharset = NodeValue
      End If
   Next
</SCRIPT>
<HTML><BODY>
<% Dim nameSProc,oConn,oCommand,returnId
   
   On Error Resume Next
   
   nameSProc = Request.Form("procName")
   If nameSProc="" Or IsEmpty(nameSProc) Then
      Response.Write "ERROR: must specify 'procName'."
      Response.End
   End If
   
   Set oCommand = Server.CreateObject("ADODB.Command")
   With oCommand
      .ActiveConnection = Application("Eval_ConnectionString")
      .CommandType = adCmdStoredProc
      .CommandTimeout = 30

      For Each nameSProc In Request.Form("procName")
         .CommandText = nameSProc
         Select Case UCASE(Request.Form("actionBtn"))
         Case "ADD"
            Response.Write "DEBUG: adding record with '" & nameSProc & "'<BR>"
            Call execForm
            Call reportErrors
            returnId = oCommand.Parameters("@" & Request.Form("tableName") & "Id")
            Response.Write "DEBUG: new record id = " & returnId & "<BR>"
            Call updateView("ADD",returnId)
         Case "CHANGE"
            Response.Write "DEBUG: updating record with '" & nameSProc & "'<BR>"
            returnId = Request.Form("Id")
            Response.Write "DEBUG: record id = " & returnId & "<BR>"
            Call execForm
            Call reportErrors
            Call updateView("CHANGE",returnId)
         Case "DELETE"
            Response.Write "DEBUG: deleting record with '" & nameSProc & "'<BR>"
            returnId = Request.Form("Id")
            Response.Write "DEBUG: record id = " & returnId & "<BR>"
            .Parameters.Append .CreateParameter("@" & Request.Form("tableName") & "Id", adInteger, adParamInput, 4, returnId)
            .Execute
            Call reportErrors
            Call updateView("DELETE",returnId)
         Case Else
            Response.Write "ERROR: Unknown actionBtn value." & vbCrlf
            Response.End  
         End Select

      Next ' NEXT PROCEDURE
      
   End With
      
   Set oCommand = Nothing
  
Sub execForm()
   Dim param,name,value,rname,rparam
   Set rparam = Nothing
   On Error Resume Next
   With oCommand
      .Parameters.Refresh 
      'Copy values frm FORM into PARAMETERS collection
      For Each param In .Parameters
         Response.Write "PARAM: " & param.Name & " TYPE:" & param.Type & "<BR>"
         If param.Direction = adParamInput Then
            name =  Mid(param.Name,2)
            If Request.Form(name).Count <= 1 Then
               value = Trim(Request.Form(name))
               If value = "" Or value = "null" Then value = Null
               Response.Write "DEBUG: form value '" & name & "' = '" & value & "'<BR>"
               param.Value = value
            Else
               'Come back to this one in a loop later
               If rparam Is Nothing Then
                  rname = name
                  Set rparam = param
                  Response.Write "DEBUG: repeated value.<BR>"
               Else
                  Response.Write "ERROR: Only one repeater value may be specified by the form.<BR>"
                  Response.End
               End If
            End If
         End If
      Next

      If Not (IsEmpty(rname) Or rparam Is Nothing) Then      
         'Execute in a loop...
         For Each value In Request.Form(rname)
            value = Trim(value)
            If value = "" Or value = "null" Then value = Null
            Response.Write "DEBUG: repeater form value '" & name & "' = '" & value & "'<BR>"
            rparam.Value = value
            .Execute
         Next
      Else
         'No repeated values, just execute
         .Execute
      End If
   End With
End Sub

Private Sub updateView(actn,id)
   If id = "" Or IsEmpty(id) Then id = "null"
   Response.Write "<" & "script language=""JavaScript"">" & vbCrLf & _
                  "parent.window.updateView(""" & actn & """," & id & ");" & vbCrLf & _
                  "</" & "script>"
End Sub

Private Sub reportErrors()
   Dim sMsg, error
   If Err.number <> 0 Then
      Call writeError(Err.number,Err.description,Err.source)
      Response.End
   ElseIf oCommand.ActiveConnection.Errors.Count > 0 Then
      For Each error In oCommand.ActiveConnection.Errors 
         Call writeError(error.number,error.description,error.source)
      Next
      Response.End
   End If
End Sub

Private Sub writeError(number,description,source)
   Dim sMsg
   sMsg = source & ": error " & Hex(number) & "\n" & description & "\n"
   sMsg = Replace(sMsg, "'", "\'") ' so javaScript isn't confused
   Response.Write "<" & "script language=""JavaScript"">" & vbCrLf & _
                  "alert('" & sMsg & "');" & vbCrLf & _
                  "</" & "script>"
End Sub

%>
</BODY></HTML>