ute_class_form.inc

UTE - (U)niversal ASP (T)able (E)ditor 万能数据管理（管理后台）

                                """ value=""" & m_StandardFields(i) & """>" & vbCrLf & _
                            "<input type=""hidden"" name=""" & sFormUTEFieldPrefix & sFormIdentType & CStr(nCount) & _
                                """ value=""" & m_StandardTypes(i) & """>" & vbCrLf & _
                            "<input type=""hidden"" name=""" & sFormUTEFieldPrefix & sFormIdentValue & CStr(nCount) & _
                                """ value=""" & sValue & """>" & vbCrLf
                    end if
                next
            end if 
        end if 
    end if

    InsertIdentFields = sReturn
End Function


''--------------------------------------------------------------------------
'' Name:     InitForm
''           ========
'' 
'' Initialises a recordset for the form. This is either created as a new
'' (empty) one, or as a copy from the current record from the table view.
''
'' Parameter: 
''      none
''
'' return value:
''      none
''
''--------------------------------------------------------------------------
Private Sub InitForm ()

    Dim s

    ' if cancel button was pressed redirect back to table
    if Request.Form(sFormUTEFieldPrefix & sFormButton) = STR_CANCEL then
        s = Request.QueryString
        s = getLink(m_sUTEScript, s, sParamMode,      CStr(MD_TABLE))
        s = getLink(m_sUTEScript, s, sParamFormMode,  CStr(DEF_FORM_MODE))
        s = getLink(m_sUTEScript, s, sParamSubmitted, "0")
        Response.Redirect s
    end if

    ' get RecordSet for this form
    if m_nFormMode = MD_INSERT then
        ' create new RecordSet
        Set m_RSForm = Server.CreateObject("ADODB.Recordset")
        m_RSForm.Open m_sTable, m_DB, adOpenStatic, adLockPessimistic, adCmdTable
        m_RSForm.AddNew
    else
        if not m_bSubmitted then
            ' identify record by "record" URL param
            m_RS.Move m_nRecord - 1, adBookmarkFirst
            Set m_RSForm = m_RS
        else
            ' identify record by hidden form fields
            Set m_RSForm = Server.CreateObject("ADODB.Recordset")
            m_RSForm.Open getSQLStatement("SELECT *"), m_DB, adOpenStatic, adLockPessimistic, adCmdText
        end if
    end if

End Sub


''--------------------------------------------------------------------------
'' Name:     IsFormField
''           ===========
'' 
'' Returns TRUE if thegiven field name is a field on the current submitted form.
''
'' Parameter: 
''      name        name of field
''
'' return value:
''      boolean
''
''--------------------------------------------------------------------------
Private Function IsFormField ( name )
    Dim bReturn
    Dim field
    bReturn = False
    for each field in Request.Form
        if (field = name) then bReturn = True
    next
    IsFormField = bReturn
End Function


''--------------------------------------------------------------------------
'' Name:     UpdateRecordSet
''           ===============
'' 
'' Put form values into record set
''
'' Parameter: 
''      rsUpdt      recordset to be updated
''
'' return value:
''      none
''
''--------------------------------------------------------------------------
Private Sub UpdateRecordSet ( byref rsUpdt )

    Dim field

    ' own error handling
    On Error Resume Next

    'for each field in Request.Form
    for each field in rsUpdt.fields

        select case field.type
            case adBoolean
                rsUpdt(field.name) = (Request.Form(field.name) = "on")
            case else
                ' is this a field being set in the form ?
                if IsFormField(field.name) then
                    if Request.Form(field.name) = "" then
                        rsUpdt(field.name) = NULL
                    else
                        rsUpdt(field.name) = Request.Form(field.name)
                    end if
                end if
        end select
    
        if Err <> 0 then PutError field.name

    next

    if UBound(m_ErrorField) = 0 then 
        ' make update permanent in DB
        rsUpdt.Update
        if Err <> 0 then PutError ""
    end if

    ' disable own error handling
    On Error Goto 0

End Sub


''--------------------------------------------------------------------------
'' Name:     Update
''           ======
'' 
'' Updates record in database. If successful redirect to ute page in table
'' view mode (else do not redirect, this will lead to display the form and
'' show the error)
''
'' Parameter: 
''      none
''
'' return value:
''      none
''
''--------------------------------------------------------------------------
Private Sub Update
    Dim s
    
    ' initialise form
    InitForm

    if m_bSubmitted then

        select case m_nFormMode
            case MD_INSERT
                ' Insert New Record
                UpdaterecordSet m_RSForm

            case MD_EDIT
                ' Edit Record
                UpdaterecordSet m_RSForm

            case MD_DELETE
                ' Delete Record
                m_DB.Execute getSQLStatement("DELETE")
        end select

        ' If everything is ok return to table view
        if UBound(m_ErrorField) = 0 then 
            s = Request.QueryString
            s = getLink(m_sUTEScript, s, sParamMode,      CStr(MD_TABLE))
            s = getLink(m_sUTEScript, s, sParamFormMode,  CStr(DEF_FORM_MODE))
            s = getLink(m_sUTEScript, s, sParamSubmitted, "0")
            if m_nPageSize = m_RS.RecordCount-1 then
                s = getLink(m_sUTEScript, s, sParamPageSize, CStr(m_RS.RecordCount-1))
            end if
            Response.Redirect s
        end if

    end if

End Sub


''--------------------------------------------------------------------------
'' Name:     getFormToolBar
''           ==============
'' 
'' Returns HTML code for the toolbar on top of the form.
''
'' Parameter: 
''      none
''
'' return value:
''      string      HTML code
''
''--------------------------------------------------------------------------
Private Function getFormToolBar( nColCount )
    Dim s, sValue, sSubmitted

    sValue = ""

    if m_bShowDefLink then

        sValue = "<tr><td class=""ute_toolbar"" colspan=""" & CStr(nColCount)& """>" & vbCrLf

        s = Request.QueryString

        ' show/hide field definitions
        if (m_bShowDefLink) and (m_RS.RecordCount > 0) then
            if m_bViewDefinitions then
                if m_bSubmitted then
                    sSubmitted = "1"
                else
                    sSubmitted = "0"
                end if
                s = getLink(m_sUTEScript, s, sParamSubmitted, sSubmitted)
                s = getLink(m_sUTEScript, s, sParamDefs, "0")
                sValue = sValue & _
                    "<a href=""" & s & """ " & _
                        "onMouseover=""SelectImage('Definition_down','Definition');""" & _
                        "onMouseout=""SelectImage('Definition_down_sel','Definition');"">" & _
                            "<img src=""" & m_sIMAGEDir & "definition_down_sel.gif"" name=""Definition"" border=""0"" " & _
                            "height=""25"" width=""25"" title=""" & STR_DEF_HIDE & """>" & _
                    "</a>" & vbCrLf
            else
                s = getLink(m_sUTEScript, s, sParamDefs, "1")
                s = getLink(m_sUTEScript, s, sParamSubmitted, "0")
                sValue = sValue & _
                    "<a href=""" & s & """ " & _
                        "onMouseover=""SelectImage('Definition_up','Definition');""" & _
                        "onMouseout=""SelectImage('Definition_normal','Definition');"">" & _
                            "<img src=""" & m_sIMAGEDir & "definition.gif"" name=""Definition"" border=""0"" " & _
                            "height=""25"" width=""25"" title=""" & STR_DEF_SHOW & """>" & _
                    "</a>" & vbCrLf
            end if
        end if

        sValue = sValue & "</td></tr>" & vbCrLf

    end if

    getFormToolBar = sValue

End Function


''--------------------------------------------------------------------------
'' Name:     buildHTML_Form
''           ==============
'' 
'' Creates entire UTE HTML code for form view mode.
''
'' Parameter: 
''      none
''
'' return value:
''      string      HTML code
''
''--------------------------------------------------------------------------
Private Function buildHTML_Form()
    Dim i, nColCount
    Dim s, sValue, sSubmitted

    if m_bViewDefinitions then
        nColCount = 4
    else
        nColCount = 2
    end if

    s = Request.QueryString
    s = getLink(m_sUTEScript, s, sParamSubmitted, "1")

    ' add javascript code
    sValue = _
        "<script language=""JavaScript"">" & vbCrLf & _
        "<!--" & vbCrLf & _
        "   browserName = navigator.appName;" & vbCrLf & _
        "   browserVer = parseInt(navigator.appVersion);" & vbCrLf & _
        vbCrLf & _
        "   if (browserName == ""Netscape"" && browserVer >= 3)" & vbCrLf & _
        "   {" & vbCrLf & _
        "   version = ""n3"";" & vbCrLf & _
        "   }" & vbCrLf & _
        "   else if (browserName == ""Microsoft Internet Explorer"" && browserVer >= 3)" & vbCrLf & _
        "   {" & vbCrLf & _
        "   version = ""n3"";" & vbCrLf & _
        "   }" & vbCrLf & _
        "   else version = ""n2"";" & vbCrLf & _
        vbCrLf & _
        "   if (version == ""n3"")" & vbCrLf & _
        "   {" & vbCrLf & _
        "       // create image objects" & vbCrLf & _
        "       Definition_normal       = new Image();" & vbCrLf & _
        "       Definition_up           = new Image();" & vbCrLf & _
        "       Definition_down         = new Image();" & vbCrLf & _
        "       Definition_down_sel     = new Image();" & vbCrLf & _
        vbCrLf & _
        "       // assign actual images to image objects" & vbCrLf & _
        "       Definition_normal.src   = """ & m_sIMAGEDir & "definition.gif"";" & vbCrLf & _
        "       Definition_up.src       = """ & m_sIMAGEDir & "definition_up.gif"";" & vbCrLf & _
        "       Definition_down.src     = """ & m_sIMAGEDir & "definition_down.gif"";" & vbCrLf & _
        "       Definition_down_sel.src = """ & m_sIMAGEDir & "definition_down_sel.gif"";" & vbCrLf & _

        "   }" & vbCrLf & _
        "" & vbCrLf & _
        "   function SelectImage(img_src, img_name)" & vbCrLf & _
        "   {" & vbCrLf & _
        "       if (version == ""n3"")" & vbCrLf & _
        "       {" & vbCrLf & _
        "           imgOn = eval(img_src + "".src"");" & vbCrLf & _
        "           document [img_name].src = imgOn;" & vbCrLf & _
        "       }" & vbCrLf & _
        "   }" & vbCrLf & _
        "//-->" & vbCrLf & _
        "</script>" & vbCrLf & _
        "<p><span class=""ute_headline"">" & m_sTable & "</span></p>" & vbCrLf & _
        "<p><span class=""ute_subheadline"">" & m_sHeadline & "</span></p>" & vbCrLf

    for i = 1 to UBound(m_ErrorField)
        if m_ErrorField(i) = "" then
            sValue = sValue & _
                "<p><span class=""ute_form_error"">" & _
                m_ErrorMessage(i) & _
                "</span></p>" & vbCrLf
        end if
    next

    sValue = sValue & _
        "<form method=""post"" action=""" & s & """>" & vbCrLf & _
        InsertIdentFields & vbCrLf & _
        "<table class=""ute_form"">" & vbCrLf

    ' add toolbar
    sValue = sValue & getFormToolBar(nColCount) & vbCrLf

    ' insert all primary keys
    for i = 1 to UBound(m_PrimaryKeyFields)
        sValue = sValue & InsertFieldForm (m_RSForm.fields(m_PrimaryKeyFields(i)), True)
    next

    ' insert all other fields
    for i = 1 to UBound(m_StandardFields)
        sValue = sValue & InsertFieldForm (m_RSForm.fields(m_StandardFields(i)), False)
    next

    sValue = sValue & _
        "<tr>" & vbCrLf & _
        "<td colspan=""" & CStr(nColCount) & """>" & vbCrLf & _
        "<br><br>&nbsp;" & vbCrLf & _
        "<input type=""submit"" name=""" & sFormUTEFieldPrefix & sFormButton & """ class=""ute_btn_ok"" " & _
                "value=""" & STR_OK & """>" & vbCrLf & _
        "&nbsp;" & vbCrLf & _
        "<input type=""submit"" name=""" & sFormUTEFieldPrefix & sFormButton & """ class=""ute_btn_cancel"" " & _
                "value=""" & STR_CANCEL & """>" & vbCrLf & _
        "&nbsp;" & vbCrLf & _
        "</td>" & vbCrLf & _
        "</tr>" & vbCrLf

    sValue = sValue & _
        "</table>" & vbCrLf & _
        "</from>"

    buildHTML_Form = sValue

End Function


%>