PC World Komputer 1998 July & August/Pcwk78a98.iso/Micrsoft/VJ/COMMON/WIZARD98/VIWZ1.DLL/1033/HTMX/5530

Text File | 1998-02-24 | 15KB | 411 lines

<%@ LANGUAGE="vbscript" %>
<%
'-------------------------------------------------------------------------------
' Microsoft Visual InterDev - Data Form Wizard
'
' Form Page
'
' (c) 1997 Microsoft Corporation.  All Rights Reserved.
'
' This file is an Active Server Page that contains the form view of a Data Form.
' It requires Microsoft Internet Information Server 3.0 and can be displayed
' using any browser that supports tables. You can edit this file to further
' customize the form view.
'
' Modes:         The form mode can be controlled by passing the following
'                name/value pairs using POST or GET:
'                FormMode=Edit
'                FormMode=Filter
'                FormMode=New
' Tips:            - If a field contains a URL to an image and has a name that
'                begins with "img_" (case-insensitive), the image will be
'                displayed using the IMG tag.
'                - If a field contains a URL and has a name that begins with
'                "url_" (case-insensitive), a jump will be displayed using the
'                Anchor tag.
'-------------------------------------------------------------------------------

Dim strPagingMove
Dim strFormMode
Dim strDFName
strDFName = "rs<%#TableShortName#%>"
%>

<SCRIPT RUNAT=Server LANGUAGE="VBScript">

'---- FieldAttributeEnum Values ----
Const adFldUpdatable = &H00000004
Const adFldUnknownUpdatable = &H00000008
Const adFldIsNullable = &H00000020

'---- DataTypeEnum Values ----
Const adUnsignedTinyInt = 17
Const adBoolean = 11
Const adLongVarChar = 201
Const adLongVarWChar = 203
Const adBinary = 128
Const adVarBinary = 204
Const adLongVarBinary = 205
Const adVarChar = 200
Const adWVarChar = 202
Const adBSTR = 8
Const adChar = 129
Const adWChar = 130
'---- Other Values ----
Const dfMaxSize = 100

'-------------------------------------------------------------------------------
' Purpose:  Substitutes Empty for Null and trims leading/trailing spaces
' Inputs:   varTemp    - the target value
' Returns:    The processed value
'-------------------------------------------------------------------------------

Function ConvertNull(varTemp)
    If IsNull(varTemp) Then
        ConvertNull = ""
    Else
        ConvertNull = Trim(varTemp)
    End If
End Function

'-------------------------------------------------------------------------------
' Purpose:  Embeds bracketing quotes around the string
' Inputs:   varTemp    - the target value
' Returns:    The processed value
'-------------------------------------------------------------------------------

Function QuotedString(varTemp)
    If IsNull(varTemp) Then
        QuotedString = Chr(34) & Chr(34)
    Else
        QuotedString = Chr(34) & CStr(varTemp) & Chr(34)
    End If
End Function

'-------------------------------------------------------------------------------
' Purpose:  Tests string to see if it is a URL by looking for protocol
' Inputs:   varTemp    - the target value
' Returns:    True - if is URL, False if not
'-------------------------------------------------------------------------------

Function IsURL(varTemp)
    IsURL = True
    If UCase(Left(Trim(varTemp), 6)) = "HTTP:/" Then Exit Function
    If UCase(Left(Trim(varTemp), 6)) = "FILE:/" Then Exit Function
    If UCase(Left(Trim(varTemp), 8)) = "MAILTO:/" Then Exit Function
    If UCase(Left(Trim(varTemp), 5)) = "FTP:/" Then Exit Function
    If UCase(Left(Trim(varTemp), 8)) = "GOPHER:/" Then Exit Function
    If UCase(Left(Trim(varTemp), 6)) = "NEWS:/" Then Exit Function
    If UCase(Left(Trim(varTemp), 7)) = "HTTPS:/" Then Exit Function
    If UCase(Left(Trim(varTemp), 8)) = "TELNET:/" Then Exit Function
    If UCase(Left(Trim(varTemp), 6)) = "NNTP:/" Then Exit Function
    IsURL = False
End Function

'-------------------------------------------------------------------------------
' Purpose:  Tests whether the field in the recordset is updatable
' Assumes:     That the recordset containing the field is open
' Inputs:   strFieldName    - the name of the field in the recordset
' Returns:    True if updatable, False if not
'-------------------------------------------------------------------------------

Function CanUpdateField(strFieldName)
    Dim intUpdatable
    intUpdatable = (adFldUpdatable Or adFldUnknownUpdatable)
    CanUpdateField = True
    If (rs<%#TableShortName#%>(strFieldName).Attributes And intUpdatable) = False Then
        CanUpdateField = False
    End If
End Function

'-------------------------------------------------------------------------------
' Purpose:  Handles the display of a field from a recordset depending
'            on its data type, attributes, and the current mode.
' Assumes:     That the recordset containing the field is open
'            That strFormMode is initialized
' Inputs:   strFieldName     - the name of the field in the recordset
'            strLabel        - the label to display
'            blnIdentity        - identity field flag
'            avarLookup        - array of lookup values
'-------------------------------------------------------------------------------

Sub ShowField(strFieldName, strLabel, blnIdentity, avarLookup)
    Dim blnFieldRequired
    Dim intMaxSize
    Dim intInputSize
    Dim strOption1State
    Dim strOption2State
    Dim strFieldValue
    Dim nPos
    strFieldValue = ""
    nPos=Instr(strFieldName,".")
    Do While nPos > 0
        strFieldName= Mid (strFieldName, nPos+1)
        nPos=Instr(strFieldName,".")
    Loop
    ' If not in Edit form mode then set value to empty so doesn't display
    strFieldValue = ""
    If strFormMode = "Edit" Then strFieldValue = RTrim(rs<%#TableShortName#%>(strFieldName))

    ' See if the field is required by checking the attributes
    blnFieldRequired = False
    If (rs<%#TableShortName#%>(strFieldName).Attributes And adFldIsNullable) = 0 Then
        blnFieldRequired = True
    End If

    ' Set values for the MaxLength and Size attributes
    intMaxSize = dfMaxSize
    intInputSize = rs<%#TableShortName#%>(strFieldName).DefinedSize + 2
    If strFormMode <> "Filter" Then intMaxSize = intInputSize - 2

    ' Write the field label and start the value cell
    Response.Write "<TR VALIGN=TOP>"
    Response.Write "<TD HEIGHT=25 ALIGN=Left NOWRAP><FONT SIZE=-1><B>  " & strLabel & "</B></FONT></TD>"
    Response.Write "<TD WIDTH=100% ><FONT SIZE=-1>"

    ' If the field is not updatable, then handle
    ' it like an Identity column and exit
    If Not CanUpdateField(strFieldName) Then
        ' Special handling if Binary
        Select Case rs<%#TableShortName#%>(strFieldName).Type
            Case adBinary, adVarBinary, adLongVarBinary        'Binary
                Response.Write "[Binary]"
            Case Else
                Select Case strFormMode
                    Case "Edit"
                        Response.Write ConvertNull(strFieldValue)
                        Response.Write "<INPUT TYPE=Hidden NAME=" & QuotedString(strFieldName)
                        Response.Write " VALUE=" & QuotedString(strFieldValue) & " >"
                    Case "New"
                        Response.Write "[AutoNumber]"
                        Response.Write "<INPUT TYPE=Hidden NAME=" & QuotedString(strFieldName)
                        Response.Write " VALUE=" & QuotedString(strFieldValue) & " >"
                    Case "Filter"
                        Response.Write "<INPUT TYPE=Text NAME=" & QuotedString(strFieldName)
                        Response.Write " SIZE=" & intInputSize
                        Response.Write " MAXLENGTH=" & intMaxSize
                        Response.Write " VALUE=" & QuotedString(strFieldValue) & " >"
                End Select
        End Select
        Response.Write "</FONT></TD></TR>"
        Exit Sub
    End If

    ' Handle lookups using a select and options
    If Not IsNull(avarLookup) Then
        Response.Write "<SELECT NAME=" & QuotedString(strFieldName) & ">"
        ' Add blank entry if not required or in filter mode
        If Not blnFieldRequired Or strFormMode = "Filter" Then
            If (strFormMode = "Filter" Or strFormMode = "New") Then
                Response.Write "<OPTION SELECTED>"
            Else
                Response.Write "<OPTION>"
            End If
        End If

        ' Loop thru the rows in the array
        For intRow = 0 to UBound(avarLookup, 2)
            Response.Write "<OPTION VALUE=" & QuotedString(avarLookup(0, intRow))
            If strFormMode = "Edit" Then
                If ConvertNull(avarLookup(0, intRow)) = ConvertNull(strFieldValue) Then
                       Response.Write " SELECTED"
                End If
            End If
               Response.Write ">"
            Response.Write ConvertNull(avarLookup(1, intRow))
        Next
        Response.Write "</SELECT>"
        If blnFieldRequired And strFormMode = "New" Then
            Response.Write "  Required"
        End If
        Response.Write "</FONT></TD></TR>"
        Exit Sub
    End If

    ' Evaluate data type and handle appropriately
    Select Case rs<%#TableShortName#%>(strFieldName).Type

        Case adBoolean, adUnsignedTinyInt                'Boolean
            If strFormMode = "Filter" Then
                strOption1State = " >True"
                strOption2State = " >False"
            Else
                Select Case strFieldValue
                    Case "True", "1", "-1"
                        strOption1State = " CHECKED>True"
                        strOption2State = " >False"
                    Case "False", "0"
                        strOption1State = " >True"
                        strOption2State = " CHECKED>False"
                    Case Else
                        strOption1State = " >True"
                        strOption2State = " >False"
                End Select
            End If
            Response.Write "<INPUT TYPE=Radio VALUE=1 NAME=" & QuotedString(strFieldName) & strOption1State
            Response.Write "<INPUT TYPE=Radio VALUE=0 NAME=" & QuotedString(strFieldName) & strOption2State
            If strFormMode = "Filter" Then
                Response.Write "<INPUT TYPE=Radio NAME=" & QuotedString(strFieldName) & " CHECKED>Neither"
            End If

        Case adBinary, adVarBinary, adLongVarBinary        'Binary
            Response.Write "[Binary]"

        Case adLongVarChar, adLongVarWChar                'Memo
            Response.Write "<TEXTAREA NAME=" & QuotedString(strFieldName) & " ROWS=3 COLS=80>"
            Response.Write Server.HTMLEncode(ConvertNull(strFieldValue))
            Response.Write "</TEXTAREA>"

        Case Else
            Dim nType
            nType=rs<%#TableShortName#%>(strFieldName).Type
            If (nType <> adVarChar) and (nType <> adWVarChar) and (nType <> adBSTR) and (nType <> adChar) and (nType <> adWChar)  Then
                intInputSize = (intInputSize-2)*3+2
                If strFormMode <> "Filter" Then intMaxSize = intInputSize - 2
            End If
            If blnIdentity Then
                Select Case strFormMode
                    Case "Edit"
                        Response.Write ConvertNull(strFieldValue)
                        Response.Write "<INPUT TYPE=Hidden NAME=" & QuotedString(strFieldName)
                        Response.Write " VALUE=" & QuotedString(strFieldValue) & " >"
                    Case "New"
                        Response.Write "[AutoNumber]"
                        Response.Write "<INPUT TYPE=Hidden NAME=" & QuotedString(strFieldName)
                        Response.Write " VALUE=" & QuotedString(strFieldValue) & " >"
                    Case "Filter"
                        Response.Write "<INPUT TYPE=Text NAME=" & QuotedString(strFieldName) & " SIZE=" & tInputSize
                        Response.Write " MAXLENGTH=" & tMaxSize & " VALUE=" & QuotedString(strFieldValue) & " >"
                End Select
            Else
                If intInputSize > 80 Then intInputSize = 80
                Response.Write "<INPUT TYPE=Text NAME=" & QuotedString(strFieldName)
                Response.Write " SIZE=" & intInputSize
                Response.Write " MAXLENGTH=" & intMaxSize
                Response.Write " VALUE=" & QuotedString(strFieldValue) & " >"
                ' Check for special field types
                Select Case UCase(Left(rs<%#TableShortName#%>(strFieldName).Name, 4))
                    Case "IMG_"
                        If strFieldValue <> "" Then
                            Response.Write "<BR><BR><IMG SRC=" & QuotedString(strFieldValue) & "><BR> <BR>"
                        End If
                    Case "URL_"
                        If strFieldValue <> "" Then
                            Response.Write "  <A HREF=" & QuotedString(strFieldValue) & ">"
                            Response.Write "Go"
                            Response.Write "</A>"
                        End If
                    Case Else
                        If IsURL(strFieldValue) Then
                            Response.Write "  <A HREF=" & QuotedString(strFieldValue) & ">"
                            Response.Write "Go"
                            Response.Write "</A>"
                        End If
                End Select
            End If
    End Select
       If blnFieldRequired And strFormMode = "New" Then
        Response.Write "  Required"
    End If
    Response.Write "</FONT></TD></TR>"
End Sub
</SCRIPT>

<%
strFormMode = "Edit"    ' Initalize the default
If Not IsEmpty(Request("FormMode")) Then strFormMode = Request("FormMode")
If Not IsEmpty(Request("rs<%#TableShortName#%>_PagingMove")) Then
    strPagingMove = Trim(Request("rs<%#TableShortName#%>_PagingMove"))
End If
%>

<HTML>
<HEAD>
    <META NAME="GENERATOR" CONTENT="Microsoft Visual InterDev">
    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
    <META NAME="Keywords" CONTENT="Microsoft Data Form, <%#FormName#%> Form">
    <TITLE><%#FormName#%> Form</TITLE>
</HEAD>

<!--------------------------- Formatting Section ------------------------------>

<BASEFONT FACE="Arial, Helvetica, sans-serif">
<LINK REL=STYLESHEET HREF="./Stylesheets/<%#THEMENAME#%>/Style2.css">
<BODY BACKGROUND="./Images/<%#THEMENAME#%>/Background/Back2.jpg" BGCOLOR=White>

<!---------------------------- Lookups Section -------------------------------->
<%#ForeignKeyRS#%>
<!---------------------------- Heading Section -------------------------------->

<% Response.Write "<FORM ACTION=""<%#DataActionFileName#%>"" METHOD=""POST"">" %>
<TABLE WIDTH=100% BORDER=0 CELLSPACING=0 CELLPADDING=0>
    <TR>
        <TH NOWRAP BGCOLOR=Silver BACKGROUND="./Images/<%#THEMENAME#%>/Navigation/Nav1.jpg">
            <FONT SIZE=6> <%#FormName#%> </FONT>
        </TH>
        <TD ALIGN=Right BGCOLOR=Silver VALIGN=MIDDLE WIDTH=100% BACKGROUND="./Images/<%#THEMENAME#%>/Navigation/Nav1.jpg">
            <%
            If strFormMode = "Form View" then strFormMode = "Edit"
            Select Case strFormMode
                Case "Edit"
                    %>
<%#ActionButtons#%>
                <% Case "Filter" %>
                    <INPUT TYPE="SUBMIT" NAME="DataAction" VALUE=" Apply ">
                    <INPUT TYPE="SUBMIT" NAME="DataAction" VALUE=" Cancel ">
                <% Case "New" %>
                    <INPUT TYPE="SUBMIT" NAME="DataAction" VALUE=" Insert ">
                    <INPUT TYPE="SUBMIT" NAME="DataAction" VALUE=" Cancel ">
            <% End Select %>
<%#ChangeToListView#%>
        </TD>
    </TR>
<%#StatusLine#%></TABLE>

<!----------------------------- Form Section ---------------------------------->

<%#DataRangeHeaderHTML#%>

<%
If strFormMode = "Edit" Then
    Response.Write "<P>"
    Response.Write "<TABLE WIDTH=100% CELLSPACING=0 CELLPADDING=2 BORDER=0>"
<%#DataFields#%>    Response.Write "</TABLE>"
    Response.Write "</FORM></P>"
    stQueryString = "?FormMode=Edit"
    fHideNavBar = False
    fHideRule = True
Else
    fHideNavBar = True
    fHideRule = True
End If
%>

<%#DataRangeFooterHTML#%>

<%
If strFormMode <> "Edit" Then
    Response.Write "<P>"
    Response.Write "<TABLE WIDTH=100% CELLSPACING=0 CELLPADDING=2 BORDER=0>"
<%#DataFields#%>    Response.Write "</TABLE>"
    Response.Write "</FORM></P>"
End If
%>

<!---------------------------- Footer Section --------------------------------->

<%
' Display a message if there are no records to show
If strFormMode = "Edit" And fEmptyRecordset Then
    Response.Write "<p align=left>No Records Available</p>"
End If
' TEMP: This is here until we get a drop of the data range that has
'         the CacheRecordset property
If fNeedRecordset Then
    Set Session("rs<%#TableShortName#%>_Recordset") = rs<%#TableShortName#%>
End If
%>

</BODY>
</HTML>