Processes
.
change title and icon in Windows Task Manager
by Jurjen Dijkstra and Edwin van Elk
When you look at the "Applications" tab in Windows Task Manager, you see that every Progress session has the same title and icon. When you run multiple Progress sessions you may wish to change the icon and/or title of each individual entry in this list.
The Progress session creates one hidden window, which is the owner of all other Progress window. This ultimate owner is the window whos icon and title are displayed in the Task Manager. There is no Progress widget for this window, so you need API functions in order to manipulate it.
&Scoped-Define WM_GETICON 127
&Scoped-Define WM_SETICON 128
/* WM_SETICON / WM_GETICON Type Codes */
&Scoped-Define ICON_SMALL 0
&Scoped-Define ICON_BIG 1
/* some GetWindow() Constants */
&Scoped-Define GW_OWNER 4
DEFINE VARIABLE hParent AS INTEGER NO-UNDO.
DEFINE VARIABLE hOwner AS INTEGER NO-UNDO.
DEFINE VARIABLE i_ApiStat AS INTEGER NO-UNDO.
DEFINE VARIABLE hIcon AS INTEGER NO-UNDO.
/* find the hidden owner window */
RUN GetParent (DEFAULT-WINDOW:HWND, OUTPUT hParent).
RUN GetWindow (hParent, {&GW_OWNER}, OUTPUT hOwner).
/* change the title: */
RUN SetWindowTextA (hOwner, "This is the new application title").
/* change the icon: */
RUN ExtractIconA (0, SEARCH("ICON.ICO":U), 0, OUTPUT hIcon).
IF hIcon > 0 THEN DO:
RUN SendMessageA( hOwner, {&WM_SETICON}, {&ICON_BIG}, hIcon, OUTPUT i_ApiStat ).
RUN SendMessageA( hOwner, {&WM_SETICON}, {&ICON_SMALL}, hIcon, OUTPUT i_ApiStat ).
END.
/* ----------- API definitions: ----------------------- */
PROCEDURE SetWindowTextA EXTERNAL "user32.dll" :
DEFINE INPUT PARAMETER HWND AS LONG.
DEFINE INPUT PARAMETER txt AS CHARACTER.
END PROCEDURE.
PROCEDURE SendMessageA EXTERNAL "USER32.DLL":
DEFINE INPUT PARAMETER h_Widget AS LONG.
DEFINE INPUT PARAMETER i_Message AS LONG.
DEFINE INPUT PARAMETER i_wParam AS LONG.
DEFINE INPUT PARAMETER i_lParam AS LONG.
DEFINE RETURN PARAMETER i_ApiStatus AS LONG.
END PROCEDURE.
PROCEDURE GetWindow EXTERNAL "user32.dll" :
DEFINE INPUT PARAMETER HWND AS LONG.
DEFINE INPUT PARAMETER uCmd AS LONG.
DEFINE RETURN PARAMETER hwndOther AS LONG.
END PROCEDURE.
PROCEDURE GetParent EXTERNAL "user32.dll" :
DEFINE INPUT PARAMETER hwndChild AS LONG.
DEFINE RETURN PARAMETER hwndParent AS LONG.
END PROCEDURE.
PROCEDURE ExtractIconA EXTERNAL "shell32.dll":
DEFINE INPUT PARAMETER hInst AS LONG.
DEFINE INPUT PARAMETER lpszExeFileName AS CHARACTER.
DEFINE INPUT PARAMETER nIconIndex AS LONG.
DEFINE RETURN PARAMETER i_Return AS LONG.
END PROCEDURE.
Notes
If you only want to set the BIG icon you don't need API functions:
SESSION:LOAD-ICON ("example.ico").
However, the BIG icon does not affect the Task Manager listview. It only affects the Alt-Tab window.
Disallowing multiple instances of your application
_Based on an example from Microsofts whitepaper 'Optimizing Applications for Windows NT Server Terminal Server Edition, version 4.0'_
Suppose you want to prevent your Progress application to be launched more than once on each computer. The startup procedure would contain something like this:
IF IsAppAlreadyRunning(NO, "MyProgressApplication") THEN DO:
MESSAGE "'MyProgressApplication' is already running on this machine,"
SKIP
"only one instance is allowed."
VIEW-AS ALERT-BOX.
QUIT.
END.
...
RUN LetAnotherInstanceRun("MyProgressApplication").
There are several ways to implement this functionality. This topic will use a mutex.
A mutex is an object that can only be owned by one thread at a time. The general purpose of a mutex is to synchronize threads, ie to have other threads wait until the mutex is released. So if your application creates and owns a named mutex, other applications can not get ownership of the same mutex. Function IsAppAlreadyRunning creates a named mutex, procedure LetAnotherInstanceRun closes the mutex.
{windows.i}
DEFINE VARIABLE hAppRunningMutex AS INTEGER NO-UNDO INITIAL 0.
FUNCTION IsAppAlreadyRunning RETURN LOGICAL
(p-OnePerSystem AS LOGICAL, p-AppName AS CHARACTER):
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE MutexName AS CHARACTER NO-UNDO.
MutexName = ''.
IF p-OnePerSystem AND ValidateProductSuite("Terminal Server") THEN
MutexName = MutexName + "Global\".
MutexName = MutexName + p-AppName + ' is running'.
RUN CreateMutexA IN hpApi(0,0,MutexName, OUTPUT hAppRunningMutex).
IF hAppRunningMutex NE 0 THEN DO:
/* we should check GetLastError = ERROR_ALREADY_EXISTS,
but unfortunately GetLastError doesn't work with Progress until 9.0B */
/* Instead we will try to get ownership of the Mutex.
This will be easy if we created the mutex, but will be impossible if
another instance created the mutex (and still holds ownership) */
RUN WaitForSingleObject IN hpApi (hAppRunningMutex,100, OUTPUT ReturnValue).
IF NOT (ReturnValue={&WAIT_ABANDONED} OR
ReturnValue={&WAIT_OBJECT_0}) THEN DO:
RUN CloseHandle IN hpApi(hAppRunningMutex, OUTPUT ReturnValue).
hAppRunningMutex = 0.
END.
END.
RETURN (hAppRunningMutex=0).
END.
The first parameter, p-OnePerSystem specifies if the application is allowed to run more than once per system. This is useful when the application is installed on Microsoft Windows Terminal Server hosting multiple users. If p-OnePerSystem=No, the application can be launched once by each user. If p-OnePerSystem=Yes the application can run only once on the entire Terminal Server system, in other words: by only one user at a time. This might be useful for batch processes perhaps?
Procedure LetAntotherInstanceRun closes the mutex, making it available to other threads. This decreases the usage-count of the mutex. If the usage-count decreases to zero (like now) the mutex will be deleted. It is not very important to run this procedure because the mutex will be closed automatically by Windows when the Progress session quits.
PROCEDURE LetAnotherInstanceRun :
DEFINE INPUT PARAMETER p-AppName AS CHARACTER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
IF hAppRunningMutex NE 0 THEN DO:
RUN CloseHandle IN hpApi(hAppRunningMutex, OUTPUT ReturnValue).
hAppRunningMutex = 0.
END.
END PROCEDURE.
Function ValidateProductSuite checks if the application is installed on and running on a Windows Terminal Server machine :
{windows.i}
FUNCTION ValidateProductSuite RETURN LOGICAL (SuitName AS CHARACTER):
DEFINE VARIABLE key-hdl AS INTEGER NO-UNDO.
DEFINE VARIABLE lpBuffer AS MEMPTR NO-UNDO.
DEFINE VARIABLE lth AS INTEGER NO-UNDO.
DEFINE VARIABLE datatype AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE retval AS LOGICAL NO-UNDO INITIAL FALSE.
RUN RegOpenKeyA IN hpApi
( {&HKEY_LOCAL_MACHINE},
"System\CurrentControlSet\Control\ProductOptions",
OUTPUT key-hdl,
OUTPUT ReturnValue).
IF ReturnValue NE {&ERROR_SUCCESS} THEN
RETURN FALSE.
/* make buffer large enough
The maximum size is supposed to be MAX_PATH + 1 */
ASSIGN lth = {&MAX_PATH} + 1
SET-SIZE(lpBuffer) = lth.
RUN RegQueryValueExA IN hpApi
( key-hdl,
"ProductSuite",
0, /* reserved, must be 0 */
OUTPUT datatype,
GET-POINTER-VALUE(lpBuffer),
INPUT-OUTPUT lth,
OUTPUT ReturnValue).
IF ReturnValue = {&ERROR_SUCCESS} THEN
retval = (GET-STRING(lpBuffer,1)=SuitName).
SET-SIZE(lpBuffer)=0.
IF key-hdl NE 0 THEN
RUN RegCloseKey IN hpApi (key-hdl,OUTPUT ReturnValue).
RETURN retval.
END FUNCTION.
get a list of processes
This procedure can be used to show a list of all running processes, for example to see if Netscape.exe is running. The process indentifier (pid) can be used for getting additional information about the process, or for terminating the process.
This method uses the psapi.dll which only works on NT (and Windows 2000 etc). On Windows 95 or Windows 98 you can not use psapi.dll, instead you can use the much nicer CreateToolhelp32 functions.
To check if you are running Windows NT4.0 see page: which version of Windows is running.
FUNCTION GetProcessName RETURNS CHARACTER (INPUT PID AS INTEGER) :
DEFINE VARIABLE hProcess AS INTEGER NO-UNDO.
DEFINE VARIABLE cbNeeded AS INTEGER NO-UNDO.
DEFINE VARIABLE lphMod AS MEMPTR NO-UNDO.
DEFINE VARIABLE szProcessName AS CHARACTER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
/* OpenProcess returns a handle (hProcess),
needed for querying info about the process */
RUN OpenProcess ( {&PROCESS_QUERY_INFORMATION} + {&PROCESS_VM_READ},
0,
PID,
OUTPUT hProcess).
/* some system processes can not be queried,
like "System" and "System Idle Process" and "csrss.exe".
ProcessName will be initialized to [unknown] for these processes: */
szProcessName = "[unknown]" + FILL(" ", {&MAX_PATH}).
IF hProcess NE 0 THEN DO:
/* EnumProcessModules fills an array of module handles */
/* The first module handle is a handle to the main module, and that's the
only handle you need */
SET-SIZE (lphMod) = 4. /* need only one hMod */
RUN EnumProcessModules ( hProcess,
GET-POINTER-VALUE(lphMod),
GET-SIZE(lphMod),
OUTPUT cbNeeded,
OUTPUT ReturnValue).
IF ReturnValue NE 0 THEN DO:
/* GetModuleBaseNameA returns the name of a module.
Because this module is the main module, it's also considered to
be the name of the process */
RUN GetModuleBaseNameA (hProcess,
GET-LONG(lphMod,1),
OUTPUT szProcessName,
LENGTH(szProcessName),
OUTPUT ReturnValue).
/* ReturnValue is the number of returned bytes (chars): */
szProcessName = SUBSTRING(szProcessName,1,ReturnValue).
SET-SIZE (lphMod) = 0.
END.
RUN CloseHandle ( hProcess, OUTPUT ReturnValue).
END.
RETURN TRIM(szProcessName).
END FUNCTION.
/* =============== TEST ================ */
DEFINE VARIABLE lpId AS MEMPTR NO-UNDO.
DEFINE VARIABLE PID AS INTEGER NO-UNDO.
DEFINE VARIABLE cbNeeded AS INTEGER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
/* lpID is an array of PID's (Process Identifiers) */
SET-SIZE(lpId) = 1000. /* assume room for 250 pid's */
/* EnumProcesses fills an array of PID's */
RUN EnumProcesses (INPUT GET-POINTER-VALUE(lpId),
INPUT GET-SIZE(lpID),
OUTPUT cbNeeded,
OUTPUT ReturnValue).
DO i = 1 TO cbNeeded / 4 :
PID = GET-LONG(lpID, 4 * (i - 1) + 1).
/* display what you have found (for testing purposes) */
MESSAGE 'PID=' PID
SKIP
'Name=' GetProcessName(PID)
VIEW-AS ALERT-BOX.
END.
SET-SIZE(lpId) = 0.
Definitions used in this procedure:
&GLOB PROCESS_QUERY_INFORMATION 1024 &GLOB PROCESS_VM_READ 16 &GLOB MAX_PATH 260 PROCEDURE EnumProcesses EXTERNAL "psapi.dll" : DEFINE INPUT PARAMETER lpIdProcess AS LONG. DEFINE INPUT PARAMETER cb AS LONG. DEFINE OUTPUT PARAMETER cbNeeded AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE EnumProcessModules EXTERNAL "psapi.dll" : DEFINE INPUT PARAMETER hProcess AS LONG. DEFINE INPUT PARAMETER lphModule AS LONG. /* lp to array of module handles */ DEFINE INPUT PARAMETER cb AS LONG. DEFINE OUTPUT PARAMETER cbNeeded AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE GetModuleBaseNameA EXTERNAL "psapi.dll" : DEFINE INPUT PARAMETER hProcess AS LONG. DEFINE INPUT PARAMETER hModule AS LONG. DEFINE OUTPUT PARAMETER lpBaseName AS CHARACTER. DEFINE INPUT PARAMETER nSize AS LONG. DEFINE RETURN PARAMETER nReturnedSize AS LONG. END PROCEDURE. PROCEDURE OpenProcess EXTERNAL "kernel32.dll" : DEFINE INPUT PARAMETER dwDesiredAccess AS LONG. DEFINE INPUT PARAMETER bInheritHandle AS LONG. DEFINE INPUT PARAMETER dwProcessId AS LONG. DEFINE RETURN PARAMETER hProcess AS LONG. END PROCEDURE. PROCEDURE CloseHandle EXTERNAL "kernel32.dll" : DEFINE INPUT PARAMETER hObject AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE.
Get a list of processes (Windows 95/98/2000)
based on an example by Michael Rüsweg-Gilbert
This procedure can be used to show a list of all running processes, for example to see if Netscape.exe is running. The process indentifier (pid) can be used for getting additional information about the process, or for terminating the process. See TerminateProcess.
This method only works on Windows 95, Windows 98 and Windows 2000. For Windows NT4.0 you have to use procedure EnumProcesses instead.
To check if you are running Windows NT4.0 see page: which Windows version is running.
RUN ListProcesses.
PROCEDURE ListProcesses:
DEFINE VARIABLE hSnapShot AS INTEGER NO-UNDO.
DEFINE VARIABLE lpPE AS MEMPTR NO-UNDO. /* PROCESSENTRY32 structure */
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE list AS CHARACTER NO-UNDO INITIAL "Process-List:".
/* Create and open SnapShot-list */
RUN CreateToolhelp32Snapshot({&TH32CS_SNAPPROCESS},
0,
OUTPUT hSnapShot).
IF hSnapShot = -1 THEN RETURN.
/* init buffer for lpPE */
SET-SIZE(lpPE) = 336.
PUT-LONG(lpPE, 1) = GET-SIZE(lpPE).
/* Cycle thru process-records */
RUN Process32First(hSnapShot,
lpPE,
OUTPUT ReturnValue).
DO WHILE ReturnValue NE 0:
list = list + "~n".
/* show process identifier (pid): */
list = list + STRING(GET-LONG(lpPE, 9)) + " ".
/* show path and filename of executable: */
list = list + GET-STRING(lpPE, 37).
RUN Process32Next(hSnapShot,
lpPE,
OUTPUT ReturnValue).
END.
/* Close SnapShot-list */
RUN CloseHandle(hSnapShot, OUTPUT ReturnValue).
MESSAGE list VIEW-AS ALERT-BOX.
END PROCEDURE.
Definitions used in this procedure:
&GLOB TH32CS_SNAPPROCESS 2 PROCEDURE CreateToolhelp32Snapshot EXTERNAL "kernel32" : DEFINE INPUT PARAMETER dwFlags AS LONG. DEFINE INPUT PARAMETER th32ProcessId AS LONG. DEFINE RETURN PARAMETER hSnapShot AS LONG. END PROCEDURE. PROCEDURE Process32First EXTERNAL "kernel32" : DEFINE INPUT PARAMETER hSnapShot AS LONG. DEFINE INPUT PARAMETER lpProcessEntry32 AS MEMPTR. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE Process32Next EXTERNAL "kernel32" : DEFINE INPUT PARAMETER hSnapShot AS LONG. DEFINE INPUT PARAMETER lpProcessEntry32 AS MEMPTR. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE CloseHandle EXTERNAL "kernel32" : DEFINE INPUT PARAMETER hObject AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE.
Get the memory usage of all running processes.
Does anyone know a good way of getting the memory usage of all running processes.
GetProcessTimes
sourcecode by Michael Rüsweg-Gilbert
Function GetProcessTimes works on Windows NT only.
GetProcessTimes obtains timing information about a specified process: the creation time, exit time, kernel time and user time. All these are returned as FILETIME structures (a 64 bit count of 100-nanosecond units).
Creation time and exit time are expressed as time elapsed since midnight January 1, 1601 (UTC). Function FileTimeToSystemTime converts this to system time - which may also be UTC.
Function FileTimeToLocalFileTime can be called prior to FileTimeToSystemTime if you want the output to be displayed in local time.
Kernel time and user time are amounts of time: the FILETIME structures will contain the amount of 100 nanosecond units (ten million units is one second).
This example uses GetProcessTimes for the current (Progress) process. The exit time is null or random because the current process did not exit yet.
/* -----------------------------------------------------------
// File: tst_procTime.p
// Desc: query the process-times of the current process
//
// Parm: ---
//
//
// Author: Michael Rüsweg-Gilbert
// Created: 20. Sept. 1999
-------------------------------------------------------------- */
DEFINE VARIABLE RetVal AS INTEGER NO-UNDO.
DEFINE VARIABLE me_Crea AS MEMPTR NO-UNDO.
DEFINE VARIABLE me_Exit AS MEMPTR NO-UNDO.
DEFINE VARIABLE me_Kern AS MEMPTR NO-UNDO.
DEFINE VARIABLE me_User AS MEMPTR NO-UNDO.
DEFINE VARIABLE hProc AS INTEGER NO-UNDO.
DEFINE VARIABLE PID AS INTEGER NO-UNDO.
&GLOB TRUE 1
&GLOB FALSE 0
&GLOB PROCESS_ALL_ACCESS 2035711 /* 0x0F0000 | 0x100000 | 0x000FFF */
/* Convert FileTime into a readable LocalTime-String */
FUNCTION proTimeString RETURNS CHAR
( ip_filetime AS MEMPTR):
DEFINE VARIABLE tmp_sysTime AS MEMPTR NO-UNDO.
DEFINE VARIABLE Ret AS INTEGER NO-UNDO.
DEFINE VARIABLE cTime AS CHARACTER NO-UNDO INIT ?.
SET-SIZE(tmp_sysTime) = 16.
/* Convert UTC-Time to Local Time */
RUN FileTimeToSystemTime ( INPUT ip_filetime,
OUTPUT tmp_systime,
OUTPUT Ret ).
IF Ret = {&TRUE} THEN DO:
/* a DAY.MONTH.YEAR HOUR:MINUTE:SECOND-string */
cTime = STRING(GET-SHORT(tmp_sysTime, 7)) + "." +
STRING(GET-SHORT(tmp_sysTime, 3)) + "." +
STRING(GET-SHORT(tmp_sysTime, 1)) + " " +
STRING(GET-SHORT(tmp_sysTime, 9)) + ":" +
STRING(GET-SHORT(tmp_sysTime, 11)) + ":" +
STRING(GET-SHORT(tmp_sysTime, 13)).
END.
SET-SIZE(tmp_sysTime) = 0.
IF cTime = ?
THEN RETURN "Error in FileTimeToSystemTime; Ret=" + STRING(Ret).
ELSE RETURN cTime.
END FUNCTION.
/* first obtain the current Process Token (add Debug rights) */
RUN GetCurrentProcessId(OUTPUT PID).
RUN OpenProcess ( {&Process_All_Access},
0,
PID,
OUTPUT hProc).
IF hProc LT 1 THEN DO:
MESSAGE "Can't open current PID" PID
VIEW-AS ALERT-BOX INFO BUTTONS OK.
RETURN.
END.
HProc0:
DO:
SET-SIZE(me_Crea) = 8.
SET-SIZE(me_Exit) = 8.
SET-SIZE(me_Kern) = 8.
SET-SIZE(me_User) = 8.
RUN GetProcessTimes ( hProc,
me_Crea,
me_Exit,
me_Kern,
me_User,
OUTPUT RetVal).
IF RetVal NE {&TRUE} THEN DO:
MESSAGE "GetProcessTimes returned" RetVal
VIEW-AS ALERT-BOX.
LEAVE.
END.
MESSAGE "Creation Time: " ProTimeString(me_Crea) SKIP
" Exit Time: " ProTimeString(me_Exit) SKIP
" Kernel Time: " ProTimeString(me_Kern) SKIP
" User Time: " ProTimeString(me_User)
VIEW-AS ALERT-BOX.
END.
SET-SIZE(me_Crea) = 0.
SET-SIZE(me_Exit) = 0.
SET-SIZE(me_Kern) = 0.
SET-SIZE(me_User) = 0.
RUN CloseHandle ( hProc, OUTPUT RetVal).
RETURN.
PROCEDURE CloseHandle EXTERNAL "kernel32":
DEFINE INPUT PARAMETER hObject AS LONG .
DEFINE RETURN PARAMETER retval AS LONG .
END PROCEDURE.
PROCEDURE GetCurrentProcessId EXTERNAL "kernel32":
DEFINE RETURN PARAMETER PID AS LONG .
END PROCEDURE.
PROCEDURE GetLastError EXTERNAL "kernel32":
DEFINE RETURN PARAMETER dwError AS LONG .
END PROCEDURE.
PROCEDURE OpenProcess EXTERNAL "kernel32.dll" :
DEFINE INPUT PARAMETER dwDesiredAccess AS LONG.
DEFINE INPUT PARAMETER bInheritHandle AS LONG.
DEFINE INPUT PARAMETER dwProcessId AS LONG.
DEFINE RETURN PARAMETER hProcess AS LONG.
END PROCEDURE.
PROCEDURE GetProcessTimes EXTERNAL "kernel32.dll" :
DEFINE INPUT PARAMETER hProcess AS LONG.
DEFINE INPUT PARAMETER lpCreationTime AS MEMPTR. /* FILETIME */
DEFINE INPUT PARAMETER lpExitTime AS MEMPTR. /* FILETIME */
DEFINE INPUT PARAMETER lpKernelTime AS MEMPTR. /* FILETIME */
DEFINE INPUT PARAMETER lpUserTime AS MEMPTR. /* FILETIME */
DEFINE RETURN PARAMETER RetBool AS LONG.
END PROCEDURE.
PROCEDURE FileTimeToSystemTime EXTERNAL "kernel32.dll":
DEFINE INPUT PARAMETER lpFileTime AS MEMPTR. /* L = 8 */
DEFINE OUTPUT PARAMETER lpSystemTime AS MEMPTR. /* L = 16 */
DEFINE RETURN PARAMETER retBool AS LONG. /* = 0, if failure */
END PROCEDURE.
Modules in the current process
It is possible to list all modules (exe, dll, ocx, drv) that are in use by a particular process. This example lists all modules loaded by the current process, which is of course the running Progress process.
The resulting list can be useful during development, to check if a certain DLL or OCX really got released, but can also be useful for support engineers to check if a customer site has the appropriate module versions.
Unfortunately the procedure for Windows NT4 is very different compared to 95/98/2000.
DEFINE TEMP-TABLE module
FIELD hModule AS INTEGER FORMAT "->>>>>>>>>>>9"
FIELD cntUsage AS INTEGER
FIELD ModuleName AS CHARACTER FORMAT "x(20)"
FIELD ModulePath AS CHARACTER FORMAT "x(150)"
FIELD FileVersion AS CHARACTER FORMAT "x(15)"
FIELD ProductVersion AS CHARACTER FORMAT "x(15)"
INDEX key_name IS PRIMARY ModuleName.
RUN FindModules.
/* assuming you want to display the contents of the
module temp-table in a browse widget: */
{&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
PROCEDURE FindModules :
FOR EACH module :
DELETE module.
END.
IF RunningWindowsNT4() THEN
RUN FindModules_NT4.
ELSE
RUN FindModules_notNT4.
FOR EACH module :
RUN GetProductVersion(module.modulePath,
OUTPUT module.ProductVersion,
OUTPUT module.FileVersion).
END.
END PROCEDURE.
Windows 9x and Windows 2000 support the fairly new toolhelp procedures for finding process information.
PROCEDURE FindModules_notNT4 :
DEFINE VARIABLE hSnapShot AS INTEGER NO-UNDO.
DEFINE VARIABLE lpME AS MEMPTR NO-UNDO. /* MODULEENTRY32 structure */
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
FOR EACH module :
DELETE module.
END.
IF RunningWindowsNT4() THEN DO:
MESSAGE "Sorry, this procedure does not work with NT4"
VIEW-AS ALERT-BOX.
RETURN.
END.
/* Create and open SnapShot-list */
RUN CreateToolhelp32Snapshot({&TH32CS_SNAPMODULE},
0,
OUTPUT hSnapShot).
IF hSnapShot = -1 THEN RETURN.
/* init buffer for lpPE */
SET-SIZE(lpME) = 32 + 256 + 260.
PUT-LONG(lpME, 1) = GET-SIZE(lpME).
/* Cycle thru process-records */
RUN Module32First(hSnapShot,
lpME,
OUTPUT ReturnValue).
DO WHILE ReturnValue NE 0:
CREATE module.
ASSIGN module.moduleName = GET-STRING(lpME, 33)
module.modulePath = GET-STRING(lpME, 33 + 256)
module.cntUsage = GET-LONG(lpME, 17)
module.hModule = GET-LONG(lpME, 29).
RUN Module32Next(hSnapShot,
lpME,
OUTPUT ReturnValue).
END.
/* Close SnapShot-list */
RUN CloseHandle(hSnapShot, OUTPUT ReturnValue).
END PROCEDURE.
In NT 4 the only way to find process information is by reading the registry in the HK_PERFORMANCE_DATA key. Interpreting the data in this registry interface is very complicated but there is a library, PSAPI.DLL, which contains a couple of higher-level procedures and reads the registry interface for you. PSAPI.DLL does not reveal every possible info from the registry but enough for this purpose.
PROCEDURE FindModules_NT4 :
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE ProcessId AS INTEGER NO-UNDO.
DEFINE VARIABLE hProcess AS INTEGER NO-UNDO.
DEFINE VARIABLE lphMod AS MEMPTR NO-UNDO.
DEFINE VARIABLE hModule AS INTEGER NO-UNDO.
DEFINE VARIABLE cbNeeded AS INTEGER NO-UNDO.
DEFINE VARIABLE szModuleName AS CHARACTER NO-UNDO.
DEFINE VARIABLE szModuleNameEx AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
RUN GetCurrentProcessId (OUTPUT ProcessId).
RUN OpenProcess ( {&PROCESS_QUERY_INFORMATION} + {&PROCESS_VM_READ},
0,
ProcessID,
OUTPUT hProcess).
/* if process handle for the current process is found, then: */
IF hProcess NE 0 THEN DO:
SET-SIZE (lphMod) = 4 * 1024. /* should be more than enough */
RUN EnumProcessModules ( hProcess,
GET-POINTER-VALUE(lphMod),
GET-SIZE(lphMod),
OUTPUT cbNeeded,
OUTPUT ReturnValue).
IF ReturnValue NE 0 THEN DO:
DO i=1 TO cbNeeded / 4 :
hModule = GET-LONG(lphMod, (i - 1) * 4 + 1).
szModuleName = "" + FILL(" ", {&MAX_PATH}).
RUN GetModuleBaseNameA (hProcess,
hModule,
OUTPUT szModuleName,
LENGTH(szModuleName),
OUTPUT ReturnValue).
/* ReturnValue is the number of returned bytes (chars): */
szModuleName = TRIM(SUBSTRING(szModuleName,1,ReturnValue)).
szModuleNameEx = "" + FILL(" ", {&MAX_PATH}).
RUN GetModuleFileNameExA (hProcess,
hModule,
OUTPUT szModuleNameEx,
LENGTH(szModuleNameEx),
OUTPUT ReturnValue).
/* ReturnValue is the number of returned bytes (chars): */
szModuleNameEx = TRIM(SUBSTRING(szModuleNameEx,1,ReturnValue)).
CREATE module.
ASSIGN module.moduleName = szModuleName
module.modulePath = szModuleNameEx
module.cntUsage = ?
module.hModule = hModule.
END.
SET-SIZE (lphMod) = 0.
END.
RUN CloseHandle(hProcess, OUTPUT ReturnValue).
END.
END PROCEDURE.
Definitions used in this procedure, not listed in windows.p :
&GLOB TH32CS_SNAPMODULE 8 &GLOB PROCESS_QUERY_INFORMATION 1024 &GLOB PROCESS_VM_READ 16 PROCEDURE CreateToolhelp32Snapshot EXTERNAL "kernel32.dll" : DEFINE INPUT PARAMETER dwFlags AS LONG. DEFINE INPUT PARAMETER th32ProcessId AS LONG. DEFINE RETURN PARAMETER hSnapShot AS LONG. END PROCEDURE. PROCEDURE Module32First EXTERNAL "kernel32.dll" : DEFINE INPUT PARAMETER hSnapShot AS LONG. DEFINE INPUT PARAMETER lpModuleEntry32 AS MEMPTR. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE Module32Next EXTERNAL "kernel32.dll" : DEFINE INPUT PARAMETER hSnapShot AS LONG. DEFINE INPUT PARAMETER lpModuleEntry32 AS MEMPTR. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE EnumProcessModules EXTERNAL "psapi.dll" : DEFINE INPUT PARAMETER hProcess AS LONG. DEFINE INPUT PARAMETER lphModule AS LONG. /* lp to array of module handles */ DEFINE INPUT PARAMETER cb AS LONG. DEFINE OUTPUT PARAMETER cbNeeded AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE GetModuleBaseNameA EXTERNAL "psapi.dll" : DEFINE INPUT PARAMETER hProcess AS LONG. DEFINE INPUT PARAMETER hModule AS LONG. DEFINE OUTPUT PARAMETER lpBaseName AS CHARACTER. DEFINE INPUT PARAMETER nSize AS LONG. DEFINE RETURN PARAMETER nReturnedSize AS LONG. END PROCEDURE. PROCEDURE GetModuleFileNameExA EXTERNAL "psapi.dll" : DEFINE INPUT PARAMETER hProcess AS LONG. DEFINE INPUT PARAMETER hModule AS LONG. DEFINE OUTPUT PARAMETER lpFileName AS CHARACTER. DEFINE INPUT PARAMETER nSize AS LONG. DEFINE RETURN PARAMETER nReturnedSize AS LONG. END PROCEDURE.
Notes:
Function RunningWindowsNT4( ) is covered on page which version of Windows is running.
Procedure GetProductVersion(..) is covered on page File version information.
If you only want to find the path and name of the the current Progress executable module ("prowin32.exe") it is much more convenient to call GetModuleFileName.
NT Services Status
by Todd G. Nist
Program source is available for download: w-findservice.w
This is a program for an NT environment which will determine all of the computers on a given network and which services they are running. You can then inquire of a given server what the status is of a services and it will return weather it is running, in error, etc...
It has only been tested under NT 4.0 with service pack 3. You will have to be logged into and authenticated on the network in order to inquire of the status of services running on other machines in the network.
API-procedures used in this example are listed here to be included in the search index: PROCEDURE CloseServiceHandle EXTERNAL "advapi32.dll" PROCEDURE EnumServicesStatusA EXTERNAL "advapi32.dll" PROCEDURE OpenSCManagerA EXTERNAL "advapi32.dll" PROCEDURE OpenServiceA EXTERNAL "advapi32.dll" PROCEDURE QueryServiceConfigA EXTERNAL "advapi32.dll" PROCEDURE QueryServiceStatus EXTERNAL "advapi32.dll" PROCEDURE NetServerEnum EXTERNAL "Netapi32.dll" PROCEDURE NetApiBufferFree EXTERNAL "Netapi32.dll" PROCEDURE lstrcpyW EXTERNAL "kernel32.dll" PROCEDURE lstrlen EXTERNAL "kernel32.dll" PROCEDURE RtlMoveMemory EXTERNAL "kernel32.dll" PROCEDURE WideCharToMultiByte EXTERNAL "kernel32.dll" PROCEDURE GetComputerNameA EXTERNAL "kernel32.dll"
Attachments
w-findservice.w.zip : example program
sleep (milliseconds)
The P4GL PAUSE function can only be used for whole seconds, not fractions of seconds.
A loop using the ETIME function can be used to wait for fractions of a second, but will keep the processor busy in the current thread.
The following call will wait for 0.5 seconds and minimize system load :
/* by Michael Rüsweg-Gilbert */ RUN sleep ( 500 ). PROCEDURE Sleep EXTERNAL "KERNEL32": DEFINE INPUT PARAMETER lMilliseconds AS LONG NO-UNDO. END PROCEDURE.
How does Sleep minimize system load?
Windows works multi-tasking, sort of. A thread is allowed to work for a certain time quantum. When that quantum is over, the running thread is suspended and one of the other threads can start its own time quantum. Which thread? Well, that is decided based on priorities and is not easy to understand, but one thing is clear: a thread is skipped when it has requested a Sleep.
As a matter of fact, the time quantum for the running thread will immediately be suspended when the thread calls Sleep.
In other words: Sleep gives extra time to other threads.
What is the meaning of Sleep(0)?
Sometimes you see Sleep(0) in source code. Sleep(0) does not take very long, it just gives the remainder of the current time quantum back to the operating system. Each of the other threads will have a turn (well, I am ignoring priority issues here) before the thread who called Sleep(0) will execute again.
So Sleep(0) can be useful when you need an other thread to respond to one of your actions.
Don't sleep too long
A window **has to** respond to messages within a fair amount of time, that's one of the rules of the GUI system. That is to say, the window has to be able to repaint itself and respond swiftly to user actions and system messages. A sleeping thread does not respond. In other words, a thread that owns windows should not sleep too long. More precisely: a thread that directly or indirectly creates windows. This also includes threads involved in DDE.
Somewhat off-topic: a thread that owns windows should also not do things like
FOR EACH order: DELETE order. END.
without PROCESS EVENTS inside the loop. Such actions should be performed by a second thread while the GUI thread continues. Oh well.
terminate a process gently
Topic TerminateProcess introduced the equivalent to the Unix "kill -9" command.
The following 4GL procedure KillProcess(pid) also terminates a process, but tries to avoid the use of TerminateProcess.
Procedure CloseProcessWindows is based on API-function EnumWindows. This API-function can not be called from within P4GL because it needs a callback, so I wrote procedure CloseProcessWindows in Pascal and added it to proextra.dll (see page ProExtra.dll). Of course I might as well have included all the rest in Pascal too, but then I would not allow myself to post it on this Progress site :-)
By the way, the topic on CreateProcess shows how to create a process and return a PID.
{windows.i}
{proextra.i} /* version August 21, 1999 */
&GLOBAL-DEFINE PROCESS_QUERY_INFORMATION 1024
&GLOBAL-DEFINE PROCESS_TERMINATE 1
&GLOBAL-DEFINE STILL_ACTIVE 259
/* =======================================================
IsProcessRunning
Returns TRUE if the process is not terminated.
(also returns TRUE if the process is hanging)
------------------------------------------------------- */
FUNCTION IsProcessRunning RETURNS LOGICAL (PID AS INTEGER) :
DEFINE VARIABLE IsRunning AS LOGICAL NO-UNDO INITIAL NO.
DEFINE VARIABLE hProcess AS INTEGER NO-UNDO.
DEFINE VARIABLE ExitCode AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
RUN Sleep IN hpApi (0).
/* Sleep(0) just gives the remainder of this
thread's time quantum back to the task switcher so the other
process gets the opportunity to finish and release itself. */
RUN OpenProcess IN hpApi
( {&PROCESS_QUERY_INFORMATION},
0,
PID,
OUTPUT hProcess).
IF hProcess NE 0 THEN DO:
RUN GetExitcodeProcess IN hpApi
( hProcess,
OUTPUT ExitCode,
OUTPUT ReturnValue).
IsRunning = (ExitCode={&STILL_ACTIVE}) AND (ReturnValue NE 0).
RUN CloseHandle IN hpApi(hProcess, OUTPUT ReturnValue).
END.
RETURN IsRunning.
END FUNCTION.
/* =======================================================
KillProcess
terminates a process as gently as possible.
pHow tells you how it is done, for debugging purposes
------------------------------------------------------- */
PROCEDURE KillProcess :
DEFINE INPUT PARAMETER PID AS INTEGER NO-UNDO.
DEFINE OUTPUT PARAMETER pHow AS CHARACTER NO-UNDO.
DEFINE VARIABLE cName AS CHARACTER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
DEFINE VARIABLE ProcessHandle AS INTEGER NO-UNDO.
/* first step: */
/* ------------ */
/* verify if the process is really running */
pHow='not running'.
IF NOT IsProcessRunning(PID) THEN RETURN.
/* second step: */
/* ------------ */
/* does the process have windows?
If it does, the nicest way to stop the process is
send a WM_CLOSE message to each window, as if a human operator
pressed the [x]-titlebar button. */
/* If the process is very young it might not have created a window yet.
Use WaitForInputIdle to wait until the process has a window and is
ready to receive messages. */
pHow='close'.
RUN OpenProcess IN hpApi({&PROCESS_QUERY_INFORMATION},
0,
PID,
OUTPUT ProcessHandle).
IF ProcessHandle NE 0 THEN
RUN WaitForInputIdle IN hpApi(ProcessHandle,
1000, /* one second maximum */
OUTPUT ReturnValue).
RUN CloseProcessWindows IN hpExtra (PID, OUTPUT ReturnValue).
/* ReturnValue=0 if the PID didn't own any windows.
The windows may be too busy to close immediately.
Give them 5 seconds to respond.
That's what the Windows Task Manager would also do. */
IF ReturnValue NE 0 THEN
RUN WaitForSingleObject IN hpApi (ProcessHandle,
5000, /* five seconds maximum */
OUTPUT ReturnValue).
RUN CloseHandle IN hpApi(ProcessHandle, OUTPUT ReturnValue).
/* third step: */
/* ----------- */
/* If PID is a Progress session it would be nice to execute PROSHUT.
You would first have to find the user number
via the VST _Connect table. And you would have
to repeat this for every database the process is connected to. */
/* I am not going to do this, but it would have been nice... */
/* last step: */
/* ---------- */
/* because everything else failed: TerminateProcess.
This is similar to "kill -9" in Unix so should be avoided */
/* Must assume we have sufficient rights for terminating this process. */
IF NOT IsProcessRunning(PID) THEN RETURN.
pHow='kill'.
RUN OpenProcess IN hpApi({&PROCESS_TERMINATE}, 0, PID, OUTPUT ProcessHandle).
IF ProcessHandle NE 0 THEN DO:
RUN TerminateProcess IN hpApi(ProcessHandle, 0, OUTPUT ReturnValue).
RUN CloseHandle IN hpApi(ProcessHandle, OUTPUT ReturnValue).
END.
/* if everything failed the process will keep running. How could this happen? */
IF IsProcessRunning(PID) THEN pHow='failed'.
END PROCEDURE.
terminating a process
To terminate a process for which you know the process handle, you can use function TerminateProcess.
If you don't know the process handle but the process identifier, you can get the handle by calling OpenProcess first.
DEFINE INPUT PARAMETER ProcessId AS INTEGER NO-UNDO.
DEFINE VARIABLE ProcessHandle AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
RUN OpenProcess ({&PROCESS_TERMINATE}, 0, ProcessId, OUTPUT ProcessHandle).
IF ProcessHandle NE 0 THEN DO:
RUN TerminateProcess (ProcessHandle, 0, OUTPUT ReturnValue).
RUN CloseHandle(ProcessHandle, OUTPUT ReturnValue).
END.
Definitions used in this procedure:
&GLOB PROCESS_TERMINATE 1 PROCEDURE OpenProcess EXTERNAL "kernel32" : DEFINE INPUT PARAMETER dwDesiredAccess AS LONG. DEFINE INPUT PARAMETER bInheritHandle AS LONG. DEFINE INPUT PARAMETER dwProcessId AS LONG. DEFINE RETURN PARAMETER hProcess AS LONG. END PROCEDURE. PROCEDURE CloseHandle EXTERNAL "kernel32" : DEFINE INPUT PARAMETER hObject AS LONG. DEFINE RETURN PARAMETER ReturnValue AS LONG. END PROCEDURE. PROCEDURE TerminateProcess EXTERNAL "kernel32" : DEFINE INPUT PARAMETER hProcess AS LONG. DEFINE INPUT PARAMETER uExitCode AS LONG. DEFINE RETURN PARAMETER retval AS LONG. END PROCEDURE.
notes
TerminateProcess is guaranteed to free all resources allocated by the process.
But, similar to "kill -9" in Unix, the process will not get the opportunity to perform any of its shutdown code. Examples of shutdown code can be: writing "recent actions" in registry, notifying other processes, saving data etc.
Because of this, TerminateProcess should only be used as an emergency measure.
A more cautious way to terminate a process would be to find all its top-level windows and send a WM_CLOSE message to each of those windows. If this does not succeed within some time interval ("not responding") you can still use TerminateProcess.
An example of how to do this is on page terminate a process gently
the current Progress executable
by Sturla Johnsen
This procedure is convenient for tech support: it shows some information about the currently running Progress process like path and name of the Progress executable ("D:\DLC\BIN\PROWIN32.EXE"), the Progress version ("8.2C") and the serial number (believe me).
DEFINE VARIABLE hModule AS INTEGER NO-UNDO.
DEFINE VARIABLE cFileName AS CHARACTER NO-UNDO.
DEFINE VARIABLE RetVal AS INTEGER NO-UNDO.
ASSIGN hModule = ?
cFileName = FILL(" ",256).
RUN GetModuleFileNameA(hModule, OUTPUT cFileName, 256, OUTPUT RetVal).
MESSAGE "Progress exe :" SUBSTRING(cFileName, 1, RetVal) SKIP
"version:" PROVERSION SKIP
"Serial number:" _SERIAL
VIEW-AS ALERT-BOX.
Definitions used in this procedure, not listed in windows.p :
PROCEDURE GetModuleFileNameA EXTERNAL "kernel32.dll" : DEFINE INPUT PARAMETER hModule AS LONG. DEFINE OUTPUT PARAMETER lpFilename AS CHARACTER. DEFINE INPUT PARAMETER nSize AS LONG. DEFINE RETURN PARAMETER ReturnSize AS LONG. END PROCEDURE.
Notes:
It is not required to find the actual module handle, because GetModuleFileName with module=NULL (or =? as we say in Progress) is documented to return the name of the module that started the process.
This makes it a light and convenient alternative for the source in example Modules in the current process which enumerates the names of all the modules in the current process.
An other advantage of this example is that function GetModuleFileName is available in every Windows version.
which version of Windows is running
** note: this topic is outdated, needs to be adjusted for ME and XP **
The API is not exactly the same for the different Windows versions so it is sometimes usefull to know which Windows version is running. However the differences may disappear when Windows 95/98 and Windows NT mature (or when add-ons are installed) so checking for the Windows version may become less interesting: you should prefer to check for features instead versions.
This procedure here shows what Windows version you are running providing it's a 32-bit version. These are:
* Windows 3.1 with win32s
* Windows 95
* Windows 95 OSR 2
* Windows 98
* NT 3.51
* NT 4.0
* Windows 2000
* Windows CE also runs a subset of WIN32 but CE isn't interesting for us.
The procedure also shows buildnumber and CSDversion. What a CSDversion is, is not always clear: on NT it's a string describing the latest installed Service Pack. On 95 it can be anything but CSDversion will be "a" if Service Pack 1 is installed.
{windows.i}
DEFINE VARIABLE lpVersionInfo AS MEMPTR.
DEFINE VARIABLE dwPlatformID AS INTEGER NO-UNDO.
DEFINE VARIABLE chPlatformID AS CHARACTER NO-UNDO.
DEFINE VARIABLE BuildNumber AS INTEGER NO-UNDO.
DEFINE VARIABLE MajorVersion AS INTEGER NO-UNDO.
DEFINE VARIABLE MinorVersion AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
SET-SIZE(lpVersionInfo) = 148.
PUT-LONG(lpVersionInfo,1) = 148.
RUN GetVersionExA IN hpApi( GET-POINTER-VALUE(lpVersionInfo),
OUTPUT ReturnValue).
dwPlatformID = GET-LONG(lpVersionInfo,17).
CASE dwPlatformID :
WHEN 0 THEN chPlatformID = "Win32s on Windows 3.1".
WHEN 1 THEN chPlatformID = "Win32 on Windows 95 or 98".
WHEN 2 THEN chPlatformID = "Win32 on Windows NT".
END.
CASE dwPlatformID :
WHEN 1 THEN BuildNumber = GET-SHORT(lpVersionInfo,13).
WHEN 2 THEN BuildNumber = GET-LONG (lpVersionInfo,13).
/* what about 'when 0' for 3.1 with win32s ?? */
END.
/* You have Windows 95 OSR 2 if:
dwPlatformID=1
and
LOWORD(BuildNumber)=1111 (probably hex??)
Unfortunately I have not had a chance to test that.
*/
CASE dwPlatformID :
WHEN 1 THEN DO:
MinorVersion = GET-BYTE(lpVersionInfo,15).
MajorVersion = GET-BYTE(lpVersionInfo,16).
END.
OTHERWISE DO:
MajorVersion = GET-LONG(lpVersionInfo, 5).
MinorVersion = GET-LONG(lpVersionInfo, 9).
END.
END.
MESSAGE "MajorVersion=" MajorVersion SKIP
"MinorVersion=" MinorVersion SKIP
"BuildNumber=" BuildNumber SKIP
"PlatformID=" chPlatFormId SKIP
"CSDversion=" GET-STRING(lpVersionInfo,21) SKIP(2)
"on NT, CSDversion contains version of latest Service Pack" SKIP
"on 95/98, CSDversion contains arbitrary extra info, if any"
VIEW-AS ALERT-BOX.
SET-SIZE(lpVersionInfo) = 0.
NT4 Terminal Server Edition
To check if you are running on Terminal Server Edition you can use function ValidateProductSuite("Terminal Server").
Old documentation suggested that this function would be added to the WIN32 API in Windows 2000. But newer documentation for Windows 2000 describes a new function VerifyVersionInfo - to be called with wSuiteMask = VER_SUITE_TERMINAL. We will see.
In the meantime you can write your own function ValidateProductSuite in Progress 4GL and some registry functions. An example is on page Disallowing multiple instances of your application.
A couple of convenient functions
FUNCTION RunningWindows95 RETURNS LOGICAL () :
/* returns TRUE if you are running Windows 95 */
DEFINE VARIABLE Win95 AS LOGICAL NO-UNDO.
DEFINE VARIABLE lpVersionInfo AS MEMPTR.
DEFINE VARIABLE dwPlatformID AS INTEGER NO-UNDO.
DEFINE VARIABLE MinorVersion AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
SET-SIZE(lpVersionInfo) = 148.
PUT-LONG(lpVersionInfo,1) = 148.
RUN GetVersionExA IN hpApi( GET-POINTER-VALUE(lpVersionInfo),
OUTPUT ReturnValue).
dwPlatformID = GET-LONG(lpVersionInfo,17).
MinorVersion = GET-BYTE(lpVersionInfo,15).
Win95 = (dwPlatformId=1 AND MinorVersion=0).
SET-SIZE(lpVersionInfo) = 0.
RETURN Win95.
END FUNCTION.
FUNCTION RunningWindows98 RETURNS LOGICAL () :
/* returns TRUE if you are running Windows 98 */
DEFINE VARIABLE Win98 AS LOGICAL NO-UNDO.
DEFINE VARIABLE lpVersionInfo AS MEMPTR.
DEFINE VARIABLE dwPlatformID AS INTEGER NO-UNDO.
DEFINE VARIABLE MinorVersion AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
SET-SIZE(lpVersionInfo) = 148.
PUT-LONG(lpVersionInfo,1) = 148.
RUN GetVersionExA IN hpApi( GET-POINTER-VALUE(lpVersionInfo),
OUTPUT ReturnValue).
dwPlatformID = GET-LONG(lpVersionInfo,17).
MinorVersion = GET-BYTE(lpVersionInfo,15).
Win98 = (dwPlatformId=1 AND MinorVersion=10).
SET-SIZE(lpVersionInfo) = 0.
RETURN Win98.
END FUNCTION.
FUNCTION RunningWindowsNT4 RETURNS LOGICAL () :
/* returns TRUE if you are running Windows NT4.
I have not had a chance to test this yet */
DEFINE VARIABLE NT4 AS LOGICAL NO-UNDO.
DEFINE VARIABLE lpVersionInfo AS MEMPTR.
DEFINE VARIABLE dwPlatformID AS INTEGER NO-UNDO.
DEFINE VARIABLE MajorVersion AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
SET-SIZE(lpVersionInfo) = 148.
PUT-LONG(lpVersionInfo,1) = 148.
RUN GetVersionExA IN hpApi( GET-POINTER-VALUE(lpVersionInfo),
OUTPUT ReturnValue).
dwPlatformID = GET-LONG(lpVersionInfo,17).
MajorVersion = GET-BYTE(lpVersionInfo, 5).
NT4 = (dwPlatformId=2 AND MajorVersion=4).
SET-SIZE(lpVersionInfo) = 0.
RETURN NT4.
END FUNCTION.
FUNCTION RunningWindows2000 RETURNS LOGICAL () :
/* returns TRUE if you are running Windows 2000 */
DEFINE VARIABLE Win2000 AS LOGICAL NO-UNDO.
DEFINE VARIABLE lpVersionInfo AS MEMPTR.
DEFINE VARIABLE dwPlatformID AS INTEGER NO-UNDO.
DEFINE VARIABLE MajorVersion AS INTEGER NO-UNDO.
DEFINE VARIABLE ReturnValue AS INTEGER NO-UNDO.
SET-SIZE(lpVersionInfo) = 148.
PUT-LONG(lpVersionInfo,1) = 148.
RUN GetVersionExA IN hpApi( GET-POINTER-VALUE(lpVersionInfo),
OUTPUT ReturnValue).
dwPlatformID = GET-LONG(lpVersionInfo,17).
MajorVersion = GET-BYTE(lpVersionInfo, 5).
Win2000 = (dwPlatformId=2 AND MajorVersion=5).
SET-SIZE(lpVersionInfo) = 0.
RETURN Win2000.
END FUNCTION.
Another convenient function
Brad Long added this procedure which is indeed convenient.
FUNCTION WINGetVersion RETURNS CHARACTER () :
/*-----------------------------------------------------------------------------
Purpose: Calls the WINAPI function GetVersionExA to determine the version
of the Windows operating system that is running on the machine.
Notes: Returns "95" for Windows 95, "98" for Windows 98, "NT" for Windows NT
Returns "undef" if unable to determine platform.
------------------------------------------------------------------------------*/
DEFINE VARIABLE v_version-buf AS MEMPTR.
DEFINE VARIABLE v_platform-id AS INTEGER NO-UNDO.
DEFINE VARIABLE v_platform-desc AS CHARACTER NO-UNDO.
DEFINE VARIABLE v_major-version AS INTEGER NO-UNDO.
DEFINE VARIABLE v_minor-version AS INTEGER NO-UNDO.
DEFINE VARIABLE v_return-value AS INTEGER NO-UNDO.
SET-SIZE(v_version-buf) = 148.
PUT-LONG(v_version-buf,1) = 148.
RUN GetVersionExA (INPUT GET-POINTER-VALUE(v_version-buf),
OUTPUT v_return-value).
v_platform-id = GET-LONG(v_version-buf,17).
CASE v_platform-id:
WHEN 1 THEN DO:
v_minor-version = GET-BYTE(v_version-buf,15).
v_major-version = GET-BYTE(v_version-buf,16).
END.
OTHERWISE DO:
v_major-version = GET-LONG(v_version-buf,5).
v_minor-version = GET-LONG(v_version-buf,9).
END.
END.
CASE v_platform-id:
WHEN 0 THEN v_platform-desc = "3.1".
WHEN 1 THEN
DO:
IF v_minor-version EQ 0 THEN v_platform-desc = "95".
ELSE IF v_minor-version GT 0 THEN v_platform-desc = "98".
ELSE v_platform-desc = "undef".
END.
WHEN 2 THEN
v_platform-desc = "NT".
OTHERWISE
v_platform-desc = "undef".
END.
SET-SIZE(v_version-buf) = 0.
RETURN v_platform-desc.
END FUNCTION.