Process Pool Demo

In an article on the Unicorn InterGlobal web site I describe my Process Pooling Demo web view.

The code for it is as follows and you can download the zip file from this link: File:ProcPoolDemo.zip.

(Note: now modified to work with DataFlex 20.0 as well as DataFlex 19.1... and possibly prior versions as well - no guarantees though. I have only tested with 19.1 and 20.0.)

Use cWebView.pkg
Use cWebModalDialog.pkg
Use cWebPanel.pkg
Use cWebGroup.pkg
Use cWebForm.pkg 
Use cWebButton.pkg
Use cWebSpacer.pkg
Use cWebList.pkg
Use cWebColumn.pkg
Use cWebLabel.pkg
Use cRegistry.pkg
Use Flexml.pkg
 
Define PROCESS_VM_READ              for |CI$0010
Define PROCESS_QUERY_INFORMATION    for |CI$0400

Define KEY_WOW64_64KEY              for |CI$0100

// Wrap all these in #IFNDEF/#ENDIF blocks to avoid any conflicts
// with the same things already defined in the application
 
#IFNDEF get_GetLastError
External_Function GetLastError "GetLastError" Kernal32.DLL Returns DWord
#ENDIF
 
#IFNDEF get_GetCurrentProcessId
External_Function GetCurrentProcessId "GetCurrentProcessId" Kernel32.Dll Returns Integer
#ENDIF
 
#IFNDEF get_EnumProcesses
External_Function EnumProcesses "K32EnumProcesses" Kernel32.DLL ;
    Pointer lpidProcess ;
    DWord   cb ;
    Pointer lpcbNeeded ;
    Returns Integer
#ENDIF
   
#IFNDEF get_OpenProcess
External_Function OpenProcess "OpenProcess" Kernel32.Dll ;
    DWord dwDesiredAccess ;
    Boolean bInheritHandle ;
    DWord dwProcessId ;
    Returns Handle
#ENDIF
 
#IFNDEF get_ProcessHandle
External_Function ProcessHandle "OpenProcess" Kernel32.DLL ;
    DWord   dwDesiredAccess ;
    Boolean bInheritHandle ;
    DWord   dwProcessID ;
    Returns Handle
#ENDIF
     
#IFNDEF get_ProcessImageFileName
External_Function ProcessImageFileName "K32GetProcessImageFileNameA" Kernel32.DLL ;
    Handle  hProcess ;
    Pointer lpImageFileName ;
    DWord   nSize ;
    Returns DWord
#ENDIF
 
#IFNDEF _struct_stAllMyState
// Struct to hold state
Struct stAllMyState
    Time    tmClicked
    String  sFirstAswer
    Time    tmAnswered1
    String  SecondAnswer
    Time    tmAnswered2
    Integer iProc1
    Integer iProc2
    Integer iProc3
End_Struct
#ENDIF
 
#IFNDEF C_CRLF
// Just for formatting the result of the Yes/No cascade in this case:
Define C_CRLF for (Character(13) + Character(10))
#ENDIF
 
// The following items will (almost always) have different values in
// different processes in the WebApp process pool, but will remain static
// in any given process.
 
Global_Variable Integer giRandom
Move (Random(10000)) to giRandom
 
// This will be a property of oWabApp:
Property Integer piRandom (Random(10000) + 10000)
 
// Will be opened in the WebApp
Open Flexerrs
Clear Flexerrs
Move (Random(99) + 1) to Flexerrs.Recnum
Find EQ FlexErrs by Recnum
 
//==============================================================================
// This is a Modal Dialog which will be called from the View,
// included directly in-line here for simplicity:
//==============================================================================
Object oTestDialog is a cWebModalDialog
    Set psCaption to "Test Dialog"
    Set piMinWidth to 300
    Set piMinHeight to 200
    Set pbServerOnEscape to False   // The only way out
    Set pbShowClose to False        // is to click "OK"
    Set pbServerOnSubmit to True    // enable the OnSubmit event
     
    Object oMainPanel is a cWebPanel
        Set piColumnCount to 12
         
        Object oProcess is a cWebForm
            Set piColumnSpan to 0
            Set peLabelAlign to alignRight
            Set pbReadOnly to True
            Set psLabel to "This Process ID:"
            Set piLabelOffset to 210
        End_Object
         
        Object oCaller is a cWebForm
            Set piColumnSpan to 0
            Set peLabelAlign to alignRight
            Set pbReadOnly to True
            Set psLabel to "Called from Process ID:"
            Set piLabelOffset to 210
        End_Object
         
        Object oGlobal is a cWebForm
            Set piColumnSpan to 0
            Set peLabelAlign to alignRight
            Set pbReadOnly to True
            Set psLabel to "Global variable giRandom was:"
            Set piLabelOffset to 210
        End_Object
                 
        Object oRegProp is a cWebForm
            Set piColumnSpan to 0
            Set peLabelAlign to alignRight
            Set pbReadOnly to True
            Set psLabel to "Regular property piRandom was:"
            Set piLabelOffset to 210
        End_Object
                 
    End_Object
     
    Object oBottomPanel is a cWebPanel
        Set piColumnCount to 4
        Set peRegion to prBottom
 
        Object oOkButton is a cWebButton
            Set psCaption to C_$OK
            Set piColumnSpan to 1
            Set piColumnIndex to 3
 
            Procedure OnClick
                Send Ok
            End_Procedure
             
        End_Object
 
    End_Object
 
    Procedure OnSubmit
        Send Ok
    End_Procedure
     
    Procedure PopupTheDialog  Handle hReturnObj Integer iCaller
        Send Popup hReturnObj
         
        WebSet psValue of oProcess to (GetCurrentProcessId())
        WebSet psValue of oCaller  to iCaller
        WebSet psValue of oGlobal  to giRandom
        WebSet psValue of oRegProp to (piRandom(Self))
    End_Procedure
 
    Function DialogResult Returns String
        String sResult
         
        WebGet psValue of oProcess to sResult
        Function_Return sResult
    End_Function
 
End_Object
 
//==============================================================================
// This is the actual view
//==============================================================================
Object oProcPoolDemo is a cWebView    
    Set piWidth to 700
    Set psCaption to "Process Pooling Effects Demo"
    Set pbServerOnShow to True
     
    Property Integer[] paiWebAppProcs
  
    // Display this view at start up:
    Delegate Set phoDefaultView to Self
     
    // Work out the web application name from the web.config
    // file in AppHTML, which we read into an XML object
    Function WebAppName Returns String
        Handle  hoXml hoElem
        String  sName
        Boolean bOK
         
        Get Create (RefClass(cXMLDOMDocument)) to hoXml
        Set psDocumentName of hoXml to ;
            (psAppHtmlPath(phoWorkspace(ghoApplication)) + "\web.config")
        Get LoadXMLDocument of hoXml to bOK
        Get FindNode of hoXml "configuration/location/system.webServer/dataflexHttpModule" to hoElem
        Get AttributeValue of hoElem "application" to sName
        Send Destroy of hoElem
        Send Destroy of hoXml
        Function_Return sName
    End_Function
     
    // Will be set to return value of above function at start-up.
    // This is a regular property because the web app name can't
    // change while the program is running.
    Property String psWebAppName (WebAppName(Self))
    
    // This uses three external functions to find all the processes in the
    // current WebApp's process pool - it will get updated on every refresh
    // so if you change the number of processes in the pool while the WebApp is
    // running you will see it in the view.
    //
    // It first uses EnumProcesses to find all the running processes on the
    // machine.
    //
    // It then iterates through that list and tries OpenProcess to get a handle
    // to it (for some permissions will not allow that, so those are skipped).
    //
    // Finally it calls ProcessImageFileName to see if that is one of the
    // processes running for THIS WebApp. However ProcessImageFileName
    // returns a file-path starting with the disk identifer in a slightly odd
    // form, i.e. "\DEVICE\HARDDISKVOLUMEn" (n is "1" for my C: drive) and even 
    // spookier things for mapped drives, so we strip off the "C:\", or whatever,
    // from the application file name DataFlex returns and uppercase both, then 
    // compare THAT to the same length of the right-portion of the image name.
    // This may screw up if you have more than one identically pathed web-apps
    // on different drives - just so you know. <g>
    //
    // Note: that although the docs (and the declarations) use DWords,
    //       on Vincent's advice we are using UIntegers in our code (the same
    //       thing in reality) because you can use SizeOfType(UInteger) in the
    //       Watches window when debugging, which you can't for DWord.
    Procedure FindWebAppProcs
        Integer[]  aiWebAppProcs 
        UInteger[] auiProcs
        UInteger   uiCb uiNeeded uiSize uiErr
        Integer    iOK i iLast iPos iSize iPathLen
        Handle     hProc
        UChar[]    ucaFile
        String     sPath sImage
         
        Move (Uppercase(GetApplicationFileName(ghoApplication))) to sPath
        // Strip off drive designation:
        Move (Pos("\", sPath))                                  to iPos
        Move (Right(sPath, (Length(sPath) - iPos)))             to sPath
        Move (Length(sPath))                                    to iPathLen
        Move 4096                                               to iSize
 
        Move (ResizeArray(auiProcs, iSize))                     to auiProcs
        Move (iSize * SizeOfType(UInteger))                     to uiCb
        Move 0                                                  to uiNeeded
 
        Move (EnumProcesses(AddressOf(auiProcs), ;
                            uiCb, ;
                            AddressOf(uiNeeded)))               to iOK
         
        // Just for debugging:
        If not iOK ;
            Move (GetLastError())                               to uiErr
         
        Move (uiNeeded / SizeOfType(UInteger))                  to iSize
        Move (ResizeArray(auiProcs, iSize))                     to auiProcs
        Decrement iSize
         
        For i from 0 to iSize
            Move (OpenProcess(PROCESS_VM_READ + PROCESS_QUERY_INFORMATION, ;
                                                    True, auiProcs[i])) to hProc
             
            If (hProc <> 0) Begin  // We DID get a handle to the process
                Move (ResizeArray(ucaFile, 0))                  to ucaFile
                Move (ResizeArray(ucaFile, 2048))               to ucaFile
                Move (ProcessImageFileName(hProc, ;
                      AddressOf(ucaFile), 2048))                to uiSize
                Move (ResizeArray(ucaFile, uiSize))             to ucaFile
                Move (Uppercase(UCharArrayToString(ucaFile)))   to sImage
                Move (Right(sImage, iPathLen))                  to sImage
                 
                If (sImage = sPath) ;
                    Move auiProcs[i] to aiWebAppProcs[SizeOfArray(aiWebAppProcs)]    
            End
             
        Loop
         
        Set paiWebAppProcs to aiWebAppProcs
    End_Procedure
     
    Procedure OnShow
        Send UpdateProcInfo
    End_Procedure
     
    // Registry object for getting the WebApp info from the registry:
    Object oReg is a cRegistry
        Set phRootKey to HKEY_LOCAL_MACHINE
        Set pfAccessRights to (KEY_WOW64_64KEY ior KEY_READ)
        
        Function BaseKey Returns String
            String[] asParts
            
            Move "SOFTWARE"                 to asParts[0]
            Move "Data Access Worldwide"    to asParts[1]
            Move "DataFlex"                 to asParts[2]
            Move C_DFVersion                to asParts[3]
            Move "WebApp Server"            to asParts[4]
            Move "Web Applications"         to asParts[5]
             
            // If it is a 64-bit machine and running on a DF version PRIOR to 20
            // Insert "Wow6432Node just after "SOFTWARE":
            If (KeyExists(Self, "SOFTWARE\Wow6432Node") and ;
                (Number(C_DFVersion) < 20)) ;
                Move (InsertInArray(asParts, 1, "Wow6432Node")) to asParts
             
            Function_Return (StrJoinFromArray(asParts, "\"))
        End_Function
         
        Function DWKeyValue String sApp String sVal Returns Integer
            Boolean bOK
            Integer iVal
            String  sKey

            Move (BaseKey(Self) + "\" + sApp)   to sKey
            
            Get KeyExists sKey                  to bOK
            If not bOK ;
                Function_Return 0
             
            Get OpenKey sKey to bOK
            If not bOK ;
                Function_Return 0
            
            Move (ReadDWord(Self, sVal)) to iVal
            Send CloseKey
             
            Function_Return iVal
        End_Function
         
    End_Object
     
    // Refresh all the displayed information
    Procedure UpdateProcInfo
        String  sApp
        Integer iMin iMax
         
        Get psWebAppName                to sApp
        WebSet psValue of oMinProc      to (DWKeyValue(oReg(Self), sApp, "MinPool"))
        WebSet psValue of oMaxProc      to (DWKeyValue(oReg(Self), sApp, "MaxPool"))
        WebSet psValue of oCurrProcs    to "Unknown"
         
        WebSet psValue of oCurrProcess  to (GetCurrentProcessId())
        WebSet psValue of oGlobalVal    to giRandom
        WebSet psValue of oRegProp      to (piRandom(Self))
        WebSet psValue of oDBRec        to FlexErrs.Recnum
         
        Send FindWebAppProcs
        Send GridRefresh of oProcList
        Send Focus of oCallServer
    End_Procedure
         
    Object oWebMainPanel is a cWebPanel
        Set piColumnCount to 8
         
        Object oExplanation is a cWebLabel
            Set piColumnSpan to 0
            Set psCaption to ;
                ('This view demonstrates the fact that in a Process' + ;
                 ' Pooled WebApp (which all modern WebApps generally' + ;
                 ' are) you CANNOT rely on the values in global variables,' + ;
                 ' regular properties and database buffers. They change' + ;
                 ' from one server round-trip to the next. ONLY web' + ;
                 ' properties and Data Dictionary values can be relied on.' + ;
                 ' If you run this under the debugger you will see that' + ;
                 ' only a single process is "in the pool" and the values' + ;
                 ' of the things below do not change, which is why you' + ;
                 ' MUST test Web Apps OUTSIDE the debugger.')
        End_Object
                 
        Object oProcPoolGrp is a cWebGroup
            Set piColumnCount to 8
            Set piColumnSpan to 0
            Set psCaption to "Process Pool Information:"
             
            Object oPoolInfo is a cWebGroup
                Set pbShowBorder to False
                Set pbShowCaption to False
                Set piColumnCount to 12
                Set piColumnSpan to 6
                 
                Object oAppName is a cWebForm
                    Set piColumnSpan to 0
                    Set pbReadOnly to True
                    Set peLabelAlign to alignRight
                    Set psLabel to "Web Application:"
                    Set psValue to (psWebAppName(Self))
                End_Object
             
                Object oMinProc is a cWebForm
                    Set piColumnSpan to 5
                    Set pbReadOnly to True
                    Set peLabelAlign to alignRight
                    Set psLabel to "Minimum Pool:"
                End_Object
                 
                Object oMaxProc is a cWebForm
                    Set piColumnSpan to 5
                    Set pbReadOnly to True
                    Set peLabelAlign to alignRight
                    Set psLabel to "Maximum Pool:"
                End_Object
                 
                Object oCurrProcs is a cWebForm
                    Set piColumnSpan to 5
                    Set pbReadOnly to True
                    Set peLabelAlign to alignRight
                    Set psLabel to "Current Pool:"
                End_Object
                
            End_Object
             
            Object oProcList is a cWebList
                Set piColumnIndex to 6
                Set piColumnSpan to 2
                Set pbDataAware to False
                Set pbOfflineEditing to True  // DON'T call the server on RowChange
                // Adjust this to see more/less process numbers without scrolling:
                Set piHeight to 200
 
                Object oProcsCol is a cWebColumn
                    Set psCaption to "Pool Process IDs"
                    Set piWidth to 100
                End_Object
                 
                Procedure OnManualLoadData tWebRow[] ByRef aTheRows String ByRef sCurrentRowID
                    Integer[] aiWebProcs
                    Integer i iLast iThis
                     
                    Get paiWebAppProcs of oProcPoolDemo to aiWebProcs
                    Move (GetCurrentProcessId())        to iThis
                     
                    Move (SizeOfArray(aiWebProcs))      to iLast
                    WebSet psValue of oCurrProcs        to iLast
                    Decrement iLast
                     
                    For i from 0 to iLast
                        Move aiWebProcs[i] to aTheRows[i].sRowID
                        Move aiWebProcs[i] to aTheRows[i].aCells[0].sValue
                         
                        If (aiWebProcs[i] = iThis) Begin
                            Move aiWebProcs[i] to sCurrentRowID
                        End
                         
                    Loop
                     
                    Forward Send OnManualLoadData (&aTheRows) (&sCurrentRowID)
                End_Procedure
                 
            End_Object
             
        End_Object
         
        Object oCurrProcess is a cWebForm
            Set piColumnIndex to 0
            Set piColumnSpan to 4
            Set pbReadOnly to True
            Set psLabel to "Last invoked server process was:"
            Set peLabelAlign to alignRight
            Set piLabelOffset to 250
        End_Object
         
        Object oGlobalVal is a cWebForm
            Set piColumnIndex to 0
            Set piColumnSpan to 4
            Set pbReadOnly to True
            Set psLabel to "Global variable giRandom in that was:"
            Set peLabelAlign to alignRight
            Set piLabelOffset to 250
        End_Object
 
        Object oRegProp is a cWebForm
            Set piColumnIndex to 0
            Set piColumnSpan to 4
            Set pbReadOnly to True
            Set psLabel to "Regular property piRandom in that was:"
            Set peLabelAlign to alignRight
            Set piLabelOffset to 250
        End_Object
 
        Object oDBRec is a cWebForm
            Set piColumnIndex to 0
            Set piColumnSpan to 4
            Set pbReadOnly to True
            Set psLabel to "Flexerrs recnum in that was:"
            Set peLabelAlign to alignRight
            Set piLabelOffset to 250
        End_Object
 
        Object oWebValue is a cWebForm
            Set piColumnIndex to 0
            Set piColumnSpan to 4
            Set psLabel to "Your entered value:"
            Set psValue to "Hello!"
            Set peLabelAlign to alignRight
            Set piLabelOffset to 250
        End_Object
         
        Object oNote is a cWebLabel
            Set psCaption to "(This is a web property - psValue of oWebValue - so will not change unless YOU change it)"
            Set piColumnIndex to 4
            Set piColumnSpan to 4
        End_Object
         
        Object oButtonSpacer is a cWebSpacer
            Set piHeight to 20
        End_Object
         
        Object oCallServer is a cWebButton
            Set piColumnIndex to 0
            Set piColumnSpan to 2
            Set psCaption to "Call Server"
             
            Procedure OnClick
                Send UpdateProcInfo
            End_Procedure
             
        End_Object
                     
        Object oInfo is a cWebButton
            Set piColumnIndex to 2
            Set piColumnSpan to 2
            Set psCaption to "Info Box"
             
            Procedure OnClick
                Integer iProc
                 
                Move (GetCurrentProcessId()) to iProc
                Send ShowInfoBox ("InfoBox in process" * String(iProc))
                Send UpdateProcInfo
            End_Procedure
             
        End_Object
         
        Object oYesNo is a cWebButton
            Set piColumnIndex to 4
            Set piColumnSpan to 2
            Set psCaption to "Yes/No"
             
            // Web Property to hold state between browser/server round-trips
            { WebProperty=Client }
            Property stAllMyState ptState
             
            // Is called in response to user's second answer:
            Procedure ProcessSecondAnswer Integer eAnswer
                stAllMyState tState
                String[]     asInfo
 
                WebGet ptState                              to tState
                Move (GetCurrentProcessId())                to tState.iProc3
                Move (CurrentDateTime())                    to tState.tmAnswered2
                Move (If((eAnswer = cmYes), "Yes", "No"))   to tState.SecondAnswer
                 
                // Assemble results:
                Move ("You clicked the 'Yes/No' button at" * String(tState.tmClicked) * ;
                    "in process" * String(tState.iProc1)) ;
                                                    to asInfo[SizeOfArray(asInfo)]
                Move ("Your first answer was: '" + ;
                    tState.sFirstAswer + "' at" * String(tState.tmAnswered1) * ;
                    "in process" * String(tState.iProc2)) ;
                                                    to asInfo[SizeOfArray(asInfo)]
                Move ("Your second answer was: '" + ;
                    tState.SecondAnswer + "' at" * String(tState.tmAnswered2) * ;
                    "in process" * String(tState.iProc3)) ;
                                                    to asInfo[SizeOfArray(asInfo)]
                 
                Send ShowInfoBox (StrJoinFromArray(asInfo, C_CRLF)) "Results"
                 
                Send UpdateProcInfo
            End_Procedure
            WebPublishProcedure ProcessSecondAnswer  // Publish the proc to receive control after second answer
             
            // Is called in response to user's first answer:
            Procedure ProcessFirstAnswer  Integer eAnswer
                stAllMyState tState
                 
                WebGet ptState to tState
                 
                Move (GetCurrentProcessId())                to tState.iProc2
                Move (CurrentDateTime())                    to tState.tmAnswered1
                Move (If((eAnswer = cmYes), "Yes", "No"))   to tState.sFirstAswer
                WebSet ptState                              to tState
                 
                Send ShowYesNo Self (RefProc(ProcessSecondAnswer)) ;
                    ("Do you REALLY want to do this? (Proc:" * String(tState.iProc2) + ")") ;
                    "Second question"
            End_Procedure
            WebPublishProcedure ProcessFirstAnswer  // Publish the proc to receive control after first answer
             
            // Triggers the question cascade:
            Procedure OnClick
                stAllMyState tState
                 
                Move (CurrentDateTime())        to tState.tmClicked
                Move (GetCurrentProcessId())    to tState.iProc1
                WebSet ptState                  to tState
                 
                Send ShowYesNo Self (RefProc(ProcessFirstAnswer)) ;
                    ("Do you want to do this? (Proc:" * String(tState.iProc1) + ")") ;
                    "First question"
            End_Procedure
             
        End_Object
         
        Object oDialog is a cWebButton
            Set piColumnIndex to 6
            Set piColumnSpan to 2
            Set psCaption to "Popup Dialog"
             
            Procedure OnCloseModalDialog Handle hoModalDialog
                Integer iProc1 iProc2
                 
                If (hoModalDialog = oTestDialog) Begin
                    Get DialogResult of oTestDialog to iProc1
                    Move (GetCurrentProcessId())    to iProc2
                    Send ShowInfoBox ;
                        ("Dialog in process" * String(iProc1) + C_CRLF + ;
                         "Returned to process" * String(iProc2)) "Result"
 
                    Send UpdateProcInfo
                End
                 
            End_Procedure
             
            Procedure OnClick
                Send PopupTheDialog of oTestDialog Self (GetCurrentProcessId())
            End_Procedure
             
        End_Object
         
    End_Object
 
End_Object