Run the following piece of code to collect the information; attached as generateEnvReport.p.
The code generates 'I18N-Rep.txt' file in the current directory.
/* sample code to get session startup options and environment,*/
/* font info and OS codepage (on Windows)*/
DEFINE VARIABLE cOutputFile AS CHARACTER NO-UNDO INIT 'I18N-Rep.txt'.
DEFINE VARIABLE cDefaultFixedFont AS CHARACTER NO-UNDO FORMAT "X(35)".
DEFINE VARIABLE cDefaultFont AS CHARACTER NO-UNDO FORMAT "X(35)".
DEFINE VARIABLE cDefaultV6UpdFont AS CHARACTER NO-UNDO FORMAT "X(35)".
DEFINE VARIABLE cRegValue AS CHARACTER NO-UNDO FORMAT "X(35)".
DEFINE TEMP-TABLE TTSession
FIELD cAttrName AS CHARACTER
FIELD cAttrValue AS CHARACTER.
FUNCTION GetComputerName RETURNS CHARACTER
() FORWARD.
/* generate the report */
OUTPUT TO VALUE(cOutputFile).
PUT UNFORM "Date: " TODAY " Time: " STRING(TIME,"HH:MM:SS") SKIP "Operating System: " OPSYS SKIP.
IF OPSYS = "WIN32" THEN
PUT UNFORM 'Machine name: ' GetComputerName() SKIP.
PUT UNFORM "Display type: " SESSION:DISPLAY-TYPE SKIP.
IF SESSION:BATCH-MODE THEN PUT UNFORM 'BATCH-MODE' SKIP.
IF OPSYS = "WIN32" THEN RUN GetScreenProprieties.
RUN GetProgressVersion.
RUN GetEnv.
RUN GetStartupParameters. /* Gives results only in 9.1D07 and above */
RUN Get18N.
RUN FontReport.
RUN GetSessionAttrs.
OUTPUT CLOSE.
/* report generated - open it? */
FILE-INFO:FILE-NAME = cOutputFile.
IF OPSYS = "WIN32" AND NOT SESSION:BATCH-MODE THEN
OS-COMMAND NO-WAIT notepad VALUE(FILE-INFO:FULL-PATHNAME).
IF OPSYS = "UNIX" AND NOT SESSION:BATCH-MODE THEN
MESSAGE "Report generated to: " FILE-INFO:FULL-PATHNAME.
PROCEDURE FontReport:
DEFINE VARIABLE i AS INTEGER NO-UNDO.
PUT UNFORM SKIP(2) "<<FONT REPORT 1>>" SKIP(2).
/* Font characteristics */
PUT UNFORM
"SESSION:PIXELS-PER-ROW => " SESSION:PIXELS-PER-ROW SKIP
"SESSION:PIXELS-PER-COL => " SESSION:PIXELS-PER-COL SKIP.
DO i = 0 TO 20:
PUT UNFORM
"FONT-TABLE:GET-TEXT-HEIGHT-PIXELS(" i ")) => "
FONT-TABLE:GET-TEXT-HEIGHT-PIXELS(i) SKIP
'FONT-TABLE:GET-TEXT-WIDTH-PIXELS("12345678901234567890",' i ') / 20 => '
FONT-TABLE:GET-TEXT-WIDTH-PIXELS("12345678901234567890",i) / 20 SKIP
'FONT-TABLE:GET-TEXT-WIDTH-PIXELS("12345678901234567890",' i ') => '
FONT-TABLE:GET-TEXT-WIDTH-PIXELS("12345678901234567890",i) SKIP.
END.
GET-KEY-VALUE SECTION "startup" KEY "DefaultFixedFont" VALUE cDefaultFixedFont.
GET-KEY-VALUE SECTION "startup" KEY "DefaultFont" VALUE cDefaultFont.
GET-KEY-VALUE SECTION "startup" KEY "DefaultV6UpdateFont" VALUE cDefaultV6UpdFont.
PUT UNFORM skip(3)
'DefaultFixedFont : ' cDefaultFixedFont SKIP
'DefaultFont : ' cDefaultFont SKIP
'DefaultV6UpdateFont: ' cDefaultV6UpdFont SKIP(3)
.
DO i = 0 TO 20:
GET-KEY-VALUE SECTION "fonts" KEY "font" + STRING(i) VALUE cRegValue.
PUT UNFORM "font" i " => " cRegValue SKIP.
END.
END PROCEDURE.
PROCEDURE GetComputerNameA EXTERNAL "KERNEL32.DLL":
DEFINE OUTPUT PARAMETER ptrToString AS MEMPTR.
DEFINE INPUT-OUTPUT PARAMETER intBufferSize AS LONG.
DEFINE RETURN PARAMETER intResult AS SHORT.
END PROCEDURE.
FUNCTION GetComputerName RETURNS CHARACTER ():
DEFINE VARIABLE chrComputerName AS CHARACTER NO-UNDO FORMAT "X(16)".
DEFINE VARIABLE intBufferSize AS INTEGER NO-UNDO INITIAL 16.
DEFINE VARIABLE intResult AS INTEGER NO-UNDO.
DEFINE VARIABLE ptrToString AS MEMPTR NO-UNDO.
SET-SIZE(ptrToString) = 16.
RUN GetComputerNameA (
OUTPUT ptrToString,
INPUT-OUTPUT intBufferSize,
OUTPUT intResult
).
IF intResult = 1 THEN DO:
ASSIGN chrComputerName = GET-STRING(ptrToString,1).
RETURN chrComputerName.
END.
ELSE
RETURN "Getting the computer name - Buffer size is too small. Must be as least " +
STRING(intBufferSize).
SET-SIZE(ptrToString) = 0.
END.
PROCEDURE GetACP EXTERNAL "kernel32":
DEFINE RETURN PARAMETER iCodePage AS LONG .
END PROCEDURE.
/* get db info */
PROCEDURE GetDatabaseInfo:
DEFINE VARIABLE i AS INTEGER NO-UNDO.
PUT SKIP(2) "<< DATABASES >>: " NUM-DBS SKIP.
REPEAT i = 1 TO NUM-DBS:
PUT UNFORM SKIP(2)
'DATABASE: ' LDBNAME(i) SKIP
' DBTYPE: ' DBTYPE(i) SKIP
' DBVERSION: ' DBVERSION(i) SKIP
' Parameters: ' DBPARAM(i) SKIP
' DBCODEPAGE: ' DBCODEPAGE(i) SKIP
' DBCOLLATION: ' DBCOLLATION(i) SKIP
.
END.
END.
PROCEDURE Get18N:
DEFINE VARIABLE iCodePage AS INTEGER NO-UNDO.
PUT UNFORM SKIP(2) "<< IN18N >>" SKIP(2).
/*Get Windows codepage */
IF OPSYS = "WIN32" THEN RUN GetACP(OUTPUT iCodePage).
/* I18N Progress session parameters */
PUT UNFORM
'Windows codepage: ' iCodePage SKIP(1)
'cpinternal: ' session:cpinternal SKIP
'cpstream : ' SESSION:CPSTREAM SKIP
'cpprint : ' SESSION:CPPRINT SKIP
'cpcase : ' SESSION:CPCASE SKIP
'cpcoll : ' SESSION:CPCOLL SKIP
'cplog : ' SESSION:CPLOG SKIP
'cprcodein : ' SESSION:CPRCODEIN SKIP
'cprcodeout: ' SESSION:CPRCODEOUT SKIP
'cpterm : ' SESSION:CPTERM
.
/*Get databases codepage */
RUN GetDatabaseInfo.
END.
PROCEDURE GetProgressVersion:
DEFINE VARIABLE cinp AS CHARACTER NO-UNDO. /* hold 1st line of version file */
DEFINE VARIABLE dlcValue AS CHARACTER NO-UNDO.
DEFINE VARIABLE patchLevel AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
IF OPSYS = "Win32":U THEN /* Get DLC from Registry */
GET-KEY-VALUE SECTION "Startup":U KEY "DLC":U VALUE dlcValue.
IF (dlcValue = "" OR dlcValue = ?) THEN DO:
ASSIGN dlcValue = OS-GETENV("DLC":U). /* Get DLC from environment */
IF (dlcValue = "" OR dlcValue = ?) THEN DO: /* Still nothing? */
ASSIGN patchLevel = "".
RETURN.
END.
END.
FILE-INFO:FILE-NAME = dlcValue + "/version":U.
IF FILE-INFO:FULL-PATHNAME NE ? THEN DO: /* Read the version file */
INPUT FROM VALUE(FILE-INFO:FULL-PATHNAME).
IMPORT UNFORMATTED cinp. /* Get the first line */
INPUT CLOSE.
/*
* As of version 9.1D just append everything from the version file
* after the version from PROVERSION property
*/
LEVEL:
DO i = 2 TO NUM-ENTRIES(cinp," ":U):
IF ENTRY(i,cinp," ") BEGINS PROVERSION THEN DO:
ASSIGN patchLevel = REPLACE(ENTRY(i,cinp," "),PROVERSION,"").
IF patchLevel = '' THEN patchLevel = 'NO PATCH INSTALLED'.
LEAVE LEVEL.
END.
END.
END.
PUT UNFORM 'Progress Version: ' PROVERSION patchlevel SKIP (2).
END PROCEDURE.
/*--------------------------------------------------------*/
PROCEDURE GetStartupParameters:
IF NOT AVAILABLE TTSession THEN RUN SessionAttrs.
FIND FIRST TTSession WHERE
TTSession.cAttrName = 'STARTUP-PARAMETERS' NO-ERROR. /*could not refer the SESSION:STARTUP-PARAMETERS directly as is not valid prior to 9.1D07*/
IF AVAILABLE TTSession THEN
PUT UNFORM SKIP 'Session startup parameters: ' SKIP TTSession.cAttrValue.
ELSE PUT UNFORM 'Could not retrieve the session startup parameters'.
END.
PROCEDURE GetSessionAttrs:
PUT UNFORM SKIP(2) 'SESSION ATTRIBUTES: ' SKIP.
IF NOT AVAILABLE TTSession THEN RUN SessionAttrs.
FOR EACH TTSession WHERE TTSession.cAttrValue <> ' << Method with parameters>>' BY cAttrName:
PUT UNFORM ' ' TTSession.cAttrName ': ' TTSession.cAttrValue SKIP.
END.
END.
PROCEDURE SessionAttrs:
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE hCall AS HANDLE NO-UNDO.
FOR EACH TTSession:
DELETE TTSession.
END.
/* Version 8: comment out the following lines to DELETE OBJECT inclusive */
CREATE CALL hCall.
DO i = 1 TO NUM-ENTRIES(LIST-QUERY-ATTRS (SESSION)) TRANSACTION:
CREATE TTSession.
cAttrName = ENTRY(i, LIST-QUERY-ATTRS(SESSION)).
hCall:CLEAR().
hCall:IN-HANDLE = SESSION.
hCall:CALL-TYPE = GET-ATTR-CALL-TYPE.
hCall:CALL-NAME = cAttrName.
hCall:INVOKE() NO-ERROR.
IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
IF ERROR-STATUS:GET-NUMBER(ERROR-STATUS:NUM-MESSAGES) = 4065 THEN
cAttrValue = ' << Method with parameters>>'.
ELSE cAttrValue = 'ERROR retriving the value'.
END.
ELSE cAttrValue = string(hCall:RETURN-VALUE) .
END.
DELETE OBJECT hCall.
END PROCEDURE.
&GLOBAL-DEFINE SM_CXVIRTUALSCREEN 78
&GLOBAL-DEFINE SM_CYVIRTUALSCREEN 79
PROCEDURE GetScreenProprieties:
DEFINE VARIABLE VirtWidth AS INTEGER NO-UNDO.
DEFINE VARiable VirtHeight AS INTEGER NO-UNDO.
/* Get the size of the virtual screen from Windows */
RUN GetSystemMetrics({&SM_CXVIRTUALSCREEN}, OUTPUT VirtWidth).
RUN GetSystemMetrics({&SM_CYVIRTUALSCREEN}, OUTPUT VirtHeight).
PUT UNFORM /* gives info about screen resolution*/
"Screen Virtual Width: " VirtWidth SKIP
"Screen Virtual Height: " VirtHeight SKIP (2).
END.
PROCEDURE GetSystemMetrics EXTERNAL "USER32.DLL":
DEFINE INPUT PARAMETER nIndex AS LONG.
DEFINE RETURN PARAMETER nRet AS LONG.
END PROCEDURE.
PROCEDURE GetEnv:
PUT UNFORM 'ORACLE_SID : ' OS-GETENV("ORACLE_SID":U) SKIP.
PUT UNFORM 'ORACLE_HOME : ' OS-GETENV("ORACLE_HOME":U) SKIP.
PUT UNFORM 'NLS_LANG : ' OS-GETENV("NLS_LANG":U) SKIP.
PUT UNFORM 'NLS_CHARACTER_SET: ' OS-GETENV("NLS_CHARACTER_SET":U) SKIP(2).
END PROCEDURE.
