Chip 2001 May/W2KPRK.iso/apps/crystal/disk24/Xasp24

Text File | 1999-08-23 | 15.0 KB | 548 lines

<%

'    This script assumes that the Session contains the following Crystal Report Engine
'    Objects:
'
'    "oApp" - Crystal Report Engine Application Object
'    "oRpt" - Crystal Report Engine Report Object
'    "oPageEngine - Crystal Report Engine Page Engine Object
'
'    Note:  Before creating the PageEngine object, call ReadRecords on the
'    report object to that all the database records have been read.




 On Error Resume Next

'  The oEMF object is a helper object to create EMFs (Ecapsulated Messages) for the viewers.
'  The viewers use EMFs to display errors and navigate to specific pages of the report.

If Not IsObject(session("oEMF")) then
    Set session("oEMF") = Server.CreateObject("CREmfgen.CREmfgen.1")
End if


'    Initialize all Global variables
'    These will contain the page generator and page collection

    Dim goPageGenerator        ' page generator object
    Dim goPageCollection    ' page collection object
    Dim goPageGeneratorDrill' page generator object in Drill Down Context
    Dim goPage                ' the page object
    Dim gvGroupPathDD        ' drill down group path, this is an array.
    Dim gvGroupPath            ' this is branch, aka Group Path converted from string passed on the QS, it is an Array
    Dim gvGroupLevel        ' this is the Group level, converted from the string passed on the QS, it is an Array
    Dim gvMaxNode            ' this represents the number of nodes to retrieve for the totaller, it is set to an empty array
    Dim glX                    ' this is the X Coordinate for a drill down on a graph
    Dim glY                    ' this is the Y Coordinate for a drill down on a graph
    Dim gvPageNumber        ' holds the requested page number
    Dim gvURL                ' URL to redirect to
    Dim gsErrorText

' Vaiables that represent what was passed on the Query String
    Dim CMD                    ' This determines the main function to perform
    Dim PAGE                ' the page to return
    Dim BRCH                ' the branch is a mechanism to determine the drill down level.
                            ' A drill down level is like a view of the report, a new tab
                            ' is created to indicate that it is a new view
    Dim VIEWER                ' This is the viewer that is calling the server
    Dim VFMT                ' the format that the viewer understands
    Dim NODE                ' Currently not used??
    Dim GRP                    ' this is a way of specifing the actual group
    Dim COORD                ' these are the coordinates on the graph to process
    Dim DIR                    ' this is the search direction
    Dim CSE                    ' indicates if the search is case sensitive
    Dim TEXT                ' this is the text to search for.
    Dim INIT                ' used to build the frames for the html viewer

'    Initialize Arrays
    gvGroupPath = Array()
    gvGroupLevel = Array()
    gvMaxNode = Array() ' reteive all nodes

' Parse Query String for paramaters

Call ParseQS()

' INIT is a special QS case, we only care about HTML viewer, if it is then save send page and branch info
' to the frame page

if INIT = "HTML_FRAME" then
    ' build URL and send the QS
    if BRCH <> "" then
        ' htmstart is the base page that creates the frames for the HTML viewer
        ' if there is branch information it needs to be passed along.
        gvURL = "htmstart.asp?brch=" & BRCH
    else
        gvURL = "htmstart.asp"
    end if
    response.redirect gvURL
end if



' If there is a BRCH then create the gvGroupPath array that represents it.

if BRCH <> "" then
    gvGroupPath = CreateArray(BRCH)
end if

' If there is a GRP then create the gvGroupLevel array that represents it.

if GRP <> "" then
    gvGroupLevel = CreateArray(GRP)
end if

' If there are COORDs, then get them
if COORD <> "" then
    Call GetDrillDownCoordinates()
end if

' This case statement determines what action to perform based on CMD
' there are sub cases for each viewer type

Select Case CMD

Case "GET_PG"

    Call RetrieveObjects

    ' create the actual page
    Set goPage = goPageCollection(PAGE)
    ' check for an exception on the page number
    if err.number <> 0 then
        if err.number = 9 then
            ' just return the last page
            PAGE = goPageCollection.count
            Set goPage = goPageCollection(PAGE)
            ' these session variables are used for the HTML Frame viewer
            session("LastPageNumber") = PAGE
            session("CurrentPageNumber") = PAGE
            err.clear
        else
            ' abort the script
            response.end
        end if
    end if

    ' 0 is for epf, 8209 is a SafeArray
    Select Case VFMT

        Case "ENCP"
            session("oPageEngine").ImageOptions = 1
            response.binarywrite goPage.Renderepf(8209)

        Case "HTML_FRAME"
            session("oPageEngine").ImageOptions = 1
            response.binarywrite goPage.Renderhtml(1,2,1,request.ServerVariables("SCRIPT_NAME"),8209)
            ' Need to know if it is the last page to construct the toolbar correctly
            if goPage.IsLastPage then
                session("LastPageNumber") = goPage.pagenumber
                session("CurrentPageNumber") = session("LastPageNumber")
            end if
        Case "HTML_PAGE"
            session("oPageEngine").ImageOptions = 1
            response.binarywrite goPage.Renderhtml(1,1,3,request.ServerVariables("SCRIPT_NAME"),8209)

        end select

Case "GET_TTL"

    Select Case VFMT

    Case "ENCP"
        response.binarywrite session("oPageEngine").RenderTotallerETF(gvGroupPath, 0, 0, gvMaxNode, 8209)

    Case "HTML_FRAME"
        response.binarywrite session("oPageEngine").RenderTotallerHTML(gvGroupPath, 1, 0, gvMaxNode, gvGroupLevel, 1, request.ServerVariables("SCRIPT_NAME"), 8209)

    end select


Case "RFSH"

    ' This commard does not force the engine to read records again
    ' to do that you will need to manipulate the oRpt object outside
    ' of this script.

    Call RetrieveObjects
    Set goPage = goPageCollection(PAGE)

    Select Case VFMT

    Case "ENCP"
    ' just send a no error message to the browser, you will need
    ' to implement refresh code here.
    session("oEMF").SendErrorMsg 54, "No Error"

    Case "HTML_FRAME"
        gvURL = "htmstart.asp"
        response.redirect gvURL

    Case "HTML_PAGE"
    session("oPageEngine").ImageOptions = 1
    response.binarywrite goPage.Renderhtml(1,1,3,request.ServerVariables("SCRIPT_NAME"),8209)

    end select


Case "NAV"
    Call RetrieveObjects
    ' Get the page number that the group in on, for this particular branch
    gvPageNumber = goPageGenerator.GetPageNumberForGroup(gvGroupLevel)

    Select Case VFMT
    ' 0 is for epf, 8209 is a SafeArray, 8 is a BSTR
    Case "ENCP"
        ' Create a byte array for the EMF, which will contain the page number
        session("oEMF").sendpagenumberrecord(gvPageNumber)

    Case "HTML_FRAME"
        ' for html browser send back the page
        session("CurrentPageNumber") = gvPageNumber
        response.redirect "framepage.asp"

    end select


Case "CHRT_DD"
    ' only support in smart viewers
    Select Case VFMT

    Case "ENCP"

        '  Get page collection
        Call RetrieveObjects
        ' Pass the coordinates to the report engine to determine what
        ' branch the drill down goes to.
        Set goPageGeneratorDrill = goPageGenerator.DrillOnGraph(PAGE, glX, glY)
        ' Check for an exception because of coordinates
        if err.number <> 0 then
            gsErrorText = "Not part of the Graph"
            session("oEMF").SendErrorMsg 40, gsErrorText
            err.clear
            response.end
        end if
        ' pass the group level and group path to helper function to create
        ' the EMF message, this tells the viewer where to get the page.

        gvGroupPathDD = goPageGeneratorDrill.grouppath
        gvGroupNameDD = goPageGeneratorDrill.groupname

        if err.number <> 0 then
            gsErrorText = "Not part of the Graph"
            session("oEMF").SendErrorMsg 40, gsErrorText
            err.clear
            response.end
        end if

        'session("oEMF").sendbranchesemf(gvGroupPathDD,gvGroupNameDD)\
        session("oEMF").GroupName = gvGroupNameDD
        session("oEMF").sendbranchesemf(gvGroupPathDD)


    end select

Case "GET_LPG"

    ' only support in smart viewers
    Select Case VFMT

    Case "ENCP"
        ' this command returns the page number of the last page
        ' Get page collection
        Call RetrieveObjects
        ' Get the count from the Pages collection
        gvPageNumber = goPageCollection.Count

        ' Send the EMF representing the page number
        session("oEMF").sendpagenumberrecord(gvPageNumber)
    end select

Case "SRCH"
    Call RetrieveObjects
    ' create page variable
    gvPageNumber = CInt(PAGE)

    Select Case VFMT
    Case "ENCP"
        if goPageGenerator.SearchForText(TEXT, 0, gvPageNumber) then
            session("oEMF").sendpagenumberrecord(gvPageNumber)
        else
            gsErrorText = "The specified text, '" & TEXT & "' was not found in the report"
            session("oEMF").SendErrorMsg 33, gsErrorText
        end if

    Case "HTML_FRAME"
        ' We are being called by HTML viewer
        ' need to get the text from the form post
        TEXT = request.form("text")
        ' Now find out what page the text is on
        goPageGenerator.SearchForText TEXT, 0, gvPageNumber
        session("CurrentPageNumber") = gvPageNumber
        if BRCH <> "" then
            gvURL = "framepage.asp?brch=" & BRCH
        else
            gvURL = "framepage.asp"
        end if
        response.redirect gvURL

    Case "HTML_PAGE"
        ' We are being called by HTML viewer
        ' need to get the text from the form post
        TEXT = request.form("text")
        ' Now find out what page the text is on
        goPageGenerator.SearchForText TEXT, 0, gvPageNumber
        Set goPage = goPageCollection(gvPageNumber)
        session("oPageEngine").ImageOptions = 1
        response.binarywrite goPage.Renderhtml(1,1,3,request.ServerVariables("SCRIPT_NAME"),8209)
    end select


Case "TOOLBAR_PAGE"

    ' Redirect to the framepage, need to know if we are
    ' on the last page.

    if session("LastPageNumber") <> "" then
        if CInt(PAGE) > CInt(session("LastPageNumber")) then
            session("CurrentPageNumber") = session("LastPageNumber")
        else
            session("CurrentPageNumber") = PAGE
        end if
    else
        Call RetrieveObjects

        ' create the actual page
        Set goPage = goPageCollection(PAGE)
        ' check for an exception on the page number
        if err.number <> 0 then
            if err.number = 9 then
                ' just return the last page
                PAGE = goPageCollection.count
                Set goPage = goPageCollection(PAGE)
                session("LastPageNumber") = PAGE
                session("CurrentPageNumber") = PAGE
                err.clear
            else
                ' abort the script
                response.end
            end if
        end if
        if goPage.IsLastPage then
            session("LastPageNumber") = goPage.pagenumber
            session("CurrentPageNumber") = session("LastPageNumber")
        else
            session("CurrentPageNumber") = PAGE
        end if
    end if
    if BRCH <> "" then
        gvURL = "framepage.asp?brch=" & BRCH
    else
        gvURL = "framepage.asp"
    end if

    response.redirect gvURL

end select



SUB RetrieveObjects()
' this procedure simply retrieves the session objects into
' global variables
    Dim oRptOptions 'Report Options

    if IsObject(session("oPageEngine")) then
        ' make sure dialogs have been disabled
        Set oRptOptions = session("oRpt").Options
        oRptOptions.MorePrintEngineErrorMessages = 0

        Set goPageGenerator = session("oPageEngine").CreatePageGenerator(gvGroupPath)
        Set goPageCollection = goPageGenerator.Pages
    else
        ' must have timed out return an error, you may wan to Append to the
        ' IIS log here.
        if VFMT = "ENCP" then
            session("oEMF").SendErrorMsg 54, "User Session has expired"
        else
            response.write "User Session has expired"

        end if
        response.end
    end if

END SUB

SUB ParseQS()
    ' Parse the Query String
    CMD = UCase(request.querystring("cmd"))        ' This determines the main function to perform
    PAGE = UCase(request.querystring("page"))    ' the page to return
    BRCH = UCase(request.querystring("BRCH"))    ' the branch is a mechanism to determine the drill down level.
                                                ' A drill down level is like a view of the report, a new tab
                                                ' is created to indicate that it is a new view
    VIEWER = UCase(request.querystring("VIEWER"))    ' This is the viewer that is calling the server
    VFMT = UCase(request.querystring("VFMT"))    ' the format that the viewer understands
    NODE = UCase(request.querystring("NODE"))
    GRP = UCase(request.querystring("GRP"))        ' this is a way of specifing the actual group
    COORD = UCase(request.querystring("COORD"))    ' these are the coordinates on the graph to process
    DIR = UCase(request.querystring("DIR"))        ' this is the search direction
    CSE = UCase(request.querystring("CASE"))    ' indicates if the search is case sensitive
    TEXT = request.querystring("TEXT")            ' this is the text to search for.
    INIT = UCase(request.querystring("INIT"))    ' used to build the frames for the html viewer


    ' Initialize variables to a default if they are not provided on the query string.


    if CMD = "" then
        CMD = UCase(request.form("cmd"))
        if CMD = "" then
            CMD = "GET_PG"
        end if
    end if

    if BRCH = "" then
        BRCH = UCase(request.form("BRCH"))
    end if

    if VIEWER = "" then
        VIEWER = UCase(request.form("VIEWER"))
        if VIEWER = "" then
            VIEWER = "HTML"
        end if
    end if

    if VFMT = "" then
        VFMT = UCase(request.form("VFMT"))
        if VFMT = "" then
            VFMT = "HTML_PAGE"
        end if
    end if

    if GRP = "" then
        GRP = UCase(request.form("GRP"))
    end if

    if COORD = "" then
        COORD = UCase(request.form("COORD"))
    end if

    if NODE = "" then
        NODE = UCase(request.form("NODE"))
    end if

    if DIR = "" then
        DIR = UCase(request.form("DIR"))
        if DIR = "" then
            DIR = "FOR" ' forward
        end if
    End if

    if CSE = "" then
        CSE = UCase(request.form("CASE"))
        if CSE = "" then
            CSE = "0" ' case insensitive
        end if
    end if

    if TEXT = "" then
        TEXT = request.form("TEXT")
    end if

    if INIT = "" then
        INIT = UCase(request.form("INIT"))
    end if

    ' Check to make sure there is a page requested, if not use 1 as a default
    if PAGE = "" then
        PAGE = UCase(request.form("page"))
        if PAGE = "" then
            PAGE = "1"
        end if
    end if

END SUB

Function CreateArray(ByVal vsStringArray)
' this function takes an string like 0-1-1-0 and converts
' it into an array of integers

    Dim lvArray
    Dim lvNewArray
    Dim liCount
    Dim liCurrentPos
    Dim lsBuf
    lvArray = Array()
    lvNewArray = Array()
    ReDim lvArray(256)

    liStringLength = Len(vsStringArray)
    liCount = 0
    liCurrentPos = 1
    lsBuf = ""

    While liCurrentPos <= liStringLength

         'ignore this character
        If Mid(vsStringArray, liCurrentPos, 1) <> "-" Then
            lsBuf = lsBuf & Mid(vsStringArray, liCurrentPos, 1)
            If liCurrentPos = liStringLength Then
                lvArray(liCount) = CInt(lsBuf)
                lsBuf = ""
                liCount = liCount + 1
            End If

        Else
            lvArray(liCount) = CInt(lsBuf)
            lsBuf = ""
            liCount = liCount + 1
        End If
        liCurrentPos = liCurrentPos + 1
    Wend

    ReDim lvNewArray(liCount - 1)

    For x = 0 To (liCount - 1)
        lvNewArray(x) = lvArray(x)
    Next


    CreateArray = lvNewArray

End Function

SUB GetDrillDownCoordinates()
    Dim liStringLength
    Dim lbDone
    Dim lsBuf

    liStringLength = Len(COORD)
    lbDone = FALSE
    lsBuf = ""
    glX = ""
    glY = ""
    For x = 1 To liStringLength
        lsBuf = Mid(COORD, x, 1)

        'ignore this character
        If lsBuf = "-" Then
            lsBuf = ""
            lbDone = TRUE
        End if

        if lbDone then
            glY = glY + lsBuf
        else
            glX = glX + lsBuf
        end if

    Next

END SUB

%>