Process Pool Demo: Difference between revisions

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 ;

     Returns Integer

#ENDIF

#IFNDEF get_OpenProcess

External_Function OpenProcess "OpenProcess" Kernel32.Dll ;

     Returns Handle

#ENDIF

#IFNDEF get_ProcessHandle

External_Function ProcessHandle "OpenProcess" Kernel32.DLL ;

     Returns Handle

#ENDIF

#IFNDEF get_ProcessImageFileName

External_Function ProcessImageFileName "K32GetProcessImageFileNameA" Kernel32.DLL ;

     Returns DWord

#ENDIF

#IFNDEF _struct_stAllMyState

// Struct to hold state

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

Move (Random(99) + 1) to Flexerrs.Recnum

Find EQ FlexErrs by Recnum

//==============================================================================

// This is a Modal Dialog which will be called from the View,

     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 piLabelOffset to 210

         End_Object

         Object oCaller is a cWebForm

             Set piColumnSpan to 0

             Set piLabelOffset to 210

         End_Object

         Object oGlobal is a cWebForm

             Set piColumnSpan to 0

             Set piLabelOffset to 210

         End_Object

         Object oRegProp is a cWebForm

             Set piColumnSpan to 0

             Set piLabelOffset to 210

         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

     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 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

     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

         Handle hoIni

         String sName

         Get Create (RefClass(cIniFile)) to hoIni

         Set psFileName of hoIni to ;

         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

         UChar[]    ucaFile

         String    sPath sImage

         // Strip off drive designation:

         Move (EnumProcesses(AddressOf(auiProcs), ;

                             uiCb, ;

         // Just for debugging:

         If not iOK ;

         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 (ProcessImageFileName(hProc, ;

                 If (sImage = sPath) ;

                     Move auiProcs[i] to aiWebAppProcs[SizeOfArray(aiWebAppProcs)]     

             End

         Loop

     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 "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

                 ' 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 piColumnCount to 12

                 Set piColumnSpan to 6

                 Object oAppName is a cWebForm

                     Set piColumnSpan to 0

                     Set psValue to (psWebAppName(Self))

                 End_Object

                 Object oMinProc is a cWebForm

                     Set piColumnSpan to 5

                     Set psLabel to "Minimum Pool:"

                 End_Object

                 Object oMaxProc is a cWebForm

                     Set piColumnSpan to 5

                     Set psLabel to "Maximum Pool:"

                 End_Object

                 Object oCurrProcs is a cWebForm

                     Set piColumnSpan to 5

                     Set psLabel to "Current Pool:"

                 End_Object

             End_Object

             Object oProcList is a cWebList

                 Set piColumnIndex to 6

                 // 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

                     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 piLabelOffset to 250

         End_Object

         Object oGlobalVal is a cWebForm

             Set piColumnIndex to 0

             Set piLabelOffset to 250

         End_Object

         Object oRegProp is a cWebForm

             Set piColumnIndex to 0

             Set piLabelOffset to 250

         End_Object

         Object oDBRec is a cWebForm

             Set piColumnIndex to 0

             Set piLabelOffset to 250

         End_Object

         Object oWebValue is a cWebForm

             Set piColumnIndex to 0

             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 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.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) + ")") ;

             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

                         ("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

</source>

[[Category: Web Applications]]