/****************************************************************************** * REXX Utility Functions - Extended (RXUTILEX.DLL) * * (C) 2011 Alex Taylor. * * * * LICENSE: * * * * Redistribution and use in source and binary forms, with or without * * modification, are permitted provided that the following conditions are * * met: * * * * 1. Redistributions of source code must retain the above copyright * * notice, this list of conditions and the following disclaimer. * * * * 2. Redistributions in binary form must reproduce the above copyright * * notice, this list of conditions and the following disclaimer in the * * documentation and/or other materials provided with the distribution. * * * * 3. The name of the author may not be used to endorse or promote products * * derived from this software without specific prior written permission. * * * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ''AS IS'' AND ANY EXPRESS OR * * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE * * DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, * * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES * * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR * * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, * * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN * * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE * * POSSIBILITY OF SUCH DAMAGE. * * * ******************************************************************************/ // Uncomment to use DosQProcStatus() instead of DosQuerySysState(). // -- This was mostly put in place for early testing to see if either function // was more/less reliable than the other. In practice, DosQuerySysState() // should probably be used. // #define USE_DQPS #define INCL_WINATOM #define INCL_WINCLIPBOARD #define INCL_WINERRORS #define INCL_DOSMISC #define INCL_DOSPROCESS #define INCL_DOSPROFILE #define INCL_DOSERRORS #define INCL_DOSMODULEMGR #ifndef OS2_INCLUDED #include #endif #include #include #include #include #include #define INCL_RXSHV #define INCL_RXFUNC #include #pragma import( DosGetPrty, "DosGetPrty", "DOSCALL1", 9 ) USHORT APIENTRY16 DosGetPrty( USHORT usScope, PUSHORT pusPriority, USHORT pid ); #ifdef USE_DQPS #pragma import( DosQProcStatus, "DosQProcStatus", "DOSCALL1", 154 ) USHORT APIENTRY16 DosQProcStatus( PVOID pBuf, USHORT cbBuf ); #endif // CONSTANTS #define SZ_LIBRARY_NAME "RXUTILEX" // Name of this library #define SZ_ERROR_NAME "SYS2ERR" // REXX variable used to store error codes #define SZ_VERSION "0.0.4" // Current version of this library // Maximum string lengths... #define US_COMPOUND_MAXZ 250 // ...of a compound variable #define US_INTEGER_MAXZ 12 // ...of an integer string #define US_STEM_MAXZ ( US_COMPOUND_MAXZ - US_INTEGER_MAXZ ) // ...of a stem #define US_ERRSTR_MAXZ 250 // ...of an error string #define US_PIDSTR_MAXZ ( CCHMAXPATH + 100 ) // ...of a process information string #define US_TIMESTR_MAXZ 256 // ...of a formatted time string #define UL_SSBUFSIZE 0xFFFF // Buffer size for the DosQuerySysState() data // Time string formats #define FL_TIME_DEFAULT 0 #define FL_TIME_ISO8601 1 #define FL_TIME_LOCALE 2 // List of functions to be registered by Sys2LoadFuncs static PSZ RxFunctionTbl[] = { "Sys2DropFuncs", "Sys2GetClipboardText", "Sys2PutClipboardText", "Sys2QueryProcess", "Sys2QueryProcessList", "Sys2KillProcess", "Sys2QueryForegroundProcess", "Sys2QueryPhysicalMemory", "Sys2FormatTime", "Sys2GetEpochTime", "Sys2ReplaceModule", "Sys2LocateDLL", "Sys2Version" }; // FUNCTION DECLARATIONS // Exported REXX functions RexxFunctionHandler Sys2LoadFuncs; RexxFunctionHandler Sys2DropFuncs; RexxFunctionHandler Sys2Version; RexxFunctionHandler Sys2FormatTime; RexxFunctionHandler Sys2GetEpochTime; RexxFunctionHandler Sys2GetClipboardText; RexxFunctionHandler Sys2PutClipboardText; // RexxFunctionHandler Sys2GetClipboardData; // RexxFunctionHandler Sys2PutClipboardData; RexxFunctionHandler Sys2QueryProcess; RexxFunctionHandler Sys2QueryProcessList; RexxFunctionHandler Sys2KillProcess; RexxFunctionHandler Sys2QueryForegroundProcess; RexxFunctionHandler Sys2QueryPhysicalMemory; RexxFunctionHandler Sys2LocateDLL; RexxFunctionHandler Sys2ReplaceModule; RexxFunctionHandler Sys2ReplaceObjectClass; // Private internal functions ULONG GetProcess( PSZ pszProgram, PSZ pszFullName, PULONG pulPID, PULONG pulPPID, PULONG pulType, PUSHORT pusPriority, PULONG pulCPU ); BOOL SaveResultString( PRXSTRING prsResult, PCH pchBytes, ULONG ulBytes ); BOOL WriteStemElement( PSZ pszStem, ULONG ulIndex, PSZ pszValue ); void WriteErrorCode( ULONG ulError, PSZ pszContext ); // MACROS #define TIME_SECONDS( timeval ) ( timeval / 32 ) #define TIME_HUNDREDTHS( timeval ) (( timeval % 32 ) * 100 / 32 ) /* ------------------------------------------------------------------------- * * Sys2LoadFuncs * * * * Register all Sys2* REXX functions (except this one, obviously). * * * * REXX ARGUMENTS: None * * REXX RETURN VALUE: "" * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2LoadFuncs( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { int entries, i; // Reset the error indicator WriteErrorCode( 0, NULL ); if ( argc > 0 ) return ( 40 ); entries = sizeof(RxFunctionTbl) / sizeof(PSZ); for ( i = 0; i < entries; i++ ) RexxRegisterFunctionDll( RxFunctionTbl[i], SZ_LIBRARY_NAME, RxFunctionTbl[i] ); MAKERXSTRING( *prsResult, "", 0 ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2DropFuncs * * * * Deregister all Sys2* REXX functions. * * * * REXX ARGUMENTS: None * * REXX RETURN VALUE: "" * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2DropFuncs( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { int entries, i; // Reset the error indicator WriteErrorCode( 0, NULL ); if ( argc > 0 ) return ( 40 ); entries = sizeof(RxFunctionTbl) / sizeof(PSZ); for ( i = 0; i < entries; i++ ) RexxDeregisterFunction( RxFunctionTbl[i] ); MAKERXSTRING( *prsResult, "", 0 ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2Version * * * * Returns the current library version. * * * * REXX ARGUMENTS: None * * REXX RETURN VALUE: Current version in the form "major.minor.refresh" * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2Version( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { CHAR szVersion[ 12 ]; // Reset the error indicator WriteErrorCode( 0, NULL ); if ( argc > 0 ) return ( 40 ); sprintf( szVersion, "%s", SZ_VERSION ); MAKERXSTRING( *prsResult, szVersion, strlen(szVersion) ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2PutClipboardText * * * * Write a string to the clipboard in plain-text format. Specifying either * * no value or an empty string in the first argument will simply clear the * * clipboard of CF_TEXT data. * * * * REXX ARGUMENTS: * * 1. String to be written to the clipboard (DEFAULT: "") * * 2. Flag indicating whether other clipboard formats should be cleared: * * Y = yes, call WinEmptyClipbrd() before writing text (DEFAULT) * * N = no, leave (non-CF_TEXT) clipboard data untouched * * * * REXX RETURN VALUE: 1 on success, 0 on failure * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2PutClipboardText( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { PSZ pszShareMem; // text in clipboard ULONG ulRC = 0, // return code ulBytes = 0, // size of input string ulPType = 0; // process-type flag BOOL fEmptyCB = TRUE, // call WinEmptyClipbrd() first? fHabTerm = TRUE; // terminate HAB ourselves? HAB hab; // anchor-block handle (for Win*) HMQ hmq; // message-queue handle PPIB ppib; // process information block PTIB ptib; // thread information block // Reset the error indicator WriteErrorCode( 0, NULL ); // Make sure we have at least one valid argument (the input string) if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) return ( 40 ); // The second argument is optional, but must be correct if specified if ( argc >= 2 ) { // second argument: flag to clear clipboard (Y/N, but also accept 0/1) if ( RXVALIDSTRING(argv[1]) ) { strupr( argv[1].strptr ); if ( strcspn(argv[1].strptr, "YN01") > 0 ) return ( 40 ); switch ( argv[1].strptr[0] ) { case 'N': case '0': fEmptyCB = FALSE; break; case 'Y': case '1': default : fEmptyCB = TRUE; break; } } else fEmptyCB = TRUE; } // Initialize the PM API DosGetInfoBlocks( &ptib, &ppib ); ulPType = ppib->pib_ultype; ppib->pib_ultype = 3; hab = WinInitialize( 0 ); if ( !hab ) { fHabTerm = FALSE; hab = 1; } /* Try to create a message-queue if one doesn't exist. We don't need to * check the result, because it could fail if a message queue already exists * (in the calling process), which is also OK. */ hmq = WinCreateMsgQueue( hab, 0); // Place the string on the clipboard as CF_TEXT ulRC = WinOpenClipbrd( hab ); if ( ulRC ) { if ( fEmptyCB ) WinEmptyClipbrd( hab ); ulBytes = argv[0].strlength + 1; ulRC = DosAllocSharedMem( (PVOID) &pszShareMem, NULL, ulBytes, PAG_READ | PAG_WRITE | PAG_COMMIT | OBJ_GIVEABLE ); if ( ulRC == 0 ) { memset( pszShareMem, 0, ulBytes ); strncpy( pszShareMem, argv[0].strptr , ulBytes - 1 ); if ( ! WinSetClipbrdData( hab, (ULONG) pszShareMem, CF_TEXT, CFI_POINTER )) WriteErrorCode( ERRORIDERROR(WinGetLastError(hab)), "WinSetClipbrdData"); else MAKERXSTRING( *prsResult, "", 0 ); } else { WriteErrorCode( ulRC, "DosAllocSharedMem"); MAKERXSTRING( *prsResult, "", 0 ); } WinCloseClipbrd( hab ); } else { WriteErrorCode( ulRC, "WinOpenClipbrd"); MAKERXSTRING( *prsResult, "", 0 ); } if ( hmq != NULLHANDLE ) WinDestroyMsgQueue( hmq ); if ( fHabTerm ) WinTerminate( hab ); ppib->pib_ultype = ulPType; return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2GetClipboardText * * * * Retrieve a plain-text string from the clipboard if one is available. * * * * REXX ARGUMENTS: * * None. * * * * REXX RETURN VALUE: The retrieved clipboard string * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2GetClipboardText( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { PSZ pszClipText, // pointer to clipboard data pszLocalText; // our copy of the data (to return) ULONG ulRC = 0, // return code ulBytes = 0, // size in bytes of output string ulPType = 0; // process-type flag BOOL fHabTerm = TRUE; // terminate HAB ourselves? HAB hab; // anchor-block handle (for Win*) HMQ hmq; // message-queue handle PPIB ppib; // process information block PTIB ptib; // thread information block // Reset the error indicator WriteErrorCode( 0, NULL ); // Initialize the PM API DosGetInfoBlocks( &ptib, &ppib ); ulPType = ppib->pib_ultype; ppib->pib_ultype = 3; hab = WinInitialize( 0 ); if ( !hab ) { fHabTerm = FALSE; hab = 1; } /* Note: A message-queue must exist before we can access the clipboard. We * don't actually use the returned value. In fact, we don't even * verify it, because it could be NULLHANDLE if this function was * called from a PM process (e.g. VX-REXX) - in which case, a message * queue should already exist, and we can proceed anyway. */ hmq = WinCreateMsgQueue( hab, 0 ); // Open the clipboard ulRC = WinOpenClipbrd( hab ); if ( ulRC ) { // Read plain text from the clipboard, if available if (( pszClipText = (PSZ) WinQueryClipbrdData( hab, CF_TEXT )) != NULL ) { ulBytes = strlen( pszClipText ) + 1; if (( pszLocalText = (PSZ) malloc( ulBytes )) != NULL ) { memset( pszLocalText, 0, ulBytes ); strncpy( pszLocalText, pszClipText, ulBytes - 1 ); if ( ! SaveResultString( prsResult, pszLocalText, ulBytes - 1 )) { MAKERXSTRING( *prsResult, "", 0 ); } free( pszLocalText ); } else { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc"); MAKERXSTRING( *prsResult, "", 0 ); } } else { // Either no text exists, or clipboard is not readable MAKERXSTRING( *prsResult, "", 0 ); } WinCloseClipbrd( hab ); } else { WriteErrorCode( ulRC, "WinOpenClipbrd"); MAKERXSTRING( *prsResult, "", 0 ); } if ( hmq != NULLHANDLE ) WinDestroyMsgQueue( hmq ); if ( fHabTerm ) WinTerminate( hab ); ppib->pib_ultype = ulPType; return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2QueryProcess * * * * Queries information about the specified process. * * * * REXX ARGUMENTS: * * 1. The process identifier (program name or process ID) (REQUIRED) * * 2. Flag indicicating the identifier type: * * 'P': decimal process ID * * 'H': hexadecimal process ID * * 'N': executable program name (with or without extension) (DEFAULT) * * * * REXX RETURN VALUE: * * A string of the format * * pid parent-pid process-type priority cpu-time executable-name * * "priority" is in hexadecimal notation, all other numbers are decimal. * * "" is returned if the process was not found or if an internal error * * occurred. * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2QueryProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { PSZ pszProcName; // Requested process name UCHAR szFullName[ CCHMAXPATH ] = {0}, // Fully-qualified name szReturn[ US_PIDSTR_MAXZ ] = {0}; // Buffer for return value ULONG ulPID = 0, // Process ID ulPPID = 0, // Parent process ID ulType = 0, // Process type ulTime = 0; // Process CPU time USHORT usPrty = 0; // Process priority APIRET rc; // API return code // Reset the error indicator WriteErrorCode( 0, NULL ); // Make sure we have at least one valid argument (the input string) if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) return ( 40 ); // Parse the ID type flag if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) { strupr( argv[1].strptr ); if (strcspn(argv[1].strptr, "HNP") > 0 ) return ( 40 ); switch ( argv[1].strptr[0] ) { case 'H': if (( sscanf( argv[0].strptr, "%X", &ulPID )) != 1 ) return ( 40 ); pszProcName = NULL; break; case 'P': if (( sscanf( argv[0].strptr, "%u", &ulPID )) != 1 ) return ( 40 ); pszProcName = NULL; break; default : pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) ); if ( pszProcName == NULL ) { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) ); break; } } else { pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) ); if ( pszProcName == NULL ) { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) ); } // See if the requested process is running and get its PID/PPID rc = GetProcess( pszProcName, szFullName, &ulPID, &ulPPID, &ulType, &usPrty, &ulTime ); if (( rc != NO_ERROR ) || ( ulPID == 0 )) { MAKERXSTRING( *prsResult, "", 0 ); return ( 0 ); } sprintf( szReturn, "%u %u %u %04X %02u:%02u.%02u %s", ulPID, ulPPID, ulType, usPrty, TIME_SECONDS( ulTime ) / 60, TIME_SECONDS( ulTime ) % 60, TIME_HUNDREDTHS( ulTime ), szFullName ); MAKERXSTRING( *prsResult, szReturn, strlen(szReturn) ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2KillProcess * * * * Terminate the (first) running process with the specified executable name * * or process-ID. * * * * REXX ARGUMENTS: * * 1. The process identifier (program name or process ID) (REQUIRED) * * 2. Flag indicicating the identifier type: * * 'P': decimal process ID * * 'H': hexadecimal process ID * * 'N': executable program name (with or without extension) (DEFAULT) * * * * REXX RETURN VALUE: 1 on success or 0 on failure. * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2KillProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { PSZ pszProcName; // Requested process name UCHAR szFullName[ CCHMAXPATH ] = {0}; // Fully-qualified name ULONG ulPID = 0, // Process ID ulPPID = 0, // Parent process ID (not used) ulType = 0, // Process type (not used) ulTime = 0; // Process CPU time (not used) USHORT usPrty = 0; // Process priority (not used) APIRET rc; // API return code // Reset the error indicator WriteErrorCode( 0, NULL ); // Make sure we have at least one valid argument (the input string) if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) return ( 40 ); // Parse the ID type flag if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) { strupr( argv[1].strptr ); if (strcspn(argv[1].strptr, "HNP") > 0 ) return ( 40 ); switch ( argv[1].strptr[0] ) { case 'H': if (( sscanf( argv[0].strptr, "%X", &ulPID )) != 1 ) return ( 40 ); pszProcName = NULL; break; case 'P': if (( sscanf( argv[0].strptr, "%u", &ulPID )) != 1 ) return ( 40 ); pszProcName = NULL; break; default : pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) ); if ( pszProcName == NULL ) { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) ); break; } } else { pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) ); if ( pszProcName == NULL ) { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) ); } if ( pszProcName != NULL ) { // Get the process PID rc = GetProcess( pszProcName, szFullName, &ulPID, &ulPPID, &ulType, &usPrty, &ulTime ); if (( rc != NO_ERROR ) || ( ulPID == 0 )) { MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } } // Now attempt to kill the process using DosKillProcess() rc = DosKillProcess( 1, ulPID ); if ( rc != NO_ERROR ) { WriteErrorCode( rc, "DosKillProcess"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } MAKERXSTRING( *prsResult, "1", 1 ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2QueryProcessList * * * * Gets the process ID of the specified executable, if it is running. * * The results will be returned in a stem variable, where stem.0 contains * * number of items, and each stem item is a string of the form: * * pid parent-pid process-type priority cpu-time executable-name * * "priority" is in hexadecimal notation, all other numbers are decimal. * * * * Notes: * * - "process-type" will be one of: * * 0 Full screen protect-mode session * * 1 Requires real mode. Dos emulation. * * 2 VIO windowable protect-mode session * * 3 Presentation Manager protect-mode session * * 4 Detached protect-mode process. * * - If "priority" is 0 then the priority class could not be determined. * * - If "executable-name" is "--" then the name could not be identified. * * * * REXX ARGUMENTS: * * 1. The name of the stem in which to return the results (REQUIRED) * * * * REXX RETURN VALUE: Number of processes found, or "" in case of error. * * ------------------------------------------------------------------------- */ ULONG Sys2QueryProcessList( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { #ifdef USE_DQPS QSPTRREC *pBuf; // Data returned by DosQProcStatus() #else QSGREC **pBuf; // Data returned by DosQuerySysState() #endif QSPREC *pPrec; // Pointer to process information block QSTREC *pTrec; // Pointer to thread information block CHAR szStem[ US_STEM_MAXZ ], // Buffers used for building strings ... szNumber[ US_INTEGER_MAXZ ], // ... szName[ CCHMAXPATH ], // Fully-qualified name of process szPInfo[ US_PIDSTR_MAXZ ]; // Stem item string ULONG ulCount, // Number of processes ulCPU; // Process CPU time USHORT usPriority, // Process priority class i; // Loop counter APIRET rc; // Return code // Reset the error indicator WriteErrorCode( 0, NULL ); // Do some validity checking on the arguments if (( argc != 1 ) || // Make sure we have exactly one argument... ( ! RXVALIDSTRING(argv[0]) ) || // ...which is a valid REXX string... ( RXSTRLEN(argv[0]) > US_STEM_MAXZ )) // ...and isn't too long. return ( 40 ); // Generate the stem variable name from the argument (stripping any final dot) if ( argv[0].strptr[ argv[0].strlength-1 ] == '.') argv[0].strlength--; strncpy( szStem, argv[0].strptr, RXSTRLEN(argv[0]) ); szStem[ RXSTRLEN(argv[0]) ] = '\0'; #ifdef USE_DQPS pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE ); #else pBuf = (QSGREC **) malloc( UL_SSBUFSIZE ); #endif if ( pBuf == NULL ) { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc"); MAKERXSTRING( *prsResult, "", 0 ); return ( 0 ); } #ifdef USE_DQPS // Get running process information using DosQProcStatus() rc = DosQProcStatus( pBuf, UL_SSBUFSIZE ); if ( rc != NO_ERROR ) { WriteErrorCode( rc, "DosQProcStatus"); MAKERXSTRING( *prsResult, "", 0 ); return ( 0 ); } pPrec = pBuf->pProcRec; #else // Get running process information using DosQuerySysState() rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE ); if ( rc != NO_ERROR ) { WriteErrorCode( rc, "DosQuerySysState"); MAKERXSTRING( *prsResult, "", 0 ); return ( 0 ); } pPrec = (QSPREC *) ( (PBYTE) (*pBuf) + sizeof(QSGREC) ); #endif // Now get the list of processes ulCount = 0; while ( pPrec->RecType == 1 ) { ulCount++; // Get the program name of each process (including path) if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR ) sprintf( szName, "--"); if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR ) usPriority = 0; // Get the CPU time of the process by querying each of its threads ulCPU = 0; pTrec = pPrec->pThrdRec; for ( i = 0; i < pPrec->cTCB; i++ ) { ulCPU += ( pTrec->systime + pTrec->usertime ); pTrec++; } // Now generate the stem item with all of this information sprintf( szPInfo, "%u %u %u %04X %02u:%02u.%02u %s", pPrec->pid, // PID pPrec->ppid, // Parent PID pPrec->type, // Process type usPriority, // Priority class TIME_SECONDS( ulCPU ) / 60, // CPU time (hours) TIME_SECONDS( ulCPU ) % 60, // CPU time (minutes) TIME_HUNDREDTHS( ulCPU ), // CPU time (seconds) szName ); // Executable name & path WriteStemElement( szStem, ulCount, szPInfo ); pPrec = (QSPREC *) ( (PBYTE) (pPrec->pThrdRec) + ( pPrec->cTCB * sizeof(QSTREC) ) ); } // Create the "0" stem element with the number of processes found sprintf( szNumber, "%d", ulCount ); WriteStemElement( szStem, 0, szNumber ); // And also return the number of processes as the REXX return string MAKERXSTRING( *prsResult, szNumber, strlen(szNumber) ); free( pBuf ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2QueryPhysicalMemory * * * * Queries the amount of physical memory (RAM) installed in the system. * * * * REXX ARGUMENTS: None * * * * REXX RETURN VALUE: * * Integer representing the amount of installed memory, in KiB, or 0 if an * * error occurred. * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2QueryPhysicalMemory( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { CHAR szMemSize[ US_INTEGER_MAXZ ]; ULONG ulMemBytes = 0, ulMemKBytes = 0; APIRET rc = 0; // Reset the error indicator WriteErrorCode( 0, NULL ); // Make sure we have no arguments if ( argc > 0 ) return ( 40 ); // Query installed memory in bytes rc = DosQuerySysInfo( QSV_TOTPHYSMEM, QSV_TOTPHYSMEM, &ulMemBytes, sizeof(ulMemBytes) ); if ( rc != NO_ERROR ) { WriteErrorCode( rc, "DosQuerySysInfo"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } // Convert to binary kilobytes (any remainder is discarded) ulMemKBytes = ulMemBytes / 1024; sprintf( szMemSize, "%u", ulMemKBytes ); // Return the memory size as the REXX return string MAKERXSTRING( *prsResult, szMemSize, strlen(szMemSize) ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2QueryForegroundProcess * * * * Queries the PID of the current foreground process. * * * * REXX ARGUMENTS: None * * * * REXX RETURN VALUE: * * Integer representing the process ID (in decimal), or 0 if an error * * occurred. * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2QueryForegroundProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { CHAR szPID[ US_INTEGER_MAXZ ]; ULONG ulPID = 0; APIRET rc = 0; // Reset the error indicator WriteErrorCode( 0, NULL ); // Make sure we have no arguments if ( argc > 0 ) return ( 40 ); // Query installed memory in bytes rc = DosQuerySysInfo( QSV_FOREGROUND_PROCESS, QSV_FOREGROUND_PROCESS, &ulPID, sizeof(ulPID) ); if ( rc != NO_ERROR ) { WriteErrorCode( rc, "DosQuerySysInfo"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } sprintf( szPID, "%u", ulPID ); // Return the PID as the REXX return string MAKERXSTRING( *prsResult, szPID, strlen(szPID) ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2ReplaceModule * * * * Unlocks and optionally replaces an in-use (locked) DLL or EXE. * * * * REXX ARGUMENTS: * * 1. The filespec of the module to be replaced. (REQUIRED) * * 2. The filespec of the new module to replace it with. (DEFAULT: none) * * 3. The filespec of the backup file to be created. (DEFAULT: none) * * * * REXX RETURN VALUE: * * 1 on success, or 0 if an error occurred. * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2ReplaceModule( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { PSZ pszOldModule = NULL, pszNewModule = NULL, pszBackup = NULL; APIRET rc = 0; // Reset the error indicator WriteErrorCode( 0, NULL ); // Make sure we have at least one valid argument (the module name) if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) return ( 40 ); pszOldModule = calloc( argv[0].strlength + 1, sizeof(UCHAR) ); if ( pszOldModule == NULL ) { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } strncpy( pszOldModule, argv[0].strptr, argv[0].strlength ); // Second argument: new module name (optional, but must be correct if specified) if ( argc >= 2 ) { if ( RXVALIDSTRING(argv[1]) ) { pszNewModule = calloc( argv[1].strlength + 1, sizeof(char) ); if ( pszNewModule == NULL ) { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } strncpy( pszNewModule, argv[1].strptr, argv[1].strlength ); } else return ( 40 ); } // Third argument: backup filename (optional, but must be correct if specified) if ( argc >= 3 ) { if ( RXVALIDSTRING(argv[2]) ) { pszBackup = calloc( argv[2].strlength + 1, sizeof(char) ); if ( pszBackup == NULL ) { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } strncpy( pszBackup, argv[2].strptr, argv[2].strlength ); } else return ( 40 ); } // Now replace the module using DosReplaceModule rc = DosReplaceModule( pszOldModule, pszNewModule, pszBackup ); if ( rc != NO_ERROR ) { WriteErrorCode( rc, "DosReplaceModule"); MAKERXSTRING( *prsResult, "0", 1 ); return ( 0 ); } // Return 1 on success MAKERXSTRING( *prsResult, "1", 1 ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2FormatTime * * * * Convert a number of seconds from the epoch (1970-01-01 0:00:00 UTC) into * * a formatted date and time string. * * * * REXX ARGUMENTS: * * 1. Number of seconds (a positive integer) to be converted. (REQUIRED) * * 2. Format type, one of: * * D = return in the form 'yyyy-mm-dd hh:mm:ss (w)' where w * * represents the weekday (0-6 where 0=Sunday) (DEFAULT) * * I = return in ISO8601 combined form 'yyyy-mm-ddThh:mm:ss[Z]' * * L = return in the form 'day month year (weekday) time' where month * * and weekday are language-dependent abbreviations * * Note: With D and I, time is returned in 24-hour format; L may vary. * * 3. TZ conversion flag (indicates whether to convert to UTC from local * * time), one of: * * U = return in Coordinated Universal Time * * L = convert to local time using the current TZ (DEFAULT) * * * * REXX RETURN VALUE: The formatted time string, or '' on error. * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2FormatTime( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { UCHAR szFormat[ US_TIMESTR_MAXZ ] = {0}, // strftime() format specifier szTime[ US_TIMESTR_MAXZ ] = {0}; // Formatted time string BYTE flFormat = FL_TIME_DEFAULT; // Time format flag BOOL fUTC = FALSE; // UTC/local conversion flag PSZ pszTZ, // Pointer to TZ environment var pszSetTZ; time_t ttSeconds; // Input timestamp (seconds) struct tm *timeptr; // Timestamp structure size_t stRC; // return code from strftime() // Reset the error indicator WriteErrorCode( 0, NULL ); // All arguments are optional but must be correct if specified if ( argc >= 1 && RXVALIDSTRING(argv[0]) ) { // first argument: epoch time value if (( sscanf( argv[0].strptr, "%d", &ttSeconds )) != 1 ) return ( 40 ); } if ( argc >= 2 ) { // second argument: format flag if ( RXVALIDSTRING(argv[1]) ) { strupr( argv[1].strptr ); if ( strcspn(argv[1].strptr, "DIL") > 0 ) return ( 40 ); switch ( argv[1].strptr[0] ) { case 'I': flFormat = FL_TIME_ISO8601; break; case 'L': flFormat = FL_TIME_LOCALE; break; default : flFormat = FL_TIME_DEFAULT; break; } } } if ( argc >= 3 ) { // third argument: conversion flag if ( RXVALIDSTRING(argv[2]) ) { strupr( argv[2].strptr ); if ( strcspn(argv[2].strptr, "UL") > 0 ) return ( 40 ); switch ( argv[2].strptr[0] ) { case 'U': fUTC = TRUE; break; default : fUTC = FALSE; break; } } } /* These next 4 lines really shouldn't be necessary, but without them * getenv() and (apparently) tzset() may see the value of TZ as NULL * if the environment variable was changed in the REXX script. */ DosScanEnv("TZ", &pszTZ ); pszSetTZ = (PSZ) malloc( strlen( pszTZ ) + 5 ); sprintf( pszSetTZ, "TZ=%s", pszTZ ); putenv( pszSetTZ ); // Use the locale and timezone settings from the environment tzset(); setlocale( LC_TIME, ""); if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) { ttSeconds = time( NULL ); if ( ttSeconds == -1 ) { WriteErrorCode( ttSeconds, "time"); MAKERXSTRING( *prsResult, "", 0 ); return 0; } } if ( fUTC ) { timeptr = gmtime( &ttSeconds ); if ( !timeptr ) { WriteErrorCode( 1, "gmtime"); MAKERXSTRING( *prsResult, "0", 1 ); return 0; } } else { timeptr = localtime( &ttSeconds ); if ( !timeptr ) { WriteErrorCode( 1, "localtime"); MAKERXSTRING( *prsResult, "0", 1 ); return 0; } } switch ( flFormat ) { default: case FL_TIME_DEFAULT: sprintf( szFormat, "%%Y-%%m-%%d %%T (%%w)"); break; case FL_TIME_ISO8601: sprintf( szFormat, "%%Y-%%m-%%dT%%T"); if ( fUTC ) strcat( szFormat, "Z"); break; case FL_TIME_LOCALE: sprintf( szFormat, "%%e %%b %%Y (%%a) %%X"); break; } stRC = strftime( szTime, US_TIMESTR_MAXZ-1, szFormat, timeptr ); if ( stRC == NO_ERROR ) { WriteErrorCode( stRC, "strftime"); MAKERXSTRING( *prsResult, "", 0 ); return ( 0 ); } // Return the formatted time string MAKERXSTRING( *prsResult, szTime, strlen(szTime) ); free( pszSetTZ ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2GetEpochTime * * * * Convert formatted date and time into a number of seconds (UTC) from the * * epoch (defined as 1970-01-01 0:00:00). The input time is assumed to * * refer to the current timezone as defined in the TZ environment variable. * * * * If no parameters are specified, the current system time is used. If at * * least one parameter is specified, then any missing parameter is assumed * * to be its minimum possible value. * * * * Due to limitations in time_t, dates later than 2037 are not supported; * * the IBM library seems to convert them all to January 1 1970 00:00:00 UTC. * * * * REXX ARGUMENTS: * * 1. The year (0-99 or 1970+) (value <70 is assumed to be 20xx) * * 2. The month (1-12) * * 3. The day (1-31) * * 4. Hours (0-23) * * 5. Minutes (0-59) * * 6. Seconds (0-61) * * * * REXX RETURN VALUE: The number of seconds since the epoch, or 0 on error. * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2GetEpochTime( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { ULONG ulYear = 1970, // Input year ulMonth = 1, // Input month ulDay = 1, // Input day ulHour = 0, // Input hours ulMin = 0, // Input minutes ulSec = 0; // Input seconds BOOL fYear = FALSE, // Year parameter specified? fMonth = FALSE, // Month parameter specified? fDay = FALSE, // Day parameter specified? fHour = FALSE, // Hours parameter specified? fMin = FALSE, // Minutes parameter specified? fSec = FALSE; // Seconds parameter specified? //SHORT sDST = 0; // Input time is DST? time_t timeval; // Calculated epoch time struct tm tsTime = {0}; // Time structure for mktime() UCHAR szEpochTime[ US_INTEGER_MAXZ ]; // Output string PSZ pszTZ, pszSetTZ; // Reset the error indicator WriteErrorCode( 0, NULL ); // Parse the various time items if ( argc >= 1 && RXVALIDSTRING(argv[0]) ) { if (( sscanf( argv[0].strptr, "%u", &ulYear )) != 1 ) return ( 40 ); if ( ulYear < 100 ) { ulYear += (ulYear < 70) ? 2000 : 1900; } if ( ulYear < 1970 ) return ( 40 ); fYear = TRUE; } if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) { if (( sscanf( argv[1].strptr, "%u", &ulMonth )) != 1 ) return ( 40 ); if ( ulMonth < 1 || ulMonth > 12 ) return ( 40 ); fMonth = TRUE; } if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) { if (( sscanf( argv[2].strptr, "%u", &ulDay )) != 1 ) return ( 40 ); if ( ulDay < 1 || ulDay > 31 ) return ( 40 ); fDay = TRUE; } if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) { if (( sscanf( argv[3].strptr, "%u", &ulHour )) != 1 ) return ( 40 ); if ( ulHour > 23 ) return ( 40 ); fHour = TRUE; } if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) { if (( sscanf( argv[4].strptr, "%u", &ulMin )) != 1 ) return ( 40 ); if ( ulMin > 59 ) return ( 40 ); fMin = TRUE; } if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) { if (( sscanf( argv[5].strptr, "%u", &ulSec )) != 1 ) return ( 40 ); if ( ulSec > 61 ) return ( 40 ); fSec = TRUE; } if ( argc >= 7 ) return ( 40 ); /* // Parse the conversion flag if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) { strupr( argv[6].strptr ); if ( strcspn(argv[6].strptr, "SD") > 0 ) return ( 40 ); switch ( argv[6].strptr[0] ) { case 'S': sDST = 0; break; case 'D': sDST = 1; break; default : sDST = -1; break; } } */ /* These next 4 lines really shouldn't be necessary, but without them * getenv() and (apparently) tzset() may see the value of TZ as NULL * if the environment variable was changed in the REXX script. */ DosScanEnv("TZ", &pszTZ ); pszSetTZ = (PSZ) malloc( strlen( pszTZ ) + 5 ); sprintf( pszSetTZ, "TZ=%s", pszTZ ); putenv( pszSetTZ ); // This seems to conflict with time() under some shells -AT tzset(); // Use the locale settings from the environment setlocale( LC_TIME, ""); if ( !fYear && !fMonth && !fDay && !fHour && !fMin && !fSec ) { timeval = time( NULL ); if ( timeval == -1 ) { WriteErrorCode( timeval, "time"); MAKERXSTRING( *prsResult, "0", 1 ); return 0; } } else { //printf("TZ=%s\n", getenv("TZ")); tsTime.tm_sec = ulSec; tsTime.tm_min = ulMin; tsTime.tm_hour = ulHour; tsTime.tm_mday = ulDay; tsTime.tm_mon = ulMonth - 1; tsTime.tm_year = ulYear - 1900; tsTime.tm_isdst = -1; timeval = mktime( &tsTime ); if ( timeval == -1 ) { WriteErrorCode( timeval, "mktime"); MAKERXSTRING( *prsResult, "0", 1 ); return 0; } } // Return the calculated time value sprintf( szEpochTime, "%u", timeval ); MAKERXSTRING( *prsResult, szEpochTime, strlen(szEpochTime) ); free( pszSetTZ ); return ( 0 ); } /* ------------------------------------------------------------------------- * * Sys2LocateDLL * * * * Search for an installed or loaded DLL by module name. * * Code derived from 'whichdll' by Alessandro Cantatore (public domain). * * * * REXX ARGUMENTS: * * 1. The name of the DLL to search for. (REQUIRED) * * * * REXX RETURN VALUE: * * The fully-qualified path of the DLL, if found (or '' if not found). * * ------------------------------------------------------------------------- */ ULONG APIENTRY Sys2LocateDLL( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult ) { HMODULE hmod; CHAR achModuleName[ CCHMAXPATH ]; BOOL bUnload = FALSE; APIRET rc; // Reset the error indicator WriteErrorCode( 0, NULL ); // Parse the various time items if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 ); // See if the DLL is already loaded rc = DosQueryModuleHandle( argv[0].strptr, &hmod ); if ( rc ) { // Guess not; try to load it now rc = DosLoadModule( NULL, 0, argv[0].strptr, &hmod ); if ( rc ) { WriteErrorCode( rc, "DosLoadModule"); MAKERXSTRING( *prsResult, "", 0 ); return 0; } bUnload = TRUE; } // Get the full path name of the DLL rc = DosQueryModuleName( hmod, CCHMAXPATH, achModuleName ); if ( rc ) { WriteErrorCode( rc, "DosQueryModuleName"); MAKERXSTRING( *prsResult, "", 0 ); if ( bUnload ) DosFreeModule( hmod ); return 0; } // Free the module if we loaded it ourselves if ( bUnload ) DosFreeModule( hmod ); // Return the full path name if ( ! SaveResultString( prsResult, achModuleName, strlen( achModuleName ))) { MAKERXSTRING( *prsResult, "", 0 ); } return 0; } // ------------------------------------------------------------------------- // INTERNAL FUNCTIONS // ------------------------------------------------------------------------- /* ------------------------------------------------------------------------- * * GetProcess * * * * Gets information about the specified process (if found). If pszProgram * * is NULL, the search is done on the process ID in pulPID; otherwise, the * * search is done on the executable name in pszProgram (which may or may not * * include the extension). * * * * ARGUMENTS: * * PSZ pszProgram : The requested executable (process name). (I) * * PSZ pszFullName: The returned fully-qualified process name. (O) * * PULONG pulPID : The process ID. (IO) * * PULONG pulPPID : The returned process parent ID. (O) * * PULONG pulType : The returned process type. (O) * * PUSHORT pusPriority: The returned process priority. (O) * * PULONG pulCPU : The returned process CPU time. (O) * * * * RETURNS: ULONG * * 0 on success, or a non-zero API return code in the case of an error. * * ------------------------------------------------------------------------- */ ULONG GetProcess( PSZ pszProgram, PSZ pszFullName, PULONG pulPID, PULONG pulPPID, PULONG pulType, PUSHORT pusPriority, PULONG pulCPU ) { #ifdef USE_DQPS QSPTRREC *pBuf; // Data returned by DosQProcStatus() #else QSGREC **pBuf; // Data returned by DosQuerySysState() #endif QSPREC *pPrec; // Pointer to process information block QSTREC *pTrec; // Pointer to thread information block CHAR szName[ CCHMAXPATH ] = {0}, // Fully-qualified name of process szNoExt[ CCHMAXPATH ] = {0}; // Program name without extension PSZ pszCurrent, // Program name of a queried process c; // Pointer to substring ULONG ulCPU; // Process CPU time USHORT usPriority, // Process priority class i; // index BOOL fMatch = FALSE; // The current process is a match? APIRET rc; // Return code #ifdef USE_DQPS pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE ); #else pBuf = (QSGREC **) malloc( UL_SSBUFSIZE ); #endif if ( pBuf == NULL ) { WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc"); return ( ERROR_NOT_ENOUGH_MEMORY ); } #ifdef USE_DQPS // Get running process information using DosQProcStatus() rc = DosQProcStatus( pBuf, UL_SSBUFSIZE ); if ( rc != NO_ERROR ) { WriteErrorCode( rc, "DosQProcStatus"); return ( rc ); } pPrec = pBuf->pProcRec; #else // Get running process information using DosQuerySysState() rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE ); if ( rc != NO_ERROR ) { WriteErrorCode( rc, "DosQuerySysState"); return ( rc ); } pPrec = (QSPREC *) ( (PBYTE) (*pBuf) + sizeof(QSGREC) ); #endif *pulPPID = 0; *pulType = 0; *pusPriority = 0; *pulCPU = 0; if ( pszProgram != NULL ) *pulPID = 0; else if ( *pulPID == 0 ) return 0; // Now look for the specified process while (( pPrec->RecType == 1 ) && ( !fMatch )) { if ( pszProgram == NULL ) { if ( pPrec->pid == *pulPID ) { fMatch = TRUE; // Get the program name if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR ) sprintf( pszFullName, "--"); else strcpy( pszFullName, szName ); // Get the process priority if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR ) usPriority = 0; // Get the CPU time of the process by querying each of its threads ulCPU = 0; pTrec = pPrec->pThrdRec; for ( i = 0; i < pPrec->cTCB; i++ ) { ulCPU += ( pTrec->systime + pTrec->usertime ); pTrec++; } *pulPPID = pPrec->ppid; *pulType = pPrec->type; *pusPriority = usPriority; *pulCPU = ulCPU; } } else { // Get the program name (without the path) if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR ) sprintf( pszCurrent, "--"); else pszCurrent = strrchr( szName, '\\') + 1; // Create a copy without the extension strcpy( szNoExt, pszCurrent ); if (( c = strrchr( szNoExt, '.')) != NULL ) memset( c, 0, strlen(c) ); if (( pszCurrent != NULL ) && (( stricmp(pszCurrent, pszProgram) == 0 ) || ( stricmp(szNoExt, pszProgram) == 0 ))) { fMatch = TRUE; // Get the process priority if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR ) usPriority = 0; // Get the CPU time of the process by querying each of its threads ulCPU = 0; pTrec = pPrec->pThrdRec; for ( i = 0; i < pPrec->cTCB; i++ ) { ulCPU += ( pTrec->systime + pTrec->usertime ); pTrec++; } *pulPID = pPrec->pid; *pulPPID = pPrec->ppid; *pulType = pPrec->type; *pusPriority = usPriority; *pulCPU = ulCPU; strcpy( pszFullName, szName ); } } pPrec = (QSPREC *) ( (PBYTE) (pPrec->pThrdRec) + ( pPrec->cTCB * sizeof(QSTREC) ) ); } if ( !fMatch ) *pulPID = 0; free( pBuf ); return ( 0 ); } /* ------------------------------------------------------------------------- * * SaveResultString * * * * Writes new string contents to the specified RXSTRING, allocating any * * additional memory that may be required. If the string to be written has * * zero length, nothing is done. * * * * This function should be used in place of MAKERXSTRING if there is a * * possibility that the string contents could be longer than 256 characters. * * * * ARGUMENTS: * * PRXSTRING prsResult: Pointer to an existing RXSTRING for writing. * * PCH pchBytes : The string contents to write to prsResult. * * ULONG ulBytes : The number of bytes in pchBytes to write. * * * * RETURNS: BOOL * * TRUE if prsResult was successfully updated. FALSE otherwise. * * ------------------------------------------------------------------------- */ BOOL SaveResultString( PRXSTRING prsResult, PCH pchBytes, ULONG ulBytes ) { ULONG ulRC; PCH pchNew; if ( ulBytes == 0 ) return ( FALSE ); if ( ulBytes > 256 ) { // REXX provides 256 bytes by default; allocate more if necessary ulRC = DosAllocMem( (PVOID) &pchNew, ulBytes, PAG_WRITE | PAG_COMMIT ); if ( ulRC != 0 ) { WriteErrorCode( ulRC, "DosAllocMem"); return ( FALSE ); } DosFreeMem( prsResult->strptr ); prsResult->strptr = pchNew; } memcpy( prsResult->strptr, pchBytes, ulBytes ); prsResult->strlength = ulBytes; return ( TRUE ); } /* ------------------------------------------------------------------------- * * WriteStemElement * * * * Creates a stem element (compound variable) in the calling REXX program * * using the REXX shared variable pool interface. * * * * ARGUMENTS: * * PSZ pszStem : The name of the stem (before the '.') * * ULONG ulIndex : The number of the stem element (after the '.') * * PSZ pszValue : The value to write to the compound variable. * * * * RETURNS: BOOL * * TRUE on success, FALSE on failure. * * ------------------------------------------------------------------------- */ BOOL WriteStemElement( PSZ pszStem, ULONG ulIndex, PSZ pszValue ) { SHVBLOCK shvVar; // REXX shared variable pool block ULONG ulRc, ulBytes; CHAR szCompoundName[ US_COMPOUND_MAXZ ], *pchValue; sprintf( szCompoundName, "%s.%d", pszStem, ulIndex ); if ( pszValue == NULL ) { pchValue = ""; ulBytes = 0; } else { ulBytes = strlen( pszValue ); ulRc = DosAllocMem( (PVOID) &pchValue, ulBytes + 1, PAG_WRITE | PAG_COMMIT ); if ( ulRc != 0 ) { WriteErrorCode( ulRc, "DosAllocMem"); return FALSE; } memcpy( pchValue, pszValue, ulBytes ); } MAKERXSTRING( shvVar.shvname, szCompoundName, strlen(szCompoundName) ); shvVar.shvvalue.strptr = pchValue; shvVar.shvvalue.strlength = ulBytes; shvVar.shvnamelen = RXSTRLEN( shvVar.shvname ); shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue ); shvVar.shvcode = RXSHV_SYSET; shvVar.shvnext = NULL; ulRc = RexxVariablePool( &shvVar ); if ( ulRc > 1 ) { WriteErrorCode( shvVar.shvret, "RexxVariablePool (SHVBLOCK.shvret)"); return FALSE; } return TRUE; } /* ------------------------------------------------------------------------- * * WriteErrorCode * * * * Writes an error code to a special variable in the calling REXX program * * using the REXX shared variable pool interface. This is used to return * * API error codes to the REXX program, since the REXX functions themselves * * normally return string values. * * * * ARGUMENTS: * * ULONG ulError : The error code returned by the failing API call. * * PSZ pszContext: A string describing the API call that failed. * * * * RETURNS: N/A * * ------------------------------------------------------------------------- */ void WriteErrorCode( ULONG ulError, PSZ pszContext ) { SHVBLOCK shvVar; // REXX shared variable pool block ULONG ulRc; CHAR szErrorText[ US_ERRSTR_MAXZ ]; if ( pszContext == NULL ) sprintf( szErrorText, "%X", ulError ); else sprintf( szErrorText, "%X: %s", ulError, pszContext ); MAKERXSTRING( shvVar.shvname, SZ_ERROR_NAME, strlen(SZ_ERROR_NAME) ); MAKERXSTRING( shvVar.shvvalue, szErrorText, strlen(szErrorText) ); shvVar.shvnamelen = RXSTRLEN( shvVar.shvname ); shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue ); shvVar.shvcode = RXSHV_SYSET; shvVar.shvnext = NULL; ulRc = RexxVariablePool( &shvVar ); if ( ulRc > 1 ) printf("Unable to set %s: rc = %d\n", shvVar.shvname.strptr, shvVar.shvret ); }