Process Pool Demo: Difference between revisions

m
Added to category Process Pooling
m (Adding link)
m (Added to category Process Pooling)
 
(8 intermediate revisions by 2 users not shown)
Line 1: Line 1:
In an [https://www.unicorninterglobal.com/company/blog/dataflex-webapp-process-pooling-demo article] on the [https://www.unicorninterglobal.com Unicorn InterGlobal web site] I describe my Process Pooling Demo web view.
In an [https://www.unicorninterglobal.com/company/blog/dataflex-webapp-process-pooling-demo article] on the [https://www.unicorninterglobal.com 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 [[File:ProcPoolDemo.zip|here]].
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.)


<source lang="dataflex">
<source lang="dataflex">
Line 12: Line 14:
Use cWebSpacer.pkg
Use cWebSpacer.pkg
Use cWebList.pkg
Use cWebList.pkg
Use cWebColumn.pkg
Use cWebLabel.pkg
Use cWebLabel.pkg
Use cRegistry.pkg
Use cRegistry.pkg
Use cIniFile.pkg
Use Flexml.pkg
Define PROCESS_VM_READ              for |CI$0010
Define PROCESS_QUERY_INFORMATION    for |CI$0400


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


// Wrap all these in #IFNDEF/#ENDIF blocks to avoid any conflicts
// Wrap all these in #IFNDEF/#ENDIF blocks to avoid any conflicts
// with the same things already defined in the application
// with the same things already defined in the application
 
#IFNDEF get_GetLastError
#IFNDEF get_GetLastError
External_Function GetLastError "GetLastError" Kernal32.DLL Returns DWord
External_Function GetLastError "GetLastError" Kernal32.DLL Returns DWord
#ENDIF
#ENDIF
 
#IFNDEF get_GetCurrentProcessId
#IFNDEF get_GetCurrentProcessId
External_Function GetCurrentProcessId "GetCurrentProcessId" Kernel32.Dll Returns Integer
External_Function GetCurrentProcessId "GetCurrentProcessId" Kernel32.Dll Returns Integer
#ENDIF
#ENDIF
 
#IFNDEF get_EnumProcesses
#IFNDEF get_EnumProcesses
External_Function EnumProcesses "K32EnumProcesses" Kernel32.DLL ;
External_Function EnumProcesses "K32EnumProcesses" Kernel32.DLL ;
Line 37: Line 42:
     Returns Integer
     Returns Integer
#ENDIF
#ENDIF
 
 
#IFNDEF get_OpenProcess
#IFNDEF get_OpenProcess
External_Function OpenProcess "OpenProcess" Kernel32.Dll ;
External_Function OpenProcess "OpenProcess" Kernel32.Dll ;
Line 45: Line 50:
     Returns Handle
     Returns Handle
#ENDIF
#ENDIF
 
#IFNDEF get_ProcessHandle
#IFNDEF get_ProcessHandle
External_Function ProcessHandle "OpenProcess" Kernel32.DLL ;
External_Function ProcessHandle "OpenProcess" Kernel32.DLL ;
Line 53: Line 58:
     Returns Handle
     Returns Handle
#ENDIF
#ENDIF
   
   
#IFNDEF get_ProcessImageFileName
#IFNDEF get_ProcessImageFileName
External_Function ProcessImageFileName "K32GetProcessImageFileNameA" Kernel32.DLL ;
External_Function ProcessImageFileName "K32GetProcessImageFileNameA" Kernel32.DLL ;
Line 61: Line 66:
     Returns DWord
     Returns DWord
#ENDIF
#ENDIF
 
#IFNDEF _struct_stAllMyState
#IFNDEF _struct_stAllMyState
// Struct to hold state
// Struct to hold state
Line 75: Line 80:
End_Struct
End_Struct
#ENDIF
#ENDIF
 
#IFNDEF C_CRLF
#IFNDEF C_CRLF
// Just for formatting the result of the Yes/No cascade in this case:
// Just for formatting the result of the Yes/No cascade in this case:
Define C_CRLF for (Character(13) + Character(10))
Define C_CRLF for (Character(13) + Character(10))
#ENDIF
#ENDIF
 
// The following items will (almost always) have different values in
// The following items will (almost always) have different values in
// different processes in the WebApp process pool, but will remain static
// different processes in the WebApp process pool, but will remain static
// in any given process.
// in any given process.
 
Global_Variable Integer giRandom
Global_Variable Integer giRandom
Move (Random(10000)) to giRandom
Move (Random(10000)) to giRandom
 
// This will be a property of oWabApp:
// This will be a property of oWabApp:
Property Integer piRandom (Random(10000) + 10000)
Property Integer piRandom (Random(10000) + 10000)
 
// Will be opened in the WebApp
// Will be opened in the WebApp
Open Flexerrs
Open Flexerrs
Line 96: Line 101:
Move (Random(99) + 1) to Flexerrs.Recnum
Move (Random(99) + 1) to Flexerrs.Recnum
Find EQ FlexErrs by Recnum
Find EQ FlexErrs by Recnum
 
//==============================================================================
//==============================================================================
// This is a Modal Dialog which will be called from the View,
// This is a Modal Dialog which will be called from the View,
Line 108: Line 113:
     Set pbShowClose to False        // is to click "OK"
     Set pbShowClose to False        // is to click "OK"
     Set pbServerOnSubmit to True    // enable the OnSubmit event
     Set pbServerOnSubmit to True    // enable the OnSubmit event
   
   
     Object oMainPanel is a cWebPanel
     Object oMainPanel is a cWebPanel
         Set piColumnCount to 12
         Set piColumnCount to 12
       
       
         Object oProcess is a cWebForm
         Object oProcess is a cWebForm
             Set piColumnSpan to 0
             Set piColumnSpan to 0
Line 119: Line 124:
             Set piLabelOffset to 210
             Set piLabelOffset to 210
         End_Object
         End_Object
       
       
         Object oCaller is a cWebForm
         Object oCaller is a cWebForm
             Set piColumnSpan to 0
             Set piColumnSpan to 0
Line 127: Line 132:
             Set piLabelOffset to 210
             Set piLabelOffset to 210
         End_Object
         End_Object
       
       
         Object oGlobal is a cWebForm
         Object oGlobal is a cWebForm
             Set piColumnSpan to 0
             Set piColumnSpan to 0
Line 135: Line 140:
             Set piLabelOffset to 210
             Set piLabelOffset to 210
         End_Object
         End_Object
               
               
         Object oRegProp is a cWebForm
         Object oRegProp is a cWebForm
             Set piColumnSpan to 0
             Set piColumnSpan to 0
Line 143: Line 148:
             Set piLabelOffset to 210
             Set piLabelOffset to 210
         End_Object
         End_Object
               
               
     End_Object  
     End_Object
   
   
     Object oBottomPanel is a cWebPanel
     Object oBottomPanel is a cWebPanel
         Set piColumnCount to 4
         Set piColumnCount to 4
         Set peRegion to prBottom
         Set peRegion to prBottom
 
         Object oOkButton is a cWebButton
         Object oOkButton is a cWebButton
             Set psCaption to C_$OK
             Set psCaption to C_$OK
             Set piColumnSpan to 1
             Set piColumnSpan to 1
             Set piColumnIndex to 3
             Set piColumnIndex to 3
 
             Procedure OnClick
             Procedure OnClick
                 Send Ok
                 Send Ok
             End_Procedure
             End_Procedure
           
           
         End_Object  
         End_Object
 
     End_Object  
     End_Object
 
     Procedure OnSubmit
     Procedure OnSubmit
         Send Ok
         Send Ok
     End_Procedure
     End_Procedure
   
   
     Procedure PopupTheDialog  Handle hReturnObj Integer iCaller
     Procedure PopupTheDialog  Handle hReturnObj Integer iCaller
         Send Popup hReturnObj
         Send Popup hReturnObj
       
       
         WebSet psValue of oProcess to (GetCurrentProcessId())
         WebSet psValue of oProcess to (GetCurrentProcessId())
         WebSet psValue of oCaller  to iCaller
         WebSet psValue of oCaller  to iCaller
Line 175: Line 180:
         WebSet psValue of oRegProp to (piRandom(Self))
         WebSet psValue of oRegProp to (piRandom(Self))
     End_Procedure
     End_Procedure
 
     Function DialogResult Returns String
     Function DialogResult Returns String
         String sResult
         String sResult
       
       
         WebGet psValue of oProcess to sResult
         WebGet psValue of oProcess to sResult
         Function_Return sResult
         Function_Return sResult
     End_Function
     End_Function
 
End_Object
End_Object
 
//==============================================================================
//==============================================================================
// This is the actual view
// This is the actual view
Line 192: Line 197:
     Set psCaption to "Process Pooling Effects Demo"
     Set psCaption to "Process Pooling Effects Demo"
     Set pbServerOnShow to True
     Set pbServerOnShow to True
   
   
    { WebProperty=Client }
     Property Integer[] paiWebAppProcs
     Property Integer[] paiWebAppProcs
 
     // Display this view at start up:
     // Display this view at start up:
     Delegate Set phoDefaultView to Self
     Delegate Set phoDefaultView to Self
   
   
     // Work out the web application name from the WebServiceDispatcher.wo
     // Work out the web application name from the web.config
     // file in AppHTML, which we treat like a .ini file
     // file in AppHTML, which we read into an XML object
     Function WebAppName Returns String
     Function WebAppName Returns String
         Handle hoIni
         Handle hoXml hoElem
         String sName
         String sName
          
         Boolean bOK
         Get Create (RefClass(cIniFile)) to hoIni
       
         Set psFileName of hoIni to ;
         Get Create (RefClass(cXMLDOMDocument)) to hoXml
             (psAppHtmlPath(phoWorkspace(ghoApplication)) + ;
         Set psDocumentName of hoXml to ;
            "\WebServiceDispatcher.wso")
             (psAppHtmlPath(phoWorkspace(ghoApplication)) + "\web.config")
         Get ReadString of hoIni "WebService" "Application" "" to sName
         Get LoadXMLDocument of hoXml to bOK
         Send Destroy of hoIni
        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
         Function_Return sName
     End_Function
     End_Function
   
   
     // Will be set to return value of above function at start-up.
     // Will be set to return value of above function at start-up.
     // This is a regular property because the web app name can't
     // This is a regular property because the web app name can't
Line 232: Line 239:
     // Finally it calls ProcessImageFileName to see if that is one of the
     // Finally it calls ProcessImageFileName to see if that is one of the
     // processes running for THIS WebApp. However ProcessImageFileName
     // processes running for THIS WebApp. However ProcessImageFileName
     // returns a file-path statring with the disk identifer in the slightly
     // returns a file-path starting with the disk identifer in a slightly odd
     // odd form "\DEVICE\HARDDISKVOLUMEn" (n is "1" for my C: drive), so we
     // form, i.e. "\DEVICE\HARDDISKVOLUMEn" (n is "1" for my C: drive) and even
     // strip that off and also strip off the "C:\", or whatever, from the
     // spookier things for mapped drives, so we strip off the "C:\", or whatever,
     // application file name DataFlex returns and uppercase both before
     // from the application file name DataFlex returns and uppercase both, then
     // comparing them.
    // 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,
     // Note: that although the docs (and the declarations) use DWords,
     //      on Vincent's advice we are using UIntegers in our code (the same
     //      on Vincent's advice we are using UIntegers in our code (the same
     //      thing in reality) because you can use SizeOfType(UInteger) in the
     //      thing in reality) because you can use SizeOfType(UInteger) in the
     //      watches window when debugging which you can't for DWord.
     //      Watches window when debugging, which you can't for DWord.
     Procedure FindWebAppProcs
     Procedure FindWebAppProcs
         Integer[]  aiWebAppProcs  
         Integer[]  aiWebAppProcs  
         UInteger[] auiProcs
         UInteger[] auiProcs
         UInteger  uiCb uiNeeded uiSize uiErr
         UInteger  uiCb uiNeeded uiSize uiErr
         Integer    iOK i iLast iPos iSize
         Integer    iOK i iLast iPos iSize iPathLen
         Handle    hProc
         Handle    hProc
         UChar[]    ucaFile
         UChar[]    ucaFile
         String    sPath sImage
         String    sPath sImage
       
       
         Move (Uppercase(GetApplicationFileName(ghoApplication)))   to sPath
         Move (Uppercase(GetApplicationFileName(ghoApplication))) to sPath
         // Strip off drive designation:
         // Strip off drive designation:
         Move (Pos("\", sPath))                                     to iPos
         Move (Pos("\", sPath))                                 to iPos
         Move (Right(sPath, (Length(sPath) - iPos)))                 to sPath
         Move (Right(sPath, (Length(sPath) - iPos)))             to sPath
         Move 4096                                                   to iSize
        Move (Length(sPath))                                    to iPathLen
 
         Move 4096                                               to iSize
         Move (ResizeArray(auiProcs, iSize))                         to auiProcs
         Move (iSize * SizeOfType(UInteger))                         to uiCb
         Move (ResizeArray(auiProcs, iSize))                     to auiProcs
         Move 0                                                     to uiNeeded
         Move (iSize * SizeOfType(UInteger))                     to uiCb
 
         Move 0                                                 to uiNeeded
         Move (EnumProcesses(AddressOf(auiProcs), ;
         Move (EnumProcesses(AddressOf(auiProcs), ;
                             uiCb, ;
                             uiCb, ;
                             AddressOf(uiNeeded)))                   to iOK
                             AddressOf(uiNeeded)))               to iOK
       
       
         // Just for debugging:
         // Just for debugging:
         If not iOK ;
         If not iOK ;
             Move (GetLastError())                                   to uiErr
             Move (GetLastError())                               to uiErr
       
       
         Move (uiNeeded / SizeOfType(UInteger))                     to iSize
         Move (uiNeeded / SizeOfType(UInteger))                 to iSize
         Move (ResizeArray(auiProcs, iSize))                         to auiProcs
         Move (ResizeArray(auiProcs, iSize))                     to auiProcs
         Decrement iSize
         Decrement iSize
       
       
         For i from 0 to iSize
         For i from 0 to iSize
             Move (OpenProcess(PROCESS_VM_READ + PROCESS_QUERY_INFORMATION, ;
             Move (OpenProcess(PROCESS_VM_READ + PROCESS_QUERY_INFORMATION, ;
                                                     True, auiProcs[i])) to hProc
                                                     True, auiProcs[i])) to hProc
           
           
             If (hProc <> 0) Begin  // We DID get a handle to the process
             If (hProc <> 0) Begin  // We DID get a handle to the process
                 Move (ResizeArray(ucaFile, 0))                         to ucaFile
                 Move (ResizeArray(ucaFile, 0))                 to ucaFile
                 Move (ResizeArray(ucaFile, 2048))                       to ucaFile
                 Move (ResizeArray(ucaFile, 2048))               to ucaFile
                 Move (ProcessImageFileName(hProc, ;
                 Move (ProcessImageFileName(hProc, ;
                       AddressOf(ucaFile), 2048))                       to uiSize
                       AddressOf(ucaFile), 2048))               to uiSize
                 Move (ResizeArray(ucaFile, uiSize))                     to ucaFile
                 Move (ResizeArray(ucaFile, uiSize))             to ucaFile
                 Move (Uppercase(UCharArrayToString(ucaFile)))           to sImage
                 Move (Uppercase(UCharArrayToString(ucaFile)))   to sImage
                Move (Replace("\DEVICE\HARDDISKVOLUME", sImage, ""))    to sImage
                 Move (Right(sImage, iPathLen))                 to sImage
                Move (Pos("\", sImage))                                to iPos
               
                 Move (Right(sImage, (Length(sImage) - iPos)))          to sImage
               
                 If (sImage = sPath) ;
                 If (sImage = sPath) ;
                     Move auiProcs[i] to aiWebAppProcs[SizeOfArray(aiWebAppProcs)]     
                     Move auiProcs[i] to aiWebAppProcs[SizeOfArray(aiWebAppProcs)]     
             End
             End
           
           
         Loop
         Loop
       
       
         WebSet paiWebAppProcs to aiWebAppProcs
         Set paiWebAppProcs to aiWebAppProcs
     End_Procedure
     End_Procedure
   
   
     Procedure OnShow
     Procedure OnShow
         Send UpdateProcInfo
         Send UpdateProcInfo
     End_Procedure
     End_Procedure
   
   
     // Registry object for getting the WebApp info from the registry:
     // Registry object for getting the WebApp info from the registry:
     Object oReg is a cRegistry
     Object oReg is a cRegistry
         Set phRootKey to HKEY_LOCAL_MACHINE
         Set phRootKey to HKEY_LOCAL_MACHINE
         Set pfAccessRights to Key_Read
         Set pfAccessRights to (KEY_WOW64_64KEY ior KEY_READ)
          
          
         Function BaseKey Returns String
         Function BaseKey Returns String
Line 315: Line 323:
             Move "WebApp Server"            to asParts[4]
             Move "WebApp Server"            to asParts[4]
             Move "Web Applications"        to asParts[5]
             Move "Web Applications"        to asParts[5]
           
           
             // If it is a 64-bit machine:
             // If it is a 64-bit machine and running on a DF version PRIOR to 20
             If (KeyExists(Self, "SOFTWARE\Wow6432Node")) ;
            // Insert "Wow6432Node just after "SOFTWARE":
             If (KeyExists(Self, "SOFTWARE\Wow6432Node") and ;
                (Number(C_DFVersion) < 20)) ;
                 Move (InsertInArray(asParts, 1, "Wow6432Node")) to asParts
                 Move (InsertInArray(asParts, 1, "Wow6432Node")) to asParts
           
           
             Function_Return (StrJoinFromArray(asParts, "\"))
             Function_Return (StrJoinFromArray(asParts, "\"))
         End_Function
         End_Function
       
       
         Function DWKeyValue String sApp String sVal Returns Integer
         Function DWKeyValue String sApp String sVal Returns Integer
             Boolean bOK
             Boolean bOK
             Integer iVal
             Integer iVal
             String  sKey
             String  sKey
            Move (BaseKey(Self) + "\" + sApp)  to sKey
              
              
            Move (BaseKey(Self) + "\" + sApp)  to sKey
             Get KeyExists sKey                  to bOK
             Get KeyExists sKey                  to bOK
   
             If not bOK ;
             If not bOK ;
                 Function_Return 0
                 Function_Return 0
           
           
             Get OpenKey sKey to bOK
             Get OpenKey sKey to bOK
           
             If not bOK ;
             If not bOK ;
                 Function_Return 0
                 Function_Return 0
               
           
             Move (ReadDWord(Self, sVal)) to iVal
             Move (ReadDWord(Self, sVal)) to iVal
             Send CloseKey
             Send CloseKey
           
           
             Function_Return iVal
             Function_Return iVal
         End_Function
         End_Function
       
       
     End_Object
     End_Object
   
   
     // Refresh all the displayed information
     // Refresh all the displayed information
     Procedure UpdateProcInfo
     Procedure UpdateProcInfo
         String  sApp
         String  sApp
         Integer iMin iMax
         Integer iMin iMax
       
       
         Get psWebAppName                to sApp
         Get psWebAppName                to sApp
         WebSet psValue of oMinProc      to (DWKeyValue(oReg(Self), sApp, "MinPool"))
         WebSet psValue of oMinProc      to (DWKeyValue(oReg(Self), sApp, "MinPool"))
         WebSet psValue of oMaxProc      to (DWKeyValue(oReg(Self), sApp, "MaxPool"))
         WebSet psValue of oMaxProc      to (DWKeyValue(oReg(Self), sApp, "MaxPool"))
         WebSet psValue of oCurrProcs    to "Unknown"
         WebSet psValue of oCurrProcs    to "Unknown"
       
       
         WebSet psValue of oCurrProcess  to (GetCurrentProcessId())
         WebSet psValue of oCurrProcess  to (GetCurrentProcessId())
         WebSet psValue of oGlobalVal    to giRandom
         WebSet psValue of oGlobalVal    to giRandom
         WebSet psValue of oRegProp      to (piRandom(Self))
         WebSet psValue of oRegProp      to (piRandom(Self))
         WebSet psValue of oDBRec        to FlexErrs.Recnum
         WebSet psValue of oDBRec        to FlexErrs.Recnum
       
       
         Send FindWebAppProcs
         Send FindWebAppProcs
         Send GridRefresh of oProcList
         Send GridRefresh of oProcList
         Send Focus of oCallServer
         Send Focus of oCallServer
     End_Procedure
     End_Procedure
       
       
     Object oWebMainPanel is a cWebPanel
     Object oWebMainPanel is a cWebPanel
         Set piColumnCount to 8
         Set piColumnCount to 8
       
       
         Object oExplanation is a cWebLabel
         Object oExplanation is a cWebLabel
             Set piColumnSpan to 0
             Set piColumnSpan to 0
Line 384: Line 393:
                 ' MUST test Web Apps OUTSIDE the debugger.')
                 ' MUST test Web Apps OUTSIDE the debugger.')
         End_Object
         End_Object
               
               
         Object oProcPoolGrp is a cWebGroup
         Object oProcPoolGrp is a cWebGroup
             Set piColumnCount to 8
             Set piColumnCount to 8
             Set piColumnSpan to 0
             Set piColumnSpan to 0
             Set psCaption to "Process Pool Information:"
             Set psCaption to "Process Pool Information:"
           
           
             Object oPoolInfo is a cWebGroup
             Object oPoolInfo is a cWebGroup
                 Set pbShowBorder to False
                 Set pbShowBorder to False
Line 395: Line 404:
                 Set piColumnCount to 12
                 Set piColumnCount to 12
                 Set piColumnSpan to 6
                 Set piColumnSpan to 6
               
               
                 Object oAppName is a cWebForm
                 Object oAppName is a cWebForm
                     Set piColumnSpan to 0
                     Set piColumnSpan to 0
Line 403: Line 412:
                     Set psValue to (psWebAppName(Self))
                     Set psValue to (psWebAppName(Self))
                 End_Object
                 End_Object
           
           
                 Object oMinProc is a cWebForm
                 Object oMinProc is a cWebForm
                     Set piColumnSpan to 5
                     Set piColumnSpan to 5
Line 410: Line 419:
                     Set psLabel to "Minimum Pool:"
                     Set psLabel to "Minimum Pool:"
                 End_Object
                 End_Object
               
               
                 Object oMaxProc is a cWebForm
                 Object oMaxProc is a cWebForm
                     Set piColumnSpan to 5
                     Set piColumnSpan to 5
Line 417: Line 426:
                     Set psLabel to "Maximum Pool:"
                     Set psLabel to "Maximum Pool:"
                 End_Object
                 End_Object
               
               
                 Object oCurrProcs is a cWebForm
                 Object oCurrProcs is a cWebForm
                     Set piColumnSpan to 5
                     Set piColumnSpan to 5
Line 426: Line 435:
                  
                  
             End_Object
             End_Object
           
           
             Object oProcList is a cWebList
             Object oProcList is a cWebList
                 Set piColumnIndex to 6
                 Set piColumnIndex to 6
Line 434: Line 443:
                 // Adjust this to see more/less process numbers without scrolling:
                 // Adjust this to see more/less process numbers without scrolling:
                 Set piHeight to 200
                 Set piHeight to 200
 
                 Object oProcsCol is a cWebColumn
                 Object oProcsCol is a cWebColumn
                     Set psCaption to "Pool Process IDs"
                     Set psCaption to "Pool Process IDs"
                     Set piWidth to 100
                     Set piWidth to 100
                 End_Object
                 End_Object
               
               
                 Procedure OnManualLoadData tWebRow[] ByRef aTheRows String ByRef sCurrentRowID
                 Procedure OnManualLoadData tWebRow[] ByRef aTheRows String ByRef sCurrentRowID
                     Integer[] aiWebProcs
                     Integer[] aiWebProcs
                     Integer i iLast iThis
                     Integer i iLast iThis
                   
                   
                     WebGet paiWebAppProcs of oProcPoolDemo to aiWebProcs
                     Get paiWebAppProcs of oProcPoolDemo to aiWebProcs
                     Move (GetCurrentProcessId())           to iThis
                     Move (GetCurrentProcessId())       to iThis
                   
                   
                     Move (SizeOfArray(aiWebProcs))         to iLast
                     Move (SizeOfArray(aiWebProcs))     to iLast
                     WebSet psValue of oCurrProcs           to iLast
                     WebSet psValue of oCurrProcs       to iLast
                     Decrement iLast
                     Decrement iLast
                   
                   
                     For i from 0 to iLast
                     For i from 0 to iLast
                         Move aiWebProcs[i] to aTheRows[i].sRowID
                         Move aiWebProcs[i] to aTheRows[i].sRowID
                         Move aiWebProcs[i] to aTheRows[i].aCells[0].sValue
                         Move aiWebProcs[i] to aTheRows[i].aCells[0].sValue
                       
                       
                         If (aiWebProcs[i] = iThis) Begin
                         If (aiWebProcs[i] = iThis) Begin
                             Move aiWebProcs[i] to sCurrentRowID
                             Move aiWebProcs[i] to sCurrentRowID
                         End
                         End
                       
                       
                     Loop
                     Loop
                   
                   
                     Forward Send OnManualLoadData (&aTheRows) (&sCurrentRowID)
                     Forward Send OnManualLoadData (&aTheRows) (&sCurrentRowID)
                 End_Procedure
                 End_Procedure
               
               
             End_Object
             End_Object
           
           
         End_Object
         End_Object
       
       
         Object oCurrProcess is a cWebForm
         Object oCurrProcess is a cWebForm
             Set piColumnIndex to 0
             Set piColumnIndex to 0
Line 476: Line 485:
             Set piLabelOffset to 250
             Set piLabelOffset to 250
         End_Object
         End_Object
       
       
         Object oGlobalVal is a cWebForm
         Object oGlobalVal is a cWebForm
             Set piColumnIndex to 0
             Set piColumnIndex to 0
Line 485: Line 494:
             Set piLabelOffset to 250
             Set piLabelOffset to 250
         End_Object
         End_Object
 
         Object oRegProp is a cWebForm
         Object oRegProp is a cWebForm
             Set piColumnIndex to 0
             Set piColumnIndex to 0
Line 494: Line 503:
             Set piLabelOffset to 250
             Set piLabelOffset to 250
         End_Object
         End_Object
 
         Object oDBRec is a cWebForm
         Object oDBRec is a cWebForm
             Set piColumnIndex to 0
             Set piColumnIndex to 0
Line 503: Line 512:
             Set piLabelOffset to 250
             Set piLabelOffset to 250
         End_Object
         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
         Object oButtonSpacer is a cWebSpacer
             Set piHeight to 20
             Set piHeight to 20
         End_Object
         End_Object
       
       
         Object oCallServer is a cWebButton
         Object oCallServer is a cWebButton
             Set piColumnIndex to 0
             Set piColumnIndex to 0
             Set piColumnSpan to 2
             Set piColumnSpan to 2
             Set psCaption to "Call Server"
             Set psCaption to "Call Server"
           
           
             Procedure OnClick
             Procedure OnClick
                 Send UpdateProcInfo
                 Send UpdateProcInfo
             End_Procedure
             End_Procedure
           
           
         End_Object
         End_Object
                   
                   
         Object oInfo is a cWebButton
         Object oInfo is a cWebButton
             Set piColumnIndex to 2
             Set piColumnIndex to 2
             Set piColumnSpan to 2
             Set piColumnSpan to 2
             Set psCaption to "Info Box"
             Set psCaption to "Info Box"
           
           
             Procedure OnClick
             Procedure OnClick
                 Integer iProc
                 Integer iProc
               
               
                 Move (GetCurrentProcessId()) to iProc
                 Move (GetCurrentProcessId()) to iProc
                 Send ShowInfoBox ("InfoBox in process" * String(iProc))
                 Send ShowInfoBox ("InfoBox in process" * String(iProc))
                 Send UpdateProcInfo
                 Send UpdateProcInfo
             End_Procedure
             End_Procedure
           
           
         End_Object
         End_Object
       
       
         Object oYesNo is a cWebButton
         Object oYesNo is a cWebButton
             Set piColumnIndex to 4
             Set piColumnIndex to 4
             Set piColumnSpan to 2
             Set piColumnSpan to 2
             Set psCaption to "Yes/No"
             Set psCaption to "Yes/No"
           
           
             // Web Property to hold state between browser/server round-trips
             // Web Property to hold state between browser/server round-trips
             { WebProperty=Client }
             { WebProperty=Client }
             Property stAllMyState ptState
             Property stAllMyState ptState
           
           
             // Is called in response to user's second answer:
             // Is called in response to user's second answer:
             Procedure ProcessSecondAnswer Integer eAnswer
             Procedure ProcessSecondAnswer Integer eAnswer
                 stAllMyState tState
                 stAllMyState tState
                 String[]    asInfo
                 String[]    asInfo
 
                 WebGet ptState                              to tState
                 WebGet ptState                              to tState
                 Move (GetCurrentProcessId())                to tState.iProc3
                 Move (GetCurrentProcessId())                to tState.iProc3
                 Move (CurrentDateTime())                    to tState.tmAnswered2
                 Move (CurrentDateTime())                    to tState.tmAnswered2
                 Move (If((eAnswer = cmYes), "Yes", "No"))  to tState.SecondAnswer
                 Move (If((eAnswer = cmYes), "Yes", "No"))  to tState.SecondAnswer
               
               
                 // Assemble results:
                 // Assemble results:
                 Move ("You clicked the 'Yes/No' button at" * String(tState.tmClicked) * ;
                 Move ("You clicked the 'Yes/No' button at" * String(tState.tmClicked) * ;
Line 565: Line 589:
                     "in process" * String(tState.iProc3)) ;
                     "in process" * String(tState.iProc3)) ;
                                                     to asInfo[SizeOfArray(asInfo)]
                                                     to asInfo[SizeOfArray(asInfo)]
               
               
                 Send ShowInfoBox (StrJoinFromArray(asInfo, C_CRLF)) "Results"
                 Send ShowInfoBox (StrJoinFromArray(asInfo, C_CRLF)) "Results"
               
               
                 Send UpdateProcInfo
                 Send UpdateProcInfo
             End_Procedure
             End_Procedure
             WebPublishProcedure ProcessSecondAnswer  // Publish the proc to receive control after second answer
             WebPublishProcedure ProcessSecondAnswer  // Publish the proc to receive control after second answer
           
           
             // Is called in response to user's first answer:
             // Is called in response to user's first answer:
             Procedure ProcessFirstAnswer  Integer eAnswer
             Procedure ProcessFirstAnswer  Integer eAnswer
                 stAllMyState tState
                 stAllMyState tState
               
               
                 WebGet ptState to tState
                 WebGet ptState to tState
               
               
                 Move (GetCurrentProcessId())                to tState.iProc2
                 Move (GetCurrentProcessId())                to tState.iProc2
                 Move (CurrentDateTime())                    to tState.tmAnswered1
                 Move (CurrentDateTime())                    to tState.tmAnswered1
                 Move (If((eAnswer = cmYes), "Yes", "No"))  to tState.sFirstAswer
                 Move (If((eAnswer = cmYes), "Yes", "No"))  to tState.sFirstAswer
                 WebSet ptState                              to tState
                 WebSet ptState                              to tState
               
               
                 Send ShowYesNo Self (RefProc(ProcessSecondAnswer)) ;
                 Send ShowYesNo Self (RefProc(ProcessSecondAnswer)) ;
                     ("Do you REALLY want to do this? (Proc:" * String(tState.iProc2) + ")") ;
                     ("Do you REALLY want to do this? (Proc:" * String(tState.iProc2) + ")") ;
Line 588: Line 612:
             End_Procedure
             End_Procedure
             WebPublishProcedure ProcessFirstAnswer  // Publish the proc to receive control after first answer
             WebPublishProcedure ProcessFirstAnswer  // Publish the proc to receive control after first answer
           
           
             // Triggers the question cascade:
             // Triggers the question cascade:
             Procedure OnClick
             Procedure OnClick
                 stAllMyState tState
                 stAllMyState tState
               
               
                 Move (CurrentDateTime())        to tState.tmClicked
                 Move (CurrentDateTime())        to tState.tmClicked
                 Move (GetCurrentProcessId())    to tState.iProc1
                 Move (GetCurrentProcessId())    to tState.iProc1
                 WebSet ptState                  to tState
                 WebSet ptState                  to tState
               
               
                 Send ShowYesNo Self (RefProc(ProcessFirstAnswer)) ;
                 Send ShowYesNo Self (RefProc(ProcessFirstAnswer)) ;
                     ("Do you want to do this? (Proc:" * String(tState.iProc1) + ")") ;
                     ("Do you want to do this? (Proc:" * String(tState.iProc1) + ")") ;
                     "First question"
                     "First question"
             End_Procedure
             End_Procedure
           
           
         End_Object
         End_Object
       
       
         Object oDialog is a cWebButton
         Object oDialog is a cWebButton
             Set piColumnIndex to 6
             Set piColumnIndex to 6
             Set piColumnSpan to 2
             Set piColumnSpan to 2
             Set psCaption to "Popup Dialog"
             Set psCaption to "Popup Dialog"
           
           
             Procedure OnCloseModalDialog Handle hoModalDialog
             Procedure OnCloseModalDialog Handle hoModalDialog
                 Integer iProc1 iProc2
                 Integer iProc1 iProc2
               
               
                 If (hoModalDialog = oTestDialog) Begin
                 If (hoModalDialog = oTestDialog) Begin
                     Get DialogResult of oTestDialog to iProc1
                     Get DialogResult of oTestDialog to iProc1
Line 618: Line 642:
                         ("Dialog in process" * String(iProc1) + C_CRLF + ;
                         ("Dialog in process" * String(iProc1) + C_CRLF + ;
                         "Returned to process" * String(iProc2)) "Result"
                         "Returned to process" * String(iProc2)) "Result"
 
                     Send UpdateProcInfo
                     Send UpdateProcInfo
                 End
                 End
               
               
             End_Procedure
             End_Procedure
           
           
             Procedure OnClick
             Procedure OnClick
                 Send PopupTheDialog of oTestDialog Self (GetCurrentProcessId())
                 Send PopupTheDialog of oTestDialog Self (GetCurrentProcessId())
             End_Procedure
             End_Procedure
           
           
         End_Object
         End_Object
       
       
     End_Object  
     End_Object
 
End_Object
End_Object
</source>
</source>
[[Category: Process Pooling]]
[[Category: Web Applications]]