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.

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 cWebLabel.pkg
Use cRegistry.pkg
Use cIniFile.pkg

Define PROCESS_VM_READ           for |CI$0010
Define PROCESS_QUERY_INFORMATION for |CI$0400

// 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
    
    { WebProperty=Client }
    Property Integer[] paiWebAppProcs
 
    // Display this view at start up:
    Delegate Set phoDefaultView to Self
    
    // Work out the web application name from the WebServiceDispatcher.wo
    // file in AppHTML, which we treat like a .ini file
    Function WebAppName Returns String
        Handle hoIni
        String sName
        
        Get Create (RefClass(cIniFile)) to hoIni
        Set psFileName of hoIni to ;
            (psAppHtmlPath(phoWorkspace(ghoApplication)) + ;
            "\WebServiceDispatcher.wso")
        Get ReadString of hoIni "WebService" "Application" "" to sName
        Send Destroy of hoIni
        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
        
        WebSet 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_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:
            If (KeyExists(Self, "SOFTWARE\Wow6432Node")) ;
                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
                    
                    WebGet 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