source: rxutilex/trunk/rxutilex.c@ 42

/******************************************************************************
 * REXX Utility Functions - Extended (RXUTILEX.DLL)                           *
 * (C) 2011, 2017 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

// Uncomment to use legacy C style locale data instead of the OS/2 ULS library
// #define LEGACY_C_LOCALE

#define INCL_WINATOM
#define INCL_WINCLIPBOARD
#define INCL_WINERRORS
#define INCL_WINSYS
#define INCL_DOS
#define INCL_DOSDEVIOCTL
#define INCL_DOSERRORS
#define INCL_DOSMISC
#define INCL_DOSMODULEMGR
#define INCL_DOSNMPIPES
#define INCL_DOSPROCESS
#define INCL_DOSPROFILE
#define INCL_LONGLONG
#ifndef OS2_INCLUDED
    #include <os2.h>
#endif

#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <locale.h>

#ifdef LEGACY_C_LOCALE
    #include <nl_types.h>
    #include <langinfo.h>
#else
    #include <unidef.h>
    #include <uconv.h>
#endif

#define INCL_RXSHV
#define INCL_RXFUNC
#include <rexxsaa.h>


#include "shfuncs.h"


#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 - must be defined in Makefile
#define SZ_VERSION              "0.1.6"     // Current version of this library

// Maximum string lengths...
#ifdef NO_SHARED_SOURCE
    #define US_COMPOUND_MAXZ    250                                  // ...of a compound variable
    #define US_ERRSTR_MAXZ      250                                  // ...of an error string

    static const char *PSZ_ZERO = "0";
    static const char *PSZ_ONE = "1";
#endif

#define US_INTEGER_MAXZ         12                                   // ...of a 32-bit integer string
#define US_LONGLONG_MAXZ        21                                   // ...of a 64-bit integer string
#define US_STEM_MAXZ          ( US_COMPOUND_MAXZ - US_INTEGER_MAXZ ) // ...of a stem
#define US_PIDSTR_MAXZ        ( CCHMAXPATH + 100 )                   // ...of a process information string
#define US_TIMESTR_MAXZ         256                                  // ...of a formatted time string
#define US_NUMSTR_MAXZ          32                                   // ...of a formatted number string
#define US_PIPESTATUS_MAXZ      128                                  // ...of a pipe status string
#define US_DISKINFO_MAXZ        128                                  // ...of a disk information 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 or dropped by Sys2DropFuncs
// Drop list starts at index 0, load list starts at index 1
static PSZ RxFunctionTbl[] = {
    "Sys2LoadFuncs",                    // Drop only 2015-05-06 SHL
    "Sys2DropFuncs",
    "Sys2GetClipboardText",
    "Sys2PutClipboardText",
    "Sys2QueryProcess",
    "Sys2QueryProcessList",
    "Sys2KillProcess",
    "Sys2QueryDriveInfo",
    "Sys2QueryForegroundProcess",
    "Sys2QueryPhysicalMemory",
    "Sys2FormatNumber",
    "Sys2FormatTime",
    "Sys2GetEpochTime",
    "Sys2ReplaceModule",
    "Sys2LocateDLL",
    "Sys2CreateNamedPipe",
    "Sys2ConnectNamedPipe",
    "Sys2DisconnectNamedPipe",
    "Sys2CheckNamedPipe",
    "Sys2Open",
    "Sys2Close",
    "Sys2Seek",
    "Sys2BytesRemaining",
    "Sys2Read",
    "Sys2ReadLine",
    "Sys2SyncBuffer",
    "Sys2Write",
    "Sys2QuerySysValue",
    "Sys2Version"
};

// FUNCTION DECLARATIONS

// Exported REXX functions
RexxFunctionHandler Sys2LoadFuncs;
RexxFunctionHandler Sys2DropFuncs;
RexxFunctionHandler Sys2Version;

RexxFunctionHandler Sys2FormatNumber;
RexxFunctionHandler Sys2FormatTime;
RexxFunctionHandler Sys2GetEpochTime;

RexxFunctionHandler Sys2GetClipboardText;
RexxFunctionHandler Sys2PutClipboardText;

RexxFunctionHandler Sys2QueryProcess;
RexxFunctionHandler Sys2QueryProcessList;
RexxFunctionHandler Sys2KillProcess;
RexxFunctionHandler Sys2QueryForegroundProcess;

RexxFunctionHandler Sys2QueryDriveInfo;

RexxFunctionHandler Sys2QueryPhysicalMemory;
RexxFunctionHandler Sys2QuerySysValue;

RexxFunctionHandler Sys2LocateDLL;
RexxFunctionHandler Sys2ReplaceModule;

RexxFunctionHandler Sys2CreateNamedPipe;
RexxFunctionHandler Sys2ConnectNamedPipe;
RexxFunctionHandler Sys2DisconnectNamedPipe;
RexxFunctionHandler Sys2CheckNamedPipe;

RexxFunctionHandler Sys2Open;
RexxFunctionHandler Sys2Close;
RexxFunctionHandler Sys2Seek;
RexxFunctionHandler Sys2Read;
RexxFunctionHandler Sys2Write;
RexxFunctionHandler Sys2SyncBuffer;


// Private internal functions
ULONG GetProcess( PCSZ pszProgram, PSZ pszFullName, PULONG pulPID, PULONG pulPPID, PULONG pulType, PUSHORT pusPriority, PULONG pulCPU );        // 2016-02-20 SHL

#ifndef LEGACY_C_LOCALE
int GetLocaleString( PSZ *ppszItem, LocaleItem item );
    void GroupNumber( PSZ buf, ULONGLONG val, PSZ sep );
#endif

#ifdef NO_SHARED_SOURCE
    BOOL  SaveResultString( PRXSTRING prsResult, PCSZ pchBytes, ULONG ulBytes );    // 2016-02-20 SHL
    BOOL  WriteStemElement( PCSZ pszStem, ULONG ulIndex, PCSZ pszValue );   // 2016-02-20 SHL
    void  WriteErrorCode( ULONG ulError, PCSZ pszContext ); // 2016-02-20 SHL
#endif

// 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);
    // 2015-05-06 SHL No need to load self (i.e. Sys2LoadFuncs), but do want to drop self
    for ( i = 1; i < entries; i++ )
        RexxRegisterFunctionDll( RxFunctionTbl[i], SZ_LIBRARY_NAME, RxFunctionTbl[i] );

    SaveResultString( prsResult, NULL, 0 );     // 2016-02-20 SHL
    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] );

    SaveResultString( prsResult, NULL, 0 );     // 2016-02-20 SHL
    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 );

    SaveResultString( prsResult, szVersion, strlen(szVersion) );        // 2016-02-20 SHL
    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;               // Morph to PM
    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 );

    // 2016-02-20 SHL Sync return values with docs

    // 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" );
                SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
            }
            else
                SaveResultString( prsResult, PSZ_ONE, 1 );      // Success - 2016-02-20 SHL
        } else {
            WriteErrorCode( ulRC, "DosAllocSharedMem");
            SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
        }

        WinCloseClipbrd( hab );
    } else {
        // 2016-02-20 SHL Report PM error code
        WriteErrorCode( ERRORIDERROR(WinGetLastError(hab)), "WinOpenClipbrd" );
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
    }

    if ( hmq != NULLHANDLE ) WinDestroyMsgQueue( hmq );
    if ( fHabTerm ) WinTerminate( hab );
    ppib->pib_ultype = ulPType;                 // Restore

    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  or "" if fails.        *
 * ------------------------------------------------------------------------- */
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 );
                SaveResultString( prsResult, pszLocalText, ulBytes - 1 );       // 2016-02-20 SHL
                free( pszLocalText );
            } else {
                WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
                SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
            }

        } else {
            // Either no text exists, or clipboard is not readable
            SaveResultString( prsResult, NULL, 0 );     // 2016-02-20 SHL
        }

        WinCloseClipbrd( hab );
    } else {
        // 2016-02-20 SHL Report PM error code
        WriteErrorCode( ERRORIDERROR(WinGetLastError(hab)), "WinOpenClipbrd" );
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
    }

    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");
                          SaveResultString( prsResult, NULL, 0 );       // 2016-02-20 SHL
                          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");
            SaveResultString( prsResult, NULL, 0 );     // 2016-02-20 SHL
            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 )) {
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        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 );

    SaveResultString( prsResult, szReturn, strlen(szReturn) );  // 2016-02-20 SHL

    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");
                          SaveResultString( prsResult, PSZ_ZERO, 1 );   // 2016-02-20 SHL
                          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");
            SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
            return ( 0 );
        }
        strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) );
    }

    if ( pszProcName ) {
        // Get the process PID
        rc = GetProcess( pszProcName, szFullName, &ulPID, &ulPPID, &ulType, &usPrty, &ulTime );
        if (( rc != NO_ERROR ) || ( ulPID == 0 )) {
            free( pszProcName );
            SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
            return ( 0 );
        }
    }

    // Now attempt to kill the process using DosKillProcess()
    rc = DosKillProcess( 1, ulPID );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosKillProcess");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
    }
    else
        SaveResultString( prsResult, PSZ_ONE, 1 );      // 2016-02-20 SHL

    // 2016-02-20 SHL Avoid leak
    if ( pszProcName )
      free( pszProcName );

    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 )
{
    QSPTRREC *pBuf;                      // Data returned by DosQProcStatus/DosQuerySysState() // 2015-04-23 SHL
    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 = (QSPTRREC *) malloc( UL_SSBUFSIZE ); // 2015-04-23 SHL
#endif

    if ( pBuf == NULL ) {
        WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        return ( 0 );
    }

#ifdef USE_DQPS
    // Get running process information using 16-bit DosQProcStatus()
    rc = DosQProcStatus( pBuf, UL_SSBUFSIZE );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosQProcStatus");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        return ( 0 );
    }
#else
    // Get running process information using 32-bit DosQuerySysState()
    rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosQuerySysState");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        return ( 0 );
    }
#endif

    // Now get the list of processes
    ulCount = 0;
#   if 1 // 2016-02-25 SHL FIXME debug bad pointer
    // 2016-02-26 SHL FIXME to be gone when sure this can not occur
    if ( (ULONG)pBuf->pProcRec < 0x10000 ) {
        sprintf( szName, "rxutilex#%u pBuf->pProcRec 0x%x < 0x10000",
                 __LINE__, (ULONG)pBuf->pProcRec );
        WriteErrorCode( ERROR_INVALID_ADDRESS, szName );
        SaveResultString( prsResult, NULL, 0 );
        free( pBuf );
        return ( 0 );
    }
#   endif

    for (pPrec = pBuf->pProcRec;
         ;
         pPrec = (QSPREC *)(pPrec->pThrdRec + pPrec->cTCB)
        )

    {
#       if 0 // 2015-06-19 SHL FIXME debug bad pointer
        // 2016-02-26 SHL FIMXE to be gone when sure no longer needed
        if ( (ULONG)pPrec < 0x10000 ) {
            sprintf( szName, "rxutilex#%u pPrec 0x%x < 0x10000",
                     __LINE__, (ULONG)pPrec );
            WriteErrorCode( ERROR_INVALID_ADDRESS, szName );
            SaveResultString( prsResult, NULL, 0 );
            free( pBuf );
            return ( 0 );
        }
#       endif

        // Check for documented end marker - RecType not QS_PROCESS
        if ( pPrec->RecType != QS_PROCESS ) {
#           if 0 // 2016-02-26 SHL FIXME debug
            fprintf( stderr,
                     "* rxutilex#%u RecType != QS_PROCESS "
                     "ulCount %u pBuf %p pPrec %p ->RecType %x ->pThrdRec %p ->pid %u ->ppid %u ->type %u ->stat %u ->hmte %x ->cTCB %u\n",
                     __LINE__, ulCount, pBuf, pPrec, pPrec->RecType, pPrec->pThrdRec,
                     pPrec->pid, pPrec->ppid,
                     pPrec->type, pPrec->stat, pPrec->hMte, pPrec->cTCB );
#           endif
            break;                      // Must be end of list
        }

        // Check for alternate end marker - pThredRec NULL
        // This appears to be an undocumented end marker
        // Might be a defect - testing says only RecType is non-zero
        // 2015-06-12 SHL pThrdRec can be 0 - probably when process starting or dieing
        if ( (PVOID)pPrec->pThrdRec == NULL ) {
#           if 0 // 2016-02-26 SHL FIXME debug
            fprintf( stderr,
                     "* rxutilex#%u pThrdRec NULL "
                     "ulCount %u pBuf %p pPrec %p ->pThrdRec %p ->pid %u ->ppid %u ->type %u ->stat %u ->hmte %x ->cTCB %u\n",
                     __LINE__, ulCount, pBuf, pPrec, pPrec->pThrdRec, pPrec->pid, pPrec->ppid,
                     pPrec->type, pPrec->stat, pPrec->hMte, pPrec->cTCB );
#           endif
            break;                      // Must be end of list
        }

#       if 1 // 2015-07-31 SHL FIXME debug bad pointer
        // 2016-02-26 SHL FIXME to be gone when sure can not occur
        if ( (ULONG)(pPrec->pThrdRec) < 0x10000 ) {
            sprintf( szName,
                     "rxutilex#%u pPrec < 0x10000 "
                     "ulCount %u pBuf %p pPrec %p ->pThrdRec %p ->pid %u ->ppid %u ->type %u ->stat %u ->hmte %x ->cTCB %u\n",
                     __LINE__, ulCount, pBuf, pPrec, pPrec->pThrdRec, pPrec->pid, pPrec->ppid,
                     pPrec->type, pPrec->stat, pPrec->hMte, pPrec->cTCB );
            WriteErrorCode( ERROR_INVALID_ADDRESS, szName );
            SaveResultString( prsResult, NULL, 0 );
            free( pBuf );
            return ( 0 );
        }
#       endif
#       if 1 // 2016-02-26 SHL FIXME debug bad count
        // 2016-02-26 SHL FIXME to be gone when sure can not occur
        // This is probably occurs only when pThrdRec NULL too which is already checked
        if ( !pPrec->cTCB ) {
            sprintf( szName, "rxutilex#%u cTCB 0 ulCount %u pBuf %p pPrec %p ->pid %u ->type %u ->stat %u\n",
                     __LINE__, ulCount, pBuf, pPrec, pPrec->pid, pPrec->type, pPrec->stat );
            WriteErrorCode( ERROR_INVALID_DATA, szName );
            SaveResultString( prsResult, NULL, 0 );
            free( pBuf );
            return ( 0 );
        }
#       endif

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

#       if 0 // 2015-07-31 SHL FIXME debug bad count
        // 2016-02-26 SHL FIXME to be gone when sure no longer needed
        if ( !pPrec->cTCB ) {
            sprintf( szName, "rxutilex#%u: cTCB 0 "
                     "ulCount %u pBuf %p pPrec %p ->pThrdRec %p ->pid %u\n",
                     __LINE__, ulCount, pBuf, pPrec, pPrec->pThrdRec, pPrec->pid );
            WriteErrorCode( ERROR_INVALID_DATA, szName );
            SaveResultString( prsResult, NULL, 0 );
            free( pBuf );
            return ( 0 );
        }
#       endif
#       if 0    // 2015-07-31 SHL FIXME debug bad pointer
        // 2016-02-26 SHL FIXME to be gone when sure no longer needed
        if ( (ULONG)pPrec->pThrdRec < 0x10000 ) {
            sprintf( szName,
                     "rxutilex#%u: pBuf->pThrdRec < 0x10000 "
                     "ulCount %u pBuf %p pPrec %p ->pThrdRec %p ->pid %u ->cTCB %u\n",
                     __LINE__, ulCount, pBuf, pPrec, pPrec->pThrdRec, pPrec->pid, pPrec->cTCB );
            WriteErrorCode( rc, szName );
            SaveResultString( prsResult, NULL, 0 );
            free( pBuf );
            return ( 0 );
        }
#       endif
    } // for

    // Create the stem.0 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
    SaveResultString( prsResult, szNumber, strlen(szNumber) );  // 2016-02-20 SHL

    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");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
        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
    SaveResultString( prsResult, szMemSize, strlen(szMemSize) );        // 2016-02-20 SHL

    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");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
        return ( 0 );
    }
    sprintf( szPID, "%u", ulPID );

    // Return the PID as the REXX return string
    SaveResultString( prsResult, szPID, strlen(szPID) );          // 2016-02-20 SHL

    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");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
        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");
                SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
                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");
                SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
                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");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
        return ( 0 );
    }

    // Return 1 on success
    SaveResultString( prsResult, PSZ_ONE, 1 );  // 2016-02-20 SHL

    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2FormatNumber                                                          *
 *                                                                           *
 * Format a number using locale-specific thousands separators.  The input    *
 * number may be a positive or negative integer or floating point value.  It *
 * must not contain any separators already, and any decimal point which it   *
 * contains must be a period (rather than any localized decimal symbol).     *
 * The maximum value is that of a signed 64-bit integer, or a long double.   *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. Number to be formatted.                                   (REQUIRED) *
 *   2. Number of decimal places to use for floating point                   *
 *      values.  Ignored for integer values.                    (DEFAULT: 2) *
 *                                                                           *
 * REXX RETURN VALUE: The formatted number, or "" on error.                  *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2FormatNumber( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    CHAR  achNumber[ US_NUMSTR_MAXZ ];  // Formatted output string
    int   iPrec;                        // Requested decimal precision
    PSZ   pszSep = NULL;                // Thousands separator string
    PSZ   pszDec = NULL;                // Decimal point string
    PSZ   pszNeg = NULL;                // Negative sign string
#ifdef LEGACY_C_LOCALE
    float fVal = 0;                     // Input value as floating point
    int   iVal;                         // Input value as integer
#else
    LONGLONG    llVal  = 0;
    long double ldVal  = 0,
                ldFrac = 0;
    PSZ         p,
                a;
    BOOL        bNeg   = FALSE;
    CHAR        achFrac[ 16 ];
    int         rc     = 0;
#endif

    // Make sure we have at least one valid argument (the input number)
    if ( argc < 1  || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );

#ifdef LEGACY_C_LOCALE

    // Use the locale settings from the environment
    pszSep = nl_langinfo( THOUSEP );
    if ( !pszSep || !strlen(pszSep) ) {
        /* If the current locale isn't known to the C runtime, use a common
         * known locale for the same language, if possible.
         */
        PSZ pszLang, p;
        if ( DosScanEnv( "LANG", &pszLang ) == NO_ERROR &&
             pszLang &&
             strlen(pszLang) >= 2 )
        {
            p = strdup( pszLang );
            if ( !strnicmp( p, "en_us", 2 )) setlocale( LC_NUMERIC, "EN_US");
            else if ( !strnicmp( p, "en_uk", 2 )) setlocale( LC_NUMERIC, "EN_GB");
            else if ( !strnicmp( p, "de", 2 )) setlocale( LC_NUMERIC, "DE_DE");
            else if ( !strnicmp( p, "es", 2 )) setlocale( LC_NUMERIC, "ES_ES");
            else if ( !strnicmp( p, "fr", 2 )) setlocale( LC_NUMERIC, "FR_FR");
            else if ( !strnicmp( p, "it", 2 )) setlocale( LC_NUMERIC, "IT_IT");
            else if ( !strnicmp( p, "ja", 2 )) setlocale( LC_NUMERIC, "JA_JP");
/* -- it seems the VAC runtime doesn't recognize most of these...
            else if ( !strnicmp( p, "ar", 2 )) setlocale( LC_NUMERIC, "ar_AA");
            else if ( !strnicmp( p, "be", 2 )) setlocale( LC_NUMERIC, "be_BY");
            else if ( !strnicmp( p, "bg", 2 )) setlocale( LC_NUMERIC, "bg_BG");
            else if ( !strnicmp( p, "be", 2 )) setlocale( LC_NUMERIC, "be_BY");
            else if ( !strnicmp( p, "ca", 2 )) setlocale( LC_NUMERIC, "ca_ES");
            else if ( !strnicmp( p, "cs", 2 )) setlocale( LC_NUMERIC, "cs_CZ");
            else if ( !strnicmp( p, "da", 2 )) setlocale( LC_NUMERIC, "da_DK");
            else if ( !strnicmp( p, "de", 2 )) setlocale( LC_NUMERIC, "de_DE");
            else if ( !strnicmp( p, "el", 2 )) setlocale( LC_NUMERIC, "el_GR");
            else if ( !strnicmp( p, "es", 2 )) setlocale( LC_NUMERIC, "es_ES");
            else if ( !strnicmp( p, "fi", 2 )) setlocale( LC_NUMERIC, "fi_FI");
            else if ( !strnicmp( p, "fr", 2 )) setlocale( LC_NUMERIC, "fr_FR");
            else if ( !strnicmp( p, "hr", 2 )) setlocale( LC_NUMERIC, "hr_HR");
            else if ( !strnicmp( p, "hu", 2 )) setlocale( LC_NUMERIC, "hu_HU");
            else if ( !strnicmp( p, "is", 2 )) setlocale( LC_NUMERIC, "is_IS");
            else if ( !strnicmp( p, "it", 2 )) setlocale( LC_NUMERIC, "it_IT");
            else if ( !strnicmp( p, "iw", 2 )) setlocale( LC_NUMERIC, "iw_IL");
            else if ( !strnicmp( p, "ja", 2 )) setlocale( LC_NUMERIC, "ja_JP");
            else if ( !strnicmp( p, "ko", 2 )) setlocale( LC_NUMERIC, "ko_KR");
            else if ( !strnicmp( p, "mk", 2 )) setlocale( LC_NUMERIC, "mk_MK");
            else if ( !strnicmp( p, "nl", 2 )) setlocale( LC_NUMERIC, "nl_NL");
            else if ( !strnicmp( p, "no", 2 )) setlocale( LC_NUMERIC, "no_NO");
            else if ( !strnicmp( p, "pl", 2 )) setlocale( LC_NUMERIC, "pl_PL");
            else if ( !strnicmp( p, "pt", 2 )) setlocale( LC_NUMERIC, "pt_PT");
            else if ( !strnicmp( p, "ro", 2 )) setlocale( LC_NUMERIC, "ro_RO");
            else if ( !strnicmp( p, "ru", 2 )) setlocale( LC_NUMERIC, "ru_RU");
            else if ( !strnicmp( p, "sh", 2 )) setlocale( LC_NUMERIC, "sh_SP");
            else if ( !strnicmp( p, "sk", 2 )) setlocale( LC_NUMERIC, "sk_SK");
            else if ( !strnicmp( p, "sl", 2 )) setlocale( LC_NUMERIC, "sl_SI");
            else if ( !strnicmp( p, "sq", 2 )) setlocale( LC_NUMERIC, "sq_AL");
            else if ( !strnicmp( p, "sv", 2 )) setlocale( LC_NUMERIC, "sv_SE");
            else if ( !strnicmp( p, "th", 2 )) setlocale( LC_NUMERIC, "th_TH");
            else if ( !strnicmp( p, "tr", 2 )) setlocale( LC_NUMERIC, "tr_TR");
            else if ( !strnicmp( p, "uk", 2 )) setlocale( LC_NUMERIC, "uk_UA");
            else if ( !strnicmp( p, "zh", 2 )) setlocale( LC_NUMERIC, "zh_TW");
-- */
            else setlocale( LC_NUMERIC, "EN_US");
            free(p);
        }
        else setlocale( LC_NUMERIC, "en_us");
    }
    else setlocale( LC_NUMERIC, "");

    // Check for a decimal place and treat as float or integer accordingly
    if ( strchr( argv[0].strptr, '.') != NULL ) {
        if (( sscanf( argv[0].strptr, "%f", &fVal )) != 1 ) return ( 40 );
        if ( argc >= 2  && ( RXVALIDSTRING(argv[1]) ) &&
             (( sscanf( argv[1].strptr, "%d", &iPrec )) == 1 ))
        {
            // Use user-specified precision
            sprintf( achNumber, "%'.*f", iPrec, fVal );
        }
        else
            sprintf( achNumber, "%'.2f", fVal );
    }
    else {
        if (( sscanf( argv[0].strptr, "%d", &iVal )) != 1 ) return ( 40 );
        sprintf( achNumber, "%'d", iVal );
    }

    // Return the formatted number
    SaveResultString( prsResult, achNumber, strlen(achNumber) );

#else

    rc = GetLocaleString( &pszSep, LOCI_sThousand );
    if ( rc ) {
        // GetLocaleString has already set the error indicator
        SaveResultString( prsResult, NULL, 0 );
        goto finish;
    }
    rc = GetLocaleString( &pszDec, LOCI_sDecimal );
    if ( rc ) {
        // GetLocaleString has already set the error indicator
        SaveResultString( prsResult, NULL, 0 );
        goto finish;
    }
    rc = GetLocaleString( &pszNeg, LOCI_sNegativeSign );
    if ( rc ) {
        // GetLocaleString has already set the error indicator
        SaveResultString( prsResult, NULL, 0 );
        goto finish;
    }

    // Check for negative value
    //if ( argv[0].strptr == '-') bNeg = TRUE;

    // Check for a decimal place and treat as float or integer accordingly
    if ( strchr( argv[0].strptr, '.') != NULL ) {
        if (( sscanf( argv[0].strptr, "%Lf", &ldVal )) != 1 ) return ( 40 );

        llVal  = ldVal;
        ldFrac = ldVal - llVal;
        if ( argc >= 2  && ( RXVALIDSTRING(argv[1]) ) &&
             (( sscanf( argv[1].strptr, "%d", &iPrec )) == 1 ))
        {
            // Use user-specified precision
            sprintf( achFrac, "%.*Lf", iPrec, ldFrac );
        }
        else
            sprintf( achFrac, "%.2Lf", ldFrac );

        // Format the integer part
        a = achNumber;
        if ( llVal < 0 ) {
            sprintf( a, pszNeg );
            a += strlen( pszNeg );
        }
        GroupNumber( a, llabs( llVal ), pszSep );
        // Append the fractional part
        if (( p = strchr( achFrac, '.')) != NULL ) {
            strncat( achNumber, pszDec, US_NUMSTR_MAXZ - 1 );
            strncat( achNumber, p+1,    US_NUMSTR_MAXZ - 1 );
        }
    }
    else {
        if (( sscanf( argv[0].strptr, "%lld", &llVal )) != 1 ) return ( 40 );
        a = achNumber;
        if ( llVal < 0 ) {
            sprintf( a, pszNeg );
            a += strlen( pszNeg );
        }
        GroupNumber( a, llabs( llVal ), pszSep );
    }

    // Return the formatted number
    SaveResultString( prsResult, achNumber, strlen(achNumber) );

finish:
    if ( pszSep ) free( pszSep );
    if ( pszDec ) free( pszDec );
    if ( pszNeg ) free( pszNeg );

#endif

    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;
    int    iEpoch;                            // Input epoch time
    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", &iEpoch )) != 1 ) return ( 40 );
        ttSeconds = (time_t) iEpoch;
    }

    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 );
    if ( pszSetTZ ) {
        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");
            SaveResultString( prsResult, NULL, 0 );     // 2016-02-20 SHL
            if ( pszSetTZ ) free( pszSetTZ );
            return 0;
        }
    }

    if ( fUTC ) {
        timeptr = gmtime( &ttSeconds );
        if ( !timeptr ) {
            WriteErrorCode( 1, "gmtime");
            SaveResultString( prsResult, NULL, 0 );     // 2016-02-20 SHL       // 2016-02-20 SHL
            if ( pszSetTZ ) free( pszSetTZ );
            return 0;
        }
    }
    else {
        timeptr = localtime( &ttSeconds );
        if ( !timeptr ) {
            WriteErrorCode( 1, "localtime");
            SaveResultString( prsResult, NULL, 0 );     // 2016-02-20 SHL
            if ( pszSetTZ ) free( pszSetTZ );
            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");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        if ( pszSetTZ ) free( pszSetTZ );
        return ( 0 );
    }

    // Return the formatted time string
    SaveResultString( prsResult, szTime, strlen(szTime) );      // 2016-02-20 SHL

    if ( pszSetTZ ) 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");
            SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
            free( pszSetTZ );
            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");
            SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
            free( pszSetTZ );
            return 0;
        }
    }

    // Return the calculated time value
#if __IBMC__ >= 360 || __IBMCPP__ >= 360
    sprintf( szEpochTime, "%.0f", timeval );
#else
    sprintf( szEpochTime, "%d", timeval );
#endif
    SaveResultString( prsResult, szEpochTime, strlen(szEpochTime) );    // 2016-02-20 SHL

    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) *
 *   2. Flag to limit search context, must be one of:                        *
 *        ALL       : Search for both loaded and loadable DLLs     (DEFAULT) *
 *        LOADEDONLY: Search only for currently-loaded DLLs                  *
 *      Only the first letter (A/L) is significant.                          *
 *                                                                           *
 * 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    bLoadedOnly = FALSE,
            bUnload     = FALSE;
    APIRET  rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    if ( argc < 1  || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );

    // Second argument: flag
    if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
        strupr( argv[1].strptr );
        if ( strcspn(argv[1].strptr, "AL") > 0 ) return ( 40 );
        switch ( argv[1].strptr[0] ) {
            case 'A': bLoadedOnly = FALSE; break;
            case 'L': bLoadedOnly = TRUE;  break;
            default : return ( 40 );
        }
    }

    // See if the DLL is already loaded
    rc = DosQueryModuleHandle( argv[0].strptr, &hmod );
    if ( rc ) {
        // Guess not...
        if ( bLoadedOnly ) {
            // Just return
            SaveResultString( prsResult, NULL, 0 );     // 2016-02-20 SHL
            return 0;
        }
        // Try to load it now
        rc = DosLoadModule( NULL, 0, argv[0].strptr, &hmod );
        if ( rc ) {
            WriteErrorCode( rc, "DosLoadModule");
            SaveResultString( prsResult, NULL, 0 );     // 2016-02-20 SHL
            return 0;
        }
        bUnload = TRUE;
    }

    // Get the full path name of the DLL
    rc = DosQueryModuleName( hmod, CCHMAXPATH, achModuleName );
    if ( rc ) {
        WriteErrorCode( rc, "DosQueryModuleName");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        if ( bUnload ) DosFreeModule( hmod );
        return 0;
    }

    // Free the module if we loaded it ourselves
    if ( bUnload ) DosFreeModule( hmod );

    // Return the full path name
    SaveResultString( prsResult, achModuleName, strlen(achModuleName) );        // 2016-02-20 SHL

    return 0;
}


/* ------------------------------------------------------------------------- *
 * Sys2CreateNamedPipe                                                       *
 *                                                                           *
 * Create a named pipe with the specified name and parameters.  Only byte    *
 * mode is supported; message mode is not.                                   *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. The name of the pipe, in the form "\PIPE\something".      (REQUIRED) *
 *   2. The size of the outbound buffer, in bytes.                (REQUIRED) *
 *   3. The size of the inbound buffer, in bytes.                 (REQUIRED) *
 *   4. The pipe's timeout value, in milliseconds.           (DEFAULT: 3000) *
 *   5. The number of simultaneous instances of this pipe which are allowed. *
 *      Must be between 1 and 254, or 0 indicating no limit.    (DEFAULT: 1) *
 *   6. Pipe blocking mode, one of:                                          *
 *        W = WAIT mode, read and write block waiting for data.    (DEFAULT) *
 *        N = NOWAIT mode, read and write return immediately.                *
 *   7. Pipe mode, one of:                                                   *
 *        I = Inbound pipe                                         (DEFAULT) *
 *        O = Outbound pipe                                                  *
 *        D = Duplex (inbound/outbound) pipe                                 *
 *   8. Privacy/inheritance flag, one of:                                    *
 *        0 = The pipe handle is inherited by child processes.     (DEFAULT) *
 *        1 = The pipe handle is private to the current process.             *
 *   9. Write-through flag, one of:                                          *
 *        0 = Allow delayed writes (write-behind) to remote pipes. (DEFAULT) *
 *        1 = Force immediate writes (write-through) to remote pipes.        *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   A four-byte pipe handle or 0 if create fails                            *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2CreateNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HPIPE   hp;
    PSZ     pszNPName;
    LONG    iLimit;
    ULONG   ulBufOut,
            ulBufIn,
            ulTimeout = 3000,
            flOpen    = 0,
            flPipe    = 1;
    CHAR    achHandle[ 9 ];
    APIRET  rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have at least three valid arguments (pipe name and sizes)
    if ( argc < 3  || ( !RXVALIDSTRING(argv[0]) ) ||
        ( !RXVALIDSTRING(argv[1]) ) || ( !RXVALIDSTRING(argv[2]) ))
        return ( 40 );

    // (Validate the first argument last to simplify error processing)

    // Second argument: pipe outbound buffer size
    if (( sscanf( argv[1].strptr, "%u", &ulBufOut )) != 1 ) return ( 40 );

    // Third argument: pipe outbound buffer size
    if (( sscanf( argv[2].strptr, "%u", &ulBufIn )) != 1 ) return ( 40 );

    // Fourth argument: pipe timeout value
    if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
        if (( sscanf( argv[3].strptr, "%u", &ulTimeout )) != 1 ) return ( 40 );
    }

    // Fifth argument: instances limit
    if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
        if (( sscanf( argv[4].strptr, "%d", &iLimit )) != 1 ) return ( 40 );
        if (( iLimit > 1 ) && ( iLimit < 255 ))
            flPipe = iLimit;
        else if ( !iLimit || ( iLimit == -1 ))
            flPipe = NP_UNLIMITED_INSTANCES;
        else
            return ( 40 );
    }

    // Sixth argument: blocking mode
    if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
        strupr( argv[5].strptr );
        if ( argv[5].strptr[0] == 'N' )
            flPipe |= NP_NOWAIT;
        else if ( argv[5].strptr[0] != 'W' )
            return ( 40 );
    }

    // Seventh argument: pipe mode (direction)
    if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
        strupr( argv[6].strptr );
        if (strcspn(argv[6].strptr, "IOD") > 0 ) return ( 40 );
        switch ( argv[6].strptr[0] ) {
            case 'O': flOpen |= NP_ACCESS_OUTBOUND; break;
            case 'D': flOpen |= NP_ACCESS_DUPLEX;   break;
            default : break;            // default is 0
        }
    }

    // Eighth argument: inheritance mode
    if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
        strupr( argv[7].strptr );
        if ( argv[7].strptr[0] == '1' )
            flOpen |= NP_NOINHERIT;
        else if ( argv[7].strptr[0] != '0' )
            return ( 40 );
    }

    // Ninth argument: write mode
    if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
        strupr( argv[8].strptr );
        if ( argv[8].strptr[0] == '1' )
            flOpen |= NP_NOWRITEBEHIND;
        else if ( argv[8].strptr[0] != '0' )
            return ( 40 );
    }

    // Now the first argument: pipe name
    pszNPName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
    if ( pszNPName == NULL ) {
        WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
        return ( 0 );
    }
    strncpy( pszNPName, argv[0].strptr, RXSTRLEN(argv[0]) );

    // All good, now create the pipe
    rc = DosCreateNPipe( pszNPName, &hp, flOpen, flPipe, ulBufOut, ulBufIn, ulTimeout );
    if (rc) {
        WriteErrorCode( rc, "DosCreateNPipe");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
        return 0;
    }

    // Return the handle as the REXX result string
    sprintf( achHandle, "%8X", hp );
    SaveResultString( prsResult, achHandle, strlen(achHandle) ); // 2016-02-20 SHL

    free( pszNPName );
    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2ConnectNamedPipe                                                      *
 *                                                                           *
 * Start 'listening' by allowing clients to connect to a previously-created  *
 * named pipe.                                                               *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. The pipe handle, as returned by Sys2CreateNamedPipe.      (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   1 on success, or 0 if an error occurred.                                *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2ConnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HPIPE   hp;
    ULONG   ulState = 0;
    APIRET  rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Parse the handle
    if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
    if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );

    // Determine the pipe mode
    DosQueryNPHState( hp, &ulState );

    // Connect the pipe
    rc = DosConnectNPipe( hp );

    // A non-blocking pipe returns ERROR_PIPE_NOT_CONNECTED on success
    if ((( ulState & NP_NOWAIT ) && ( rc != ERROR_PIPE_NOT_CONNECTED )) ||
        ( rc != NO_ERROR ))
    {
        WriteErrorCode( rc, "DosConnectNPipe");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
        return ( 0 );
    }

    // Return 1 on success
    SaveResultString( prsResult, PSZ_ONE, 1 );  // 2016-02-20 SHL
    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2DisconnectNamedPipe                                                   *
 *                                                                           *
 * Unlocks a named pipe after a client has closed its connection.            *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. The pipe handle, as returned by Sys2CreateNamedPipe.      (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   1 on success, or 0 if an error occurred.                                *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2DisconnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HPIPE   hp;
    APIRET  rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Parse the handle
    if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
    if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );

    // Connect the pipe
    rc = DosDisConnectNPipe( hp );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosDisConnectNPipe");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
        return ( 0 );
    }

    // Return 1 on success
    SaveResultString( prsResult, PSZ_ONE, 1 );  // 2016-02-20 SHL
    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2CheckNamedPipe                                                        *
 *                                                                           *
 * Check the status of a named pipe.                                         *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. The pipe handle (from Sys2CreateNamedPipe or DosOpen).    (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   String of the format "bytes status", where bytes is the number of bytes *
 *   currently waiting in the pipe, and status is one of: DISCONNECTED,      *
 *   LISTENING, CONNECTED, or CLOSING or "" if API error                     *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2CheckNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HPIPE     hp;
    ULONG     cbActual, ulState;
    AVAILDATA avd;
    CHAR      szStatus[ US_PIPESTATUS_MAXZ ];
    APIRET    rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Parse the handle
    if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
    if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );

    rc = DosPeekNPipe( hp, NULL, 0, &cbActual, &avd, &ulState );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosPeekNPipe");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        return ( 0 );
    }
    sprintf( szStatus, "%u ", avd.cbpipe );
    switch ( ulState ) {
        case NP_STATE_DISCONNECTED: strncat( szStatus, "DISCONNECTED", US_PIPESTATUS_MAXZ-1 ); break;
        case NP_STATE_LISTENING:    strncat( szStatus, "LISTENING",    US_PIPESTATUS_MAXZ-1 ); break;
        case NP_STATE_CONNECTED:    strncat( szStatus, "CONNECTED",    US_PIPESTATUS_MAXZ-1 ); break;
        case NP_STATE_CLOSING:      strncat( szStatus, "CLOSING",      US_PIPESTATUS_MAXZ-1 ); break;
        default:                    strncat( szStatus, "UNKNOWN",      US_PIPESTATUS_MAXZ-1 ); break;
    }

    SaveResultString( prsResult, szStatus, strlen(szStatus) );  // 2016-02-20 SHL

    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2Open                                                                  *
 *                                                                           *
 * Wrapper to DosOpenL: open a file or stream (with >2GB support).           *
 * Direct-DASD mode is not supported by this function, nor is setting the    *
 * initial extended attributes.                                              *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. Name of file or stream to open.                           (REQUIRED) *
 *   2. Open action flags, must be either "O" (open if exists), "R" (replace *
 *      if exists), or nothing (fail if exists), optionally followed by "C"  *
 *      (create if file does not exist).  If "C" is not specified, the       *
 *      operation will fail if the file does not exist.  Note that a value   *
 *      of "" alone will therefore fail automatically.        (DEFAULT: "O") *
 *      In summary, the possible combinations are:                           *
 *        O = Open only (if file exists, open it; if not, fail)              *
 *        OC= Open/create (if file exists, open it; if not, create it)       *
 *        R = Replace only (if file exists, replace it; if not, fail)        *
 *        RC= Replace/create (if file exists, replace it; if not, create it) *
 *        C = Create only (if file exists, fail; if not, create it)          *
 *        (empty) = No-op (if file exists, fail; if not, fail)               *
 *   3. Access mode flags, one or both of:                   (DEFAULT: "RW") *
 *        R = Open file with read access.                                    *
 *        W = Open file with write access.                                   *
 *   4. Sharing mode flags, any combination of:               (DEFAULT: "W") *
 *        R = Deny read access to other processes                            *
 *        W = Deny write access to other processes                           *
 *   5. Deny legacy DosOpen access, one of:                                  *
 *        0 = Allow DosOpen to access the file                     (DEFAULT) *
 *        1 = Deny access using the DosOpen API                              *
 *   6. Privacy/inheritance flag, one of:                                    *
 *        0 = The file handle is inherited by child processes.     (DEFAULT) *
 *        1 = The file handle is private to the current process.             *
 *   7. Initial file attributes when creating a file:          (DEFAULT: "") *
 *        A = Archive attribute set                                          *
 *        D = Directory attribute set                                        *
 *        S = System attribute set                                           *
 *        H = Hidden attribute set                                           *
 *        R = Read-only attribute set                                        *
 *   8. Initial file size when creating or replacing a file; ignored if      *
 *      access mode is read-only.                               (DEFAULT: 0) *
 *   9. I/O mode flags, any or all of:                         (DEFAULT: "") *
 *       T = Write-through mode (default is normal write)                    *
 *       N = No-cache mode (default is to use filesystem cache)              *
 *       S = Sequential access                                               *
 *       R = Random access                                                   *
 *          * S and R can combine as follows:                                *
 *              Neither: No locality known (default)                         *
 *              S only:  Mainly sequential access                            *
 *              R only:  Mainly random access                                *
 *              Both:    Random/sequential (i.e. random with some locality)  *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   File handle, or "" in case of error.                                    *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2Open( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    PSZ      pszFile;
    HFILE    hf;
    ULONG    fsAction = 0,
             fsMode   = 0,
             ulResult = 0,
             ulAttr   = FILE_NORMAL;
    LONGLONG llSize   = {0};
    CHAR     achHandle[ 9 ];
    APIRET   rc;


    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have at least one valid argument (the file name)
    if ( argc < 1  || ( !RXVALIDSTRING(argv[0]) ))
        return ( 40 );

    // (Validate the first argument last to simplify error processing)

    // Second argument: open action
    if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
        strupr( argv[1].strptr );
        if ( strcspn(argv[1].strptr, "OCR") > 0 ) return ( 40 );
        if ( strchr(argv[1].strptr, 'O'))
            fsAction |= OPEN_ACTION_OPEN_IF_EXISTS;
        else if ( strchr(argv[1].strptr, 'R'))
            fsAction |= OPEN_ACTION_REPLACE_IF_EXISTS;
        if ( strchr(argv[1].strptr, 'C'))
            fsAction |= OPEN_ACTION_CREATE_IF_NEW;
    }
    else
        fsAction = OPEN_ACTION_OPEN_IF_EXISTS;

    // Third argument: access mode
    if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
        strupr( argv[2].strptr );
        if ( strcspn(argv[2].strptr, "RW") > 0 ) return ( 40 );
        if ( strchr(argv[2].strptr, 'R')) {
            if (strchr(argv[2].strptr, 'W'))
                fsMode = OPEN_ACCESS_READWRITE;
            else
                fsMode = OPEN_ACCESS_READONLY;
        }
        else if (strchr(argv[2].strptr, 'W'))
            fsMode = OPEN_ACCESS_WRITEONLY;
        else
            return ( 40 );
    }
    else
        fsMode = OPEN_ACCESS_READWRITE;

    // Fourth argument: sharing mode
    if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
        strupr( argv[3].strptr );
        if ( strcspn(argv[3].strptr, "RW") > 0 ) return ( 40 );
        if ( strchr(argv[3].strptr, 'R')) {
            if (strchr(argv[3].strptr, 'W'))
                fsMode |= OPEN_SHARE_DENYREADWRITE;
            else
                fsMode |= OPEN_SHARE_DENYREAD;
        }
        else if (strchr(argv[3].strptr, 'W'))
            fsMode |= OPEN_SHARE_DENYWRITE;
        else
            fsMode |= OPEN_SHARE_DENYNONE;
    }
    else
        fsMode |= OPEN_SHARE_DENYNONE;

    // Fifth argument: deny legacy mode
    if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
        strupr( argv[4].strptr );
        if ( argv[4].strptr[0] == '1' )
            fsMode |= OPEN_SHARE_DENYLEGACY;
        else if ( argv[4].strptr[0] != '0' )
            return ( 40 );
    }

    // Sixth argument: inheritance mode
    if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
        strupr( argv[5].strptr );
        if ( argv[5].strptr[0] == '1' )
            fsMode |= OPEN_FLAGS_NOINHERIT;
        else if ( argv[5].strptr[0] != '0' )
            return ( 40 );
    }

    // Seventh argument: attributes
    if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
        strupr( argv[6].strptr );
        if (strcspn(argv[6].strptr, "ADSHR") > 0 ) return ( 40 );
        if ( strchr(argv[6].strptr, 'A')) ulAttr |= FILE_ARCHIVED;
        if ( strchr(argv[6].strptr, 'D')) ulAttr |= FILE_DIRECTORY;
        if ( strchr(argv[6].strptr, 'S')) ulAttr |= FILE_SYSTEM;
        if ( strchr(argv[6].strptr, 'H')) ulAttr |= FILE_HIDDEN;
        if ( strchr(argv[6].strptr, 'R')) ulAttr |= FILE_READONLY;
    }

    // Eighth argument: initial size
    if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
        if (( sscanf( argv[7].strptr, "%lld", &llSize )) != 1 ) return ( 40 );
    }

    // Ninth argument: I/O mode flags
    if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
        strupr( argv[8].strptr );
        if (strcspn(argv[8].strptr, "TNSR") > 0 ) return ( 40 );
        if ( strchr(argv[8].strptr, 'T')) fsMode |= OPEN_FLAGS_WRITE_THROUGH;
        if ( strchr(argv[8].strptr, 'N')) fsMode |= OPEN_FLAGS_NO_CACHE;
        if ( strchr(argv[8].strptr, 'S')) fsMode |= OPEN_FLAGS_SEQUENTIAL;
        if ( strchr(argv[8].strptr, 'R')) fsMode |= OPEN_FLAGS_RANDOM;
    }

    // Now the first argument: file name
    pszFile = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
    if ( pszFile == NULL ) {
        WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        return ( 0 );
    }
    strncpy( pszFile, argv[0].strptr, RXSTRLEN(argv[0]) );

    // Try and open the file
    rc = DosOpenL( pszFile, &hf, &ulResult, llSize, ulAttr, fsAction, fsMode, NULL );
    if (rc) {
        WriteErrorCode( rc, "DosOpenL");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        free( pszFile );
        return ( 0 );
    }

    // Return the handle as the REXX result string
    sprintf( achHandle, "%8X", hf );
    SaveResultString( prsResult, achHandle, strlen(achHandle) );        // 2016-02-20 SHL

    free( pszFile );
    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2Close                                                                 *
 *                                                                           *
 * Wrapper to DosClose: close a file/stream.                                 *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. File handle (returned by Sys2Open)                        (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   1 on success, or 0 if an error occurred.                                *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2Close( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HFILE  hf;
    APIRET rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have exactly one valid argument (the file handle)
    if ( argc != 1  || ( !RXVALIDSTRING(argv[0]) ))
        return ( 40 );
    if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );

    // Close the file
    rc = DosClose( hf );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosClose");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
    }
    else {
        SaveResultString( prsResult, PSZ_ONE, 1 );      // 2016-02-20 SHL
    }

    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2Seek                                                                  *
 *                                                                           *
 * Wrapper to DosSetFilePtrL: move the read/write pointer to the specified   *
 * location in a stream.                                                     *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. File handle (returned by Sys2Open)                        (REQUIRED) *
 *   2. The signed distance in bytes to move                      (REQUIRED) *
 *   3. Move method, one of:                                                 *
 *        B = Beginning of file                                              *
 *        C = Current position (DEFAULT)                                     *
 *        E = End of file                                                    *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   The new file position, in bytes or "" if error                          *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2Seek( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HFILE    hf;
    LONGLONG llPos,
             llActual;
    ULONG    ulMethod = FILE_CURRENT;
    CHAR     achActual[ US_LONGLONG_MAXZ ];
    APIRET   rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have at least two valid arguments
    if ( argc < 2 || ( !RXVALIDSTRING(argv[0]) ) || ( !RXVALIDSTRING(argv[1]) ))
        return ( 40 );

    // First argument: file handle
    if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );

    // Second argument: requested offset
    if (( sscanf( argv[1].strptr, "%lld", &llPos )) != 1 ) return ( 40 );

    // Third argument: starting position
    if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
        strupr( argv[2].strptr );
        if ( strcspn(argv[2].strptr, "BCE") > 0 ) return ( 40 );
        switch ( argv[2].strptr[0] ) {
            case 'B': ulMethod = FILE_BEGIN;   break;
            case 'E': ulMethod = FILE_END;     break;
            default : ulMethod = FILE_CURRENT; break;
        }
    }

    rc = DosSetFilePtrL( hf, llPos, ulMethod, &llActual );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosSetFilePtrL");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        return ( 0 );
    }

    // Return the new position as the REXX result string
    sprintf( achActual, "%lld", llActual );
    SaveResultString( prsResult, achActual, strlen(achActual) );        // 2016-02-20 SHL

    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2BytesRemaining                                                        *
 *                                                                           *
 * Return the number bytes that remain in a stream following the current     *
 * read/write position.                                                      *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   The number of bytes remaining. In case of error, 0 will be returned and *
 * SYS2ERR will be set.                                                      *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2BytesRemaining( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HFILE        hf;
    FILESTATUS3L fst3l = {0};
    LONGLONG ll = {0},
             llPos,
             llSize;
    CHAR   achActual[ US_LONGLONG_MAXZ ];
    APIRET rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have one valid argument
    if ( argc != 1  || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );

    // First argument: handle
    if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );

    // Get the current position
    rc = DosSetFilePtrL( hf, ll, FILE_CURRENT, &llPos );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosSetFilePtrL");
        SaveResultString( prsResult, NULL, 0 );
        return ( 0 );
    }

    // Get the total file size
    rc = DosQueryFileInfo( hf, FIL_STANDARDL, &fst3l, sizeof( fst3l ));
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosQueryFileInfoL");
        SaveResultString( prsResult, NULL, 0 );
        return ( 0 );
    }
    llSize = fst3l.cbFile - llPos;

    // Return the position as the REXX result string
    sprintf( achActual, "%lld", llSize );
    SaveResultString( prsResult, achActual, strlen(achActual) );

    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2Read                                                                  *
 *                                                                           *
 * Wrapper to DosRead: read bytes from a previously-opened stream.           *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
 *   2. Number of bytes to read                                   (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   String containing the bytes read, or "" in case of error.               *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2Read( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HFILE  hf;
    ULONG  cb,
           cbActual;
    PSZ    pszData;
    APIRET rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have two valid arguments
    if ( argc != 2  || ( !RXVALIDSTRING(argv[0]) ) || ( !RXVALIDSTRING(argv[1]) ))
        return ( 40 );

    // First argument: handle
    if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );

    // Second argument: number of bytes to read
    if (( sscanf( argv[1].strptr, "%u", &cb )) != 1 ) return ( 40 );
    if ( cb < 1 ) return ( 40 );
    pszData = (PSZ) malloc( cb );

    rc = DosRead( hf, pszData, cb, &cbActual );
    if ( rc || !cbActual ) {
        WriteErrorCode( rc, "DosRead");
        SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
        goto cleanup;
    }
    SaveResultString( prsResult, pszData, cbActual );   // 2016-02-20 SHL

cleanup:
    free( pszData );
    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2ReadLine                                                              *
 *                                                                           *
 * Read a line (up to the next LF byte) from a previously-opened stream.     *
 * Only line feed (0x0A) bytes are treated as line-end characters; they will *
 * be stripped from the result string.  Carriage return bytes (0x0D) will    *
 * be skipped over but otherwise ignored.                                    *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   String containing the text read. In the event of error, this will be "" *
 * and SYS2ERR will be set.                                                  *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2ReadLine( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HFILE  hf;
    ULONG  cbBuf    = 0,
           cbTotal  = 0,
           cbActual = 0;
    PSZ    pszData;
    BOOL   fEOL = FALSE;
    CHAR   ch;
    APIRET rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have one valid argument
    if ( argc != 1  || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );

    // First argument: handle
    if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );

    cbBuf = 1024;
    pszData = (PSZ) malloc( cbBuf );
    while ( !fEOL ) {
        rc = DosRead( hf, &ch, 1, &cbActual );
        if ( rc ) {
            WriteErrorCode( rc, "DosRead");
            SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
            goto cleanup;
        }
        if ( !cbActual || ch == '\n') {
            fEOL = TRUE;
            break;
        }
        else if ( ch == '\r')
            continue;
        if ( cbTotal >= cbBuf ) {
            cbBuf += 256;
            pszData = (PSZ) realloc( pszData, cbBuf );
        }
        pszData[ cbTotal++ ] = ch;
    }
    SaveResultString( prsResult, pszData, cbTotal );   // 2016-02-20 SHL

cleanup:
    free( pszData );
    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2Write                                                                 *
 *                                                                           *
 * Wrapper to DosWrite: write bytes to a previously-opened stream.           *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
 *   2. Data to be written                                        (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   Number of bytes written.                                                *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2Write( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HFILE  hf;
    ULONG  cbActual;
    CHAR   szActual[ US_INTEGER_MAXZ ];
    APIRET rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have two valid arguments
    if ( argc != 2  || ( !RXVALIDSTRING(argv[0]) ) || ( !RXVALIDSTRING(argv[1]) ))
        return ( 40 );

    // First argument: handle
    if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );

    // (Second argument can be left in standard RXSTRING form)

    rc = DosWrite( hf, argv[1].strptr, argv[1].strlength, &cbActual );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosWrite");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
        return ( 0 );
    }

    sprintf( szActual, "%d", cbActual );
    SaveResultString( prsResult, szActual, strlen(szActual) );  // 2016-02-20 SHL
    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2SyncBuffer                                                            *
 *                                                                           *
 * Wrapper to DosResetBuffer: for external files, write the buffer to disk;  *
 * for pipes, block until the far end of the pipe has read the contents.     *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. File handle (returned by Sys2Open)                        (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   1 on success, or 0 if an error occurred.                                *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2SyncBuffer( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    HFILE  hf;
    APIRET rc;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have exactly one valid argument (the file handle)
    if ( argc != 1  || ( !RXVALIDSTRING(argv[0]) ))
        return ( 40 );
    if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );

    // Sync the buffer
    rc = DosResetBuffer( hf );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosResetBuffer");
        SaveResultString( prsResult, PSZ_ZERO, 1 );     // 2016-02-20 SHL
    }
    else {
        SaveResultString( prsResult, PSZ_ONE, 1 );      // 2016-02-20 SHL
    }

    return ( 0 );
}


/* ------------------------------------------------------------------------- *
 * Sys2QueryDriveInfo                                                        *
 *                                                                           *
 * Get non-filesystem-dependent information about a logical drive (volume).  *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. Drive/volume letter to query, trailing colon optional.    (REQUIRED) *
 *                                                                           *
 * REXX RETURN VALUE:                                                        *
 *   On success, returns a string in the format                              *
 *      <drive> <size> <type> <flag>                                         *
 *   where <drive> is the uppercase drive letter followed by a colon,        *
 *         <size>  is the total size of the drive/volume in binary kilobytes,*
 *         <type>  is one of:                                                *
 *                   FLOPPY_5L - 48 TPI low-density diskette drive           *
 *                   FLOPPY_5H - 96 TPI high-density diskette drive          *
 *                   FLOPPY_3L - 3.5-inch 720KB drive                        *
 *                   FLOPPY_3H - 3.5-inch high-density 1.44MB diskette drive *
 *                   FLOPPY_3X - 3.5-inch ext-density 2.88MB diskette drive  *
 *                   FLOPPY_8L - 8-inch single-density diskette drive        *
 *                   FLOPPY_8H - 8-inch double-density diskette drive        *
 *                   OTHER     - other (including CD drive with no media)    *
 *                   HDD       - hard disk drive (including PRM)             *
 *                   TAPE      - tape drive                                  *
 *                   OPTICAL   - read/write optical drive                    *
 *     and <flag> is 1 for non-partitionable removable media (e.g. floppies) *
 *                or 0 otherwise (including both fixed and PRM disks)        *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2QueryDriveInfo( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    BIOSPARAMETERBLOCK data;
    CHAR   szDiskInfo[ US_DISKINFO_MAXZ ];
    UCHAR  achPP[ 2 ],
           chVol;
    ULONG  cbPP,
           cbData,
           ulSectors,
           ulSize;
    BOOL   bRemovable;
    APIRET rc;


    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have exactly one valid argument (the drive letter)
    if ( argc != 1  || ( !RXVALIDSTRING(argv[0]) ))
        return ( 40 );
    chVol = toupper( argv[0].strptr[0] );
    if (( chVol < 'A') || ( chVol > 'Z'))
        return ( 40 );

    cbPP = 2;
    achPP[ 0 ] = 0;
    achPP[ 1 ] = chVol - 65;
    cbData = sizeof( data );
    rc = DosDevIOCtl( (HFILE) -1, IOCTL_DISK, DSK_GETDEVICEPARAMS,
                      (PVOID) achPP, 2, &cbPP, &data, cbData, &cbData );
    if ( rc != NO_ERROR ) {
        WriteErrorCode( rc, "DosDevIOCtl");
        SaveResultString( prsResult, NULL, 0 );
        return ( 0 );
    }

    ulSectors = data.cSectors? data.cSectors: data.cLargeSectors;
    ulSize = (data.usBytesPerSector > 1024) ?
                 (ULONG) (ulSectors * ( data.usBytesPerSector / 1024 )) :
                 (ULONG) (ulSectors / ( 1024 / data.usBytesPerSector ));
    bRemovable = !( data.fsDeviceAttr & 1 );

    sprintf( szDiskInfo, "%c: %u ", chVol, ulSize );
    switch( data.bDeviceType ) {
        case 0:     // 48 TPI low-density diskette drive
            strncat( szDiskInfo, "FLOPPY_5L", US_DISKINFO_MAXZ-1 );
            break;
        case 1:     // 96 TPI high-density diskette drive
            strncat( szDiskInfo, "FLOPPY_5H", US_DISKINFO_MAXZ-1 );
            break;
        case 2:     // Small (3.5-inch) 720KB drive
            strncat( szDiskInfo, "FLOPPY_3L", US_DISKINFO_MAXZ-1 );
            break;
        case 3:     // 8-inch single-density diskette drive
            strncat( szDiskInfo, "FLOPPY_8L", US_DISKINFO_MAXZ-1 );
            break;
        case 4:     // 8-inch double-density diskette drive
            strncat( szDiskInfo, "FLOPPY_8H", US_DISKINFO_MAXZ-1 );
            break;
        case 5:     // Fixed disk
            strncat( szDiskInfo, "HDD", US_DISKINFO_MAXZ-1 );
            break;
        case 6:     // Tape drive
            strncat( szDiskInfo, "TAPE", US_DISKINFO_MAXZ-1 );
            break;
        case 7:     // Other (includes 1.44MB 3.5-inch diskette drive)
            if ( ulSize == 1440 )
                strncat( szDiskInfo, "FLOPPY_3H", US_DISKINFO_MAXZ-1 );
            else
                strncat( szDiskInfo, "OTHER", US_DISKINFO_MAXZ-1 );
            break;
        case 8:     // R/W optical disk
            strncat( szDiskInfo, "OPTICAL", US_DISKINFO_MAXZ-1 );
            break;
        case 9:     // 3.5-inch 4.0MB diskette drive (2.88MB formatted)
            strncat( szDiskInfo, "FLOPPY_3X", US_DISKINFO_MAXZ-1 );
            break;
        default:
            strncat( szDiskInfo, "UNKNOWN", US_DISKINFO_MAXZ-1 );
            break;
    }
    strncat( szDiskInfo, ( bRemovable? " 1": " 0" ), US_DISKINFO_MAXZ-1 );

    SaveResultString( prsResult, szDiskInfo, strlen(szDiskInfo) );
    return ( 0 );
}



/* ------------------------------------------------------------------------- *
 * Sys2QuerySysValue                                                         *
 *                                                                           *
 * Query the given system value.                                             *
 *                                                                           *
 * REXX ARGUMENTS:                                                           *
 *   1. The system value identifier  (REQUIRED)                              *
 *                                                                           *
 * REXX RETURN VALUE: The requested system value, or "" on error.            *
 * ------------------------------------------------------------------------- */
ULONG APIENTRY Sys2QuerySysValue( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
{
    CHAR szResult[ US_INTEGER_MAXZ ];
    LONG lID,
         lValue;

    // Reset the error indicator
    WriteErrorCode( 0, NULL );

    // Make sure we have exactly one valid argument
    if ( argc != 1  || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );

    // Parse the identifier
    lID = -1;
    strupr( argv[0].strptr );
    if (( sscanf( argv[0].strptr, "%d", &lID )) != 1 ) {
        if ( ! stricmp( argv[0].strptr, "ALARM")) lID =                    SV_ALARM;
        else if ( ! stricmp( argv[0].strptr, "ALTMNEMONIC")) lID =         SV_ALTMNEMONIC;
        else if ( ! stricmp( argv[0].strptr, "ANIMATIONSPEED")) lID =      SV_ANIMATIONSPEED;
        else if ( ! stricmp( argv[0].strptr, "ANIMATION")) lID =           SV_ANIMATION;
        else if ( ! stricmp( argv[0].strptr, "BEGINDRAG")) lID =           SV_BEGINDRAG;
        else if ( ! stricmp( argv[0].strptr, "BEGINDRAGKB")) lID =         SV_BEGINDRAGKB;
        else if ( ! stricmp( argv[0].strptr, "BEGINSELECT")) lID =         SV_BEGINSELECT;
        else if ( ! stricmp( argv[0].strptr, "BEGINSELECTKB")) lID =       SV_BEGINSELECTKB;
        else if ( ! stricmp( argv[0].strptr, "CHORDTIME")) lID =           SV_CHORDTIME;
        else if ( ! stricmp( argv[0].strptr, "CICONTEXTLINES")) lID =      SV_CICONTEXTLINES;
        else if ( ! stricmp( argv[0].strptr, "CMOUSEBUTTONS")) lID =       SV_CMOUSEBUTTONS;
        else if ( ! stricmp( argv[0].strptr, "CONTEXTHELPKB")) lID =       SV_CONTEXTHELPKB;
        else if ( ! stricmp( argv[0].strptr, "CONTEXTHELP")) lID =         SV_CONTEXTHELP;
        else if ( ! stricmp( argv[0].strptr, "CONTEXTMENU")) lID =         SV_CONTEXTMENU;
        else if ( ! stricmp( argv[0].strptr, "CONTEXTMENUKB")) lID =       SV_CONTEXTMENUKB;
        else if ( ! stricmp( argv[0].strptr, "CPOINTERBUTTONS")) lID =     SV_CPOINTERBUTTONS;
        else if ( ! stricmp( argv[0].strptr, "CTIMERS")) lID =             SV_CTIMERS;
        else if ( ! stricmp( argv[0].strptr, "CURSORLEVEL")) lID =         SV_CURSORLEVEL;
        else if ( ! stricmp( argv[0].strptr, "CURSORRATE")) lID =          SV_CURSORRATE;
        else if ( ! stricmp( argv[0].strptr, "CXALIGN")) lID =             SV_CXALIGN;
        else if ( ! stricmp( argv[0].strptr, "CXBORDER")) lID =            SV_CXBORDER;
        else if ( ! stricmp( argv[0].strptr, "CXBYTEALIGN")) lID =         SV_CXBYTEALIGN;
        else if ( ! stricmp( argv[0].strptr, "CXCHORD")) lID =             SV_CXCHORD;
        else if ( ! stricmp( argv[0].strptr, "CXDBLCLK")) lID =            SV_CXDBLCLK;
        else if ( ! stricmp( argv[0].strptr, "CXDLGFRAME")) lID =          SV_CXDLGFRAME;
        else if ( ! stricmp( argv[0].strptr, "CXFULLSCREEN")) lID =        SV_CXFULLSCREEN;
        else if ( ! stricmp( argv[0].strptr, "CXHSCROLLARROW")) lID =      SV_CXHSCROLLARROW;
        else if ( ! stricmp( argv[0].strptr, "CXHSLIDER")) lID =           SV_CXHSLIDER;
        else if ( ! stricmp( argv[0].strptr, "CXICONTEXTWIDTH")) lID =     SV_CXICONTEXTWIDTH;
        else if ( ! stricmp( argv[0].strptr, "CXICON")) lID =              SV_CXICON;
        else if ( ! stricmp( argv[0].strptr, "CXMINMAXBUTTON")) lID =      SV_CXMINMAXBUTTON;
        else if ( ! stricmp( argv[0].strptr, "CXMOTIONSTART")) lID =       SV_CXMOTIONSTART;
        else if ( ! stricmp( argv[0].strptr, "CXPOINTER")) lID =           SV_CXPOINTER;
        else if ( ! stricmp( argv[0].strptr, "CXSCREEN")) lID =            SV_CXSCREEN;
        else if ( ! stricmp( argv[0].strptr, "CXSIZEBORDER")) lID =        SV_CXSIZEBORDER;
        else if ( ! stricmp( argv[0].strptr, "CXVSCROLL")) lID =           SV_CXVSCROLL;
        else if ( ! stricmp( argv[0].strptr, "CYALIGN")) lID =             SV_CYALIGN;
        else if ( ! stricmp( argv[0].strptr, "CYBORDER")) lID =            SV_CYBORDER;
        else if ( ! stricmp( argv[0].strptr, "CYBYTEALIGN")) lID =         SV_CYBYTEALIGN;
        else if ( ! stricmp( argv[0].strptr, "CYCHORD")) lID =             SV_CYCHORD;
        else if ( ! stricmp( argv[0].strptr, "CYDBLCLK")) lID =            SV_CYDBLCLK;
        else if ( ! stricmp( argv[0].strptr, "CYDLGFRAME")) lID =          SV_CYDLGFRAME;
        else if ( ! stricmp( argv[0].strptr, "CYFULLSCREEN")) lID =        SV_CYFULLSCREEN;
        else if ( ! stricmp( argv[0].strptr, "CYHSCROLL")) lID =           SV_CYHSCROLL;
        else if ( ! stricmp( argv[0].strptr, "CYICON")) lID =              SV_CYICON;
        else if ( ! stricmp( argv[0].strptr, "CYMENU")) lID =              SV_CYMENU;
        else if ( ! stricmp( argv[0].strptr, "CYMINMAXBUTTON")) lID =      SV_CYMINMAXBUTTON;
        else if ( ! stricmp( argv[0].strptr, "CYMOTIONSTART")) lID =       SV_CYMOTIONSTART;
        else if ( ! stricmp( argv[0].strptr, "CYPOINTER")) lID =           SV_CYPOINTER;
        else if ( ! stricmp( argv[0].strptr, "CYSCREEN")) lID =            SV_CYSCREEN;
        else if ( ! stricmp( argv[0].strptr, "CYSIZEBORDER")) lID =        SV_CYSIZEBORDER;
        else if ( ! stricmp( argv[0].strptr, "CYTITLEBAR")) lID =          SV_CYTITLEBAR;
        else if ( ! stricmp( argv[0].strptr, "CYVSCROLLARROW")) lID =      SV_CYVSCROLLARROW;
        else if ( ! stricmp( argv[0].strptr, "CYVSLIDER")) lID =           SV_CYVSLIDER;
        else if ( ! stricmp( argv[0].strptr, "DBLCLKTIME")) lID =          SV_DBLCLKTIME;
        else if ( ! stricmp( argv[0].strptr, "DEBUG")) lID =               SV_DEBUG;
        else if ( ! stricmp( argv[0].strptr, "ENDDRAG")) lID =             SV_ENDDRAG;
        else if ( ! stricmp( argv[0].strptr, "ENDDRAGKB")) lID =           SV_ENDDRAGKB;
        else if ( ! stricmp( argv[0].strptr, "ENDSELECTKB")) lID =         SV_ENDSELECTKB;
        else if ( ! stricmp( argv[0].strptr, "ENDSELECT")) lID =           SV_ENDSELECT;
        else if ( ! stricmp( argv[0].strptr, "ERRORDURATION")) lID =       SV_ERRORDURATION;
        else if ( ! stricmp( argv[0].strptr, "ERRORFREQ")) lID =           SV_ERRORFREQ;
        else if ( ! stricmp( argv[0].strptr, "FIRSTSCROLLRATE")) lID =     SV_FIRSTSCROLLRATE;
        else if ( ! stricmp( argv[0].strptr, "INSERTMODE")) lID =          SV_INSERTMODE;
        else if ( ! stricmp( argv[0].strptr, "KBDALTERED")) lID =          SV_KBDALTERED;
        else if ( ! stricmp( argv[0].strptr, "LOCKSTARTINPUT")) lID =      SV_LOCKSTARTINPUT;
        else if ( ! stricmp( argv[0].strptr, "MENUROLLDOWNDELAY")) lID =   SV_MENUROLLDOWNDELAY;
        else if ( ! stricmp( argv[0].strptr, "MENUROLLUPDELAY")) lID =     SV_MENUROLLUPDELAY;
        else if ( ! stricmp( argv[0].strptr, "MONOICONS")) lID =           SV_MONOICONS;
        else if ( ! stricmp( argv[0].strptr, "MOUSEPRESENT")) lID =        SV_MOUSEPRESENT;
        else if ( ! stricmp( argv[0].strptr, "NOTEDURATION")) lID =        SV_NOTEDURATION;
        else if ( ! stricmp( argv[0].strptr, "NOTEFREQ")) lID =            SV_NOTEFREQ;
        else if ( ! stricmp( argv[0].strptr, "NUMBEREDLISTS")) lID =       SV_NUMBEREDLISTS;
        else if ( ! stricmp( argv[0].strptr, "OPEN")) lID =                SV_OPEN;
        else if ( ! stricmp( argv[0].strptr, "OPENKB")) lID =              SV_OPENKB;
        else if ( ! stricmp( argv[0].strptr, "POINTERLEVEL")) lID =        SV_POINTERLEVEL;
        else if ( ! stricmp( argv[0].strptr, "PRINTSCREEN")) lID =         SV_PRINTSCREEN;
        else if ( ! stricmp( argv[0].strptr, "SCROLLRATE")) lID =          SV_SCROLLRATE;
        else if ( ! stricmp( argv[0].strptr, "SELECTKB")) lID =            SV_SELECTKB;
        else if ( ! stricmp( argv[0].strptr, "SETLIGHTS")) lID =           SV_SETLIGHTS;
        else if ( ! stricmp( argv[0].strptr, "SINGLESELECT")) lID =        SV_SINGLESELECT;
        else if ( ! stricmp( argv[0].strptr, "SWAPBUTTON")) lID =          SV_SWAPBUTTON;
        else if ( ! stricmp( argv[0].strptr, "TASKLISTMOUSEACCESS")) lID = SV_TASKLISTMOUSEACCESS;
        else if ( ! stricmp( argv[0].strptr, "TEXTEDIT")) lID =            SV_TEXTEDIT;
        else if ( ! stricmp( argv[0].strptr, "TEXTEDITKB")) lID =          SV_TEXTEDITKB;
        else if ( ! stricmp( argv[0].strptr, "TRACKRECTLEVEL")) lID =      SV_TRACKRECTLEVEL;
        else if ( ! stricmp( argv[0].strptr, "WARNINGDURATION")) lID =     SV_WARNINGDURATION;
        else if ( ! stricmp( argv[0].strptr, "WARNINGFREQ")) lID =         SV_WARNINGFREQ;
    }
    if ( lID < 0 ) return ( 40 );

    lValue = WinQuerySysValue( HWND_DESKTOP, lID );
    if ( lValue == 0 ) {
        /* Not elegant but probably true if the function failed.  Anyway,
         * we don't have a HAB so we can't really use WinGetLastError()...
         */
        WriteErrorCode( PMERR_PARAMETER_OUT_OF_RANGE, "WinQuerySysValue");
        SaveResultString( prsResult, PSZ_ZERO, 1 );
        return ( 0 );
    }

    // Return the value as the REXX return string
    sprintf( szResult, "%d", lValue );
    SaveResultString( prsResult, szResult, strlen(szResult) );

    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.    *
 * ------------------------------------------------------------------------- */
// 2016-02-20 SHL Rework to avoid traps
ULONG GetProcess( PCSZ pszProgram,
                  PSZ pszFullName,
                  PULONG pulPID,
                  PULONG pulPPID,
                  PULONG pulType,
                  PUSHORT pusPriority,
                  PULONG pulCPU        )
{
#ifdef USE_DQPS
    QSPTRREC *pBuf;                     // Data returned by DosQProcStatus()
#else
    QSPTRREC *pBuf;                     // Data returned by DosQuerySysState()  // 2015-04-23 SHL
#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
    PPIB   ppib;                        // pointer to current process info block
    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

    // Use current process when PID is 0 and program name is not specified
    if (( pszProgram == NULL ) && ( *pulPID == 0 )) {
        rc = DosGetInfoBlocks( NULL, &ppib );
        if ( rc != NO_ERROR ) {
            WriteErrorCode( rc, "DosGetInfoBlocks");
            return ( rc );
        }
        *pulPID = ppib->pib_ulpid;
    }

#ifdef USE_DQPS
    pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE );
#else
    pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE ); // 2015-04-23 SHL
#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");
        free( pBuf );
        return ( rc );
    }
    pPrec = (QSPREC *)(((QSPTRREC*)pBuf) -> pProcRec);  // 2015-04-23 SHL
#endif

    *pulPPID     = 0;
    *pulType     = 0;
    *pusPriority = 0;
    *pulCPU      = 0;
    if ( pszProgram != NULL ) *pulPID  = 0;
    else if ( *pulPID == 0 ) return 0;

#   if 1 // 2016-02-25 SHL FIXME debug bad pointer
    // 2016-02-26 SHL FIXME to be gone when sure can not occur
    if ( (ULONG)pPrec < 0x10000 ) {
        sprintf( szName, "rxutilex#%u pPrec 0x%x < 0x10000", __LINE__, (ULONG)pPrec );
        WriteErrorCode( ERROR_INVALID_ADDRESS, szName);
        free( pBuf );
        return ( 0 );
    }
#   endif

    // Now look for the specified process
    // List ends with RecType not QS_PROCESS or pThrdRec NULL
    while ( pPrec->RecType == QS_PROCESS && pPrec->pThrdRec != NULL && !fMatch ) {

        if ( pszProgram == NULL ) {
            // Match by pid
            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 *)(pPrec->pThrdRec + pPrec->cTCB);

#       if 1 // 2016-02-25 SHL FIXME debug pointer - can this occur?
        // 2016-02-26 SHL FIXME to be gone when sure can not occur
        if ( (ULONG)pPrec < 0x10000 ) {
            sprintf( szName, "rxutilex#%u pPrec 0x%x < 0x10000", __LINE__, (ULONG)pPrec );
            WriteErrorCode( ERROR_INVALID_ADDRESS, szName);
            free( pBuf );
            return ( 0 );
        }
#       endif

    } // while
    if ( !fMatch ) *pulPID = 0;

    free( pBuf );
    return ( 0 );
}


#ifndef LEGACY_C_LOCALE

/* ------------------------------------------------------------------------- *
 * GetLocaleString                                                           *
 *                                                                           *
 * Get the requested representation string for the current locale.           *
 * The argument is a pointer to a string which will be allocated by this     *
 * function.  It is the caller's responsibility to free() it.                *
 *                                                                           *
 * ARGUMENTS:                                                                *
 *   PSZ   *ppszItem: Pointer to string to be allocated.                 (O) *
 *   LocaleItem item: Locale item to query.                              (I) *
 *                                                                           *
 * RETURNS: int                                                              *
 *   The ULS function return code.                                           *
 * ------------------------------------------------------------------------- */
int GetLocaleString( PSZ *ppszItem, LocaleItem item )
{
    UconvObject  uconv = NULL;
    LocaleObject locale = NULL;
    UniChar     *puzSep;
    int          rc = 0;
    int          buf_size;
    PSZ          pszBuffer;

    rc = UniCreateLocaleObject( UNI_MBS_STRING_POINTER, "", &locale );
    if ( rc != ULS_SUCCESS ) {
        WriteErrorCode( rc, "UniCreateLocaleObject");
        return ( rc );
    }
    rc = UniQueryLocaleItem( locale, item, &puzSep );
    if ( rc == ULS_SUCCESS ) {
        buf_size = UniStrlen( puzSep ) * 3;
        pszBuffer = (PSZ) calloc( 1, buf_size + 1 );
        if ( pszBuffer ) {
            if ( UniCreateUconvObject(L"", &uconv ) == ULS_SUCCESS ) {
                if ( UniStrFromUcs( uconv, pszBuffer, puzSep, buf_size ))
                    sprintf( pszBuffer, "%ls", puzSep );
                UniFreeUconvObject( uconv );
            }
            else
                sprintf( pszBuffer, "%ls", puzSep );
            *ppszItem = pszBuffer;
        }
        else {
            rc = ERROR_NOT_ENOUGH_MEMORY;
            WriteErrorCode( rc, "calloc");
        }
        UniFreeMem( puzSep );
    }
    else WriteErrorCode( rc, "UniQueryLocaleItem");

    UniFreeLocaleObject( locale );
    return ( rc );
}


/* ------------------------------------------------------------------------- *
 * GroupNumber                                                               *
 *                                                                           *
 * Format an unsigned number into three-digit (thousands) groups, separated  *
 * by the designated separator string. The output buffer must be allocated,  *
 * and must be large enough to hold a 64-bit integer with the added          *
 * separators, i.e. 20 + (separator length * 6 ).  This function does not    *
 * perform any bounds checking, so the caller must ensure this.              *
 *                                                                           *
 * ARGUMENTS:                                                                *
 *   PSZ       buf: The output string buffer.                           (IO) *
 *   ULONGLONG val: The number value to format.                          (I) *
 *   PSZ       sep: The group-separator string.                          (I) *
 *                                                                           *
 * RETURNS: N/A                                                              *
 * ------------------------------------------------------------------------- */
void GroupNumber( PSZ buf, ULONGLONG val, PSZ sep )
{
    if ( val < 1000 ) {
        sprintf( buf, "%u", val );
        return;
    }
    GroupNumber( buf, val / 1000, sep );
    sprintf( buf+strlen(buf), "%s%03u", sep, val % 1000 );
}

#endif      // #ifndef LEGACY_C_LOCALE


#ifdef NO_SHARED_SOURCE

/****
 **** MOVED TO shfuncs.c
 ****/

/* ------------------------------------------------------------------------- *
 * SaveResultString                                                          *
 *                                                                           *
 * Writes new string contents to the specified RXSTRING, allocating any      *
 * additional memory that may be required.                                   *
 *                                                                           *
 * ARGUMENTS:                                                                *
 *   PRXSTRING prsResult: Pointer to an existing RXSTRING for writing.       *
 *   PCH       pchBytes : The string contents to write to prsResult or NULL  *
 *   ULONG     ulBytes  : The number of bytes in pchBytes to write 0..N.     *
 *                                                                           *
 * RETURNS: BOOL                                                             *
 *   TRUE if prsResult was successfully updated.  FALSE otherwise.           *
 * ------------------------------------------------------------------------- */
BOOL SaveResultString( PRXSTRING prsResult, PCSZ pchBytes, ULONG ulBytes )
{
    ULONG ulRC;
    PCH   pchNew;

    // 2016-02-20 SHL Rework for easier usage
    if (!pchBytes)
        ulBytes = 0;                              // Sync for caller
    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");
            prsResult->strlength = 0;           // 2016-02-20 SHL Force result to empty string
            return ( FALSE );
        }
        // 2015-06-03 SHL dropped DosFreeMem(prsResult->strptr);
        // 2015-06-03 SHL Pointer not allocated by DosAllocMem
        prsResult->strptr = pchNew;
    }
    if (ulBytes)
        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.                                      *
 * ------------------------------------------------------------------------- */
// 2016-02-20 SHL
BOOL WriteStemElement( PCSZ pszStem, ULONG ulIndex, PCSZ pszValue )
{
    SHVBLOCK shvVar;                   // REXX shared variable pool block
    ULONG    ulRc,
             ulBytes;
    CHAR     szCompoundName[ US_COMPOUND_MAXZ ];

    sprintf( szCompoundName, "%s.%d", pszStem, ulIndex );
    if ( pszValue == NULL ) {
        pszValue = "";
        ulBytes  = 0;
    } else {
        // 2015-06-03 SHL Was using DosAllocMem and leaking memory
        // REXX API does not free this kind of buffer
        ulBytes = strlen(pszValue);
    }
    MAKERXSTRING( shvVar.shvname, szCompoundName, strlen(szCompoundName) );
    shvVar.shvvalue.strptr    = (PCH)pszValue;
    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, PCSZ pszContext )
{
    SHVBLOCK shvVar;                   // REXX shared variable pool block
    ULONG    ulRc;
    CHAR     szErrorText[ US_ERRSTR_MAXZ ];

    if ( pszContext == NULL )
        sprintf( szErrorText, "%u", ulError );
    else
        sprintf( szErrorText, "%u: %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;
    shvVar.shvret      = 0;             // 2016-02-26 SHL
    ulRc = RexxVariablePool( &shvVar );
    // 2016-02-26 SHL Correct if
    if ( ulRc & ~RXSHV_NEWV )
        printf("* Unable to set %s: shvret = 0x%x, apiret = 0x%x\n", shvVar.shvname.strptr, (UCHAR)shvVar.shvret, ulRc ); // 2016-02-26 SHL Correct formatting
}

#endif      // #ifdef NO_SHARED_SOURCE