Process Pool Demo
From DataFlex Wiki
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
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
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_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
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
