The following procedure scans the current session for running instances of PERSISTENT procedures and reports on how many copies of each are running. This code may be used to ensure that no duplicate copies of PERSISTENT procedures are running in this session:
FUNCTION getFrequency RETURNS INTEGER
( INPUT pcString AS CHARACTER,
INPUT pcList AS CHARACTER,
INPUT plCaseSensitive AS LOGICAL):
IF LENGTH(pcString) > 1 THEN
ASSIGN
pcString = REPLACE (pcString , pcString ,CHR(2) )
pcList = REPLACE ( pcList , pcString ,CHR(2) ).
IF NOT plCaseSensitive THEN
ASSIGN
pcString = CAPS(pcString)
pcList = CAPS(pcList).
IF NUM-ENTRIES(pcList, pcString) > 0 THEN
RETURN NUM-ENTRIES(pcList, pcString) - 1.
ELSE
RETURN 0.
END FUNCTION.
/* Report how many copies of each PERSISTENT procedure is running*/
DEFINE VARIABLE hProc AS HANDLE NO-UNDO.
DEFINE VARIABLE cList AS CHARACTER NO-UNDO.
DEFINE VARIABLE iCounter AS INTEGER NO-UNDO.
DEFINE VARIABLE cDelimiter AS CHARACTER NO-UNDO.
DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
ASSIGN
hProc = SESSION:FIRST-PROCEDURE
cList = hProc:FILE-NAME
cDelimiter = CHR(1) NO-ERROR.
DO WHILE VALID-HANDLE(hProc):
IF hProc = SESSION:FIRST-PROCEDURE THEN hProc = hProc:NEXT-SIBLING.
ASSIGN
cList = cList + cDelimiter + hProc:FILE-NAME
hProc = hProc:NEXT-SIBLING.
END.
IF NUM-ENTRIES(clist, cDelimiter) <> 0 THEN
DO iCounter = 1 TO NUM-ENTRIES(clist, cDelimiter):
cString = ENTRY(iCounter, cList, cDelimiter).
MESSAGE
"Procedure No.:" "~t" iCounter "~n"
"Procedure:" "~t" cString "~n"
"List:" "~t~t" cList "~n"
"Frequency:" "~t" getFrequency(cString, cList, FALSE)
VIEW-AS ALERT-BOX INFO BUTTONS OK.
END.
ELSE
MESSAGE "There are no currently running PERSISTENT procedures in this session"
VIEW-AS ALERT-BOX INFO BUTTONS OK.
