Context Navigation

rxutilex.c@ 48

Last change on this file since 48 was 48, checked in by Alex Taylor, 6 years ago
Add Sys2SetSize
File size: 148.2 KB

Rev	Line
[4]	1	/******************************************************************************
	2	* REXX Utility Functions - Extended (RXUTILEX.DLL) *
[48]	3	* (C) 2011, 2019 Alex Taylor. *
[4]	4	* *
	5	* LICENSE: *
	6	* *
	7	* Redistribution and use in source and binary forms, with or without *
	8	* modification, are permitted provided that the following conditions are *
	9	* met: *
	10	* *
	11	* 1. Redistributions of source code must retain the above copyright *
	12	* notice, this list of conditions and the following disclaimer. *
	13	* *
	14	* 2. Redistributions in binary form must reproduce the above copyright *
	15	* notice, this list of conditions and the following disclaimer in the *
	16	* documentation and/or other materials provided with the distribution. *
	17	* *
	18	* 3. The name of the author may not be used to endorse or promote products *
	19	* derived from this software without specific prior written permission. *
	20	* *
	21	* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ''AS IS'' AND ANY EXPRESS OR *
	22	* IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED *
	23	* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE *
	24	* DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, *
	25	* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES *
	26	* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR *
	27	* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) *
	28	* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, *
	29	* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN *
	30	* ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE *
	31	* POSSIBILITY OF SUCH DAMAGE. *
	32	* *
	33	******************************************************************************/
	34
	35	// Uncomment to use DosQProcStatus() instead of DosQuerySysState().
	36	// -- This was mostly put in place for early testing to see if either function
	37	// was more/less reliable than the other. In practice, DosQuerySysState()
	38	// should probably be used.
	39	// #define USE_DQPS
	40
[23]	41	// Uncomment to use legacy C style locale data instead of the OS/2 ULS library
[41]	42	// #define LEGACY_C_LOCALE
[4]	43
	44	#define INCL_WINATOM
	45	#define INCL_WINCLIPBOARD
	46	#define INCL_WINERRORS
[40]	47	#define INCL_WINSYS
[36]	48	#define INCL_DOS
	49	#define INCL_DOSDEVIOCTL
[16]	50	#define INCL_DOSERRORS
[4]	51	#define INCL_DOSMISC
[16]	52	#define INCL_DOSMODULEMGR
	53	#define INCL_DOSNMPIPES
[4]	54	#define INCL_DOSPROCESS
	55	#define INCL_DOSPROFILE
[39]	56	#define INCL_LONGLONG
[4]	57	#ifndef OS2_INCLUDED
	58	#include <os2.h>
	59	#endif
[23]	60
[36]	61	#include <ctype.h>
[4]	62	#include <stdio.h>
	63	#include <stdlib.h>
	64	#include <string.h>
	65	#include <time.h>
[41]	66	#include <locale.h>
[23]	67
	68	#ifdef LEGACY_C_LOCALE
	69	#include <nl_types.h>
	70	#include <langinfo.h>
	71	#else
	72	#include <unidef.h>
[41]	73	#include <uconv.h>
[23]	74	#endif
	75
[4]	76	#define INCL_RXSHV
	77	#define INCL_RXFUNC
	78	#include <rexxsaa.h>
	79
[33]	80
	81	#include "shfuncs.h"
	82
	83
[4]	84	#pragma import( DosGetPrty, "DosGetPrty", "DOSCALL1", 9 )
	85	USHORT APIENTRY16 DosGetPrty( USHORT usScope, PUSHORT pusPriority, USHORT pid );
	86
	87	#ifdef USE_DQPS
	88	#pragma import( DosQProcStatus, "DosQProcStatus", "DOSCALL1", 154 )
	89	USHORT APIENTRY16 DosQProcStatus( PVOID pBuf, USHORT cbBuf );
	90	#endif
	91
	92	// CONSTANTS
	93
	94	#define SZ_LIBRARY_NAME "RXUTILEX" // Name of this library
[40]	95	//#define SZ_ERROR_NAME "SYS2ERR" // REXX variable used to store error codes - must be defined in Makefile
[47]	96	#define SZ_VERSION "0.1.7" // Current version of this library
[4]	97
	98	// Maximum string lengths...
[33]	99	#ifdef NO_SHARED_SOURCE
	100	#define US_COMPOUND_MAXZ 250 // ...of a compound variable
	101	#define US_ERRSTR_MAXZ 250 // ...of an error string
	102
	103	static const char *PSZ_ZERO = "0";
[43]	104	static const char *PSZ_ONE = "1";
[33]	105	#endif
	106
[16]	107	#define US_INTEGER_MAXZ 12 // ...of a 32-bit integer string
	108	#define US_LONGLONG_MAXZ 21 // ...of a 64-bit integer string
[4]	109	#define US_STEM_MAXZ ( US_COMPOUND_MAXZ - US_INTEGER_MAXZ ) // ...of a stem
	110	#define US_PIDSTR_MAXZ ( CCHMAXPATH + 100 ) // ...of a process information string
	111	#define US_TIMESTR_MAXZ 256 // ...of a formatted time string
[41]	112	#define US_NUMSTR_MAXZ 32 // ...of a formatted number string
[16]	113	#define US_PIPESTATUS_MAXZ 128 // ...of a pipe status string
[36]	114	#define US_DISKINFO_MAXZ 128 // ...of a disk information string
[43]	115	#define US_FRACSTR_MAXZ 21 // ...of a fraction string
[4]	116
	117	#define UL_SSBUFSIZE 0xFFFF // Buffer size for the DosQuerySysState() data
	118
	119	// Time string formats
	120	#define FL_TIME_DEFAULT 0
	121	#define FL_TIME_ISO8601 1
	122	#define FL_TIME_LOCALE 2
	123
[24]	124	// List of functions to be registered by Sys2LoadFuncs or dropped by Sys2DropFuncs
	125	// Drop list starts at index 0, load list starts at index 1
[4]	126	static PSZ RxFunctionTbl[] = {
[30]	127	"Sys2LoadFuncs", // Drop only 2015-05-06 SHL
[4]	128	"Sys2DropFuncs",
	129	"Sys2GetClipboardText",
	130	"Sys2PutClipboardText",
	131	"Sys2QueryProcess",
	132	"Sys2QueryProcessList",
	133	"Sys2KillProcess",
[36]	134	"Sys2QueryDriveInfo",
[4]	135	"Sys2QueryForegroundProcess",
	136	"Sys2QueryPhysicalMemory",
[21]	137	"Sys2FormatNumber",
[4]	138	"Sys2FormatTime",
	139	"Sys2GetEpochTime",
	140	"Sys2ReplaceModule",
	141	"Sys2LocateDLL",
[16]	142	"Sys2CreateNamedPipe",
	143	"Sys2ConnectNamedPipe",
	144	"Sys2DisconnectNamedPipe",
	145	"Sys2CheckNamedPipe",
	146	"Sys2Open",
	147	"Sys2Close",
	148	"Sys2Seek",
[48]	149	"Sys2SetSize",
[39]	150	"Sys2BytesRemaining",
[16]	151	"Sys2Read",
[39]	152	"Sys2ReadLine",
[25]	153	"Sys2SyncBuffer",
[16]	154	"Sys2Write",
[40]	155	"Sys2QuerySysValue",
[47]	156	"Sys2Exec",
[4]	157	"Sys2Version"
	158	};
	159
	160	// FUNCTION DECLARATIONS
	161
	162	// Exported REXX functions
	163	RexxFunctionHandler Sys2LoadFuncs;
	164	RexxFunctionHandler Sys2DropFuncs;
	165	RexxFunctionHandler Sys2Version;
	166
[21]	167	RexxFunctionHandler Sys2FormatNumber;
[4]	168	RexxFunctionHandler Sys2FormatTime;
	169	RexxFunctionHandler Sys2GetEpochTime;
	170
	171	RexxFunctionHandler Sys2GetClipboardText;
	172	RexxFunctionHandler Sys2PutClipboardText;
	173
	174	RexxFunctionHandler Sys2QueryProcess;
	175	RexxFunctionHandler Sys2QueryProcessList;
	176	RexxFunctionHandler Sys2KillProcess;
	177	RexxFunctionHandler Sys2QueryForegroundProcess;
[47]	178	RexxFunctionHandler Sys2Exec;
[4]	179
[36]	180	RexxFunctionHandler Sys2QueryDriveInfo;
	181
[4]	182	RexxFunctionHandler Sys2QueryPhysicalMemory;
[40]	183	RexxFunctionHandler Sys2QuerySysValue;
[4]	184
	185	RexxFunctionHandler Sys2LocateDLL;
	186	RexxFunctionHandler Sys2ReplaceModule;
	187
[16]	188	RexxFunctionHandler Sys2CreateNamedPipe;
	189	RexxFunctionHandler Sys2ConnectNamedPipe;
	190	RexxFunctionHandler Sys2DisconnectNamedPipe;
	191	RexxFunctionHandler Sys2CheckNamedPipe;
[4]	192
[16]	193	RexxFunctionHandler Sys2Open;
	194	RexxFunctionHandler Sys2Close;
	195	RexxFunctionHandler Sys2Seek;
	196	RexxFunctionHandler Sys2Read;
	197	RexxFunctionHandler Sys2Write;
[25]	198	RexxFunctionHandler Sys2SyncBuffer;
[48]	199	RexxFunctionHandler Sys2SetSize;
[16]	200
[36]	201
[4]	202	// Private internal functions
[31]	203	ULONG GetProcess( PCSZ pszProgram, PSZ pszFullName, PULONG pulPID, PULONG pulPPID, PULONG pulType, PUSHORT pusPriority, PULONG pulCPU ); // 2016-02-20 SHL
[4]	204
[41]	205	#ifndef LEGACY_C_LOCALE
[48]	206	int GetLocaleString( PSZ *ppszItem, LocaleItem item );
[41]	207	void GroupNumber( PSZ buf, ULONGLONG val, PSZ sep );
	208	#endif
	209
[33]	210	#ifdef NO_SHARED_SOURCE
	211	BOOL SaveResultString( PRXSTRING prsResult, PCSZ pchBytes, ULONG ulBytes ); // 2016-02-20 SHL
	212	BOOL WriteStemElement( PCSZ pszStem, ULONG ulIndex, PCSZ pszValue ); // 2016-02-20 SHL
	213	void WriteErrorCode( ULONG ulError, PCSZ pszContext ); // 2016-02-20 SHL
	214	#endif
	215
[4]	216	// MACROS
	217	#define TIME_SECONDS( timeval ) ( timeval / 32 )
	218	#define TIME_HUNDREDTHS( timeval ) (( timeval % 32 ) * 100 / 32 )
	219
	220	/* ------------------------------------------------------------------------- *
	221	* Sys2LoadFuncs *
	222	* *
	223	* Register all Sys2* REXX functions (except this one, obviously). *
	224	* *
	225	* REXX ARGUMENTS: None *
	226	* REXX RETURN VALUE: "" *
	227	* ------------------------------------------------------------------------- */
	228	ULONG APIENTRY Sys2LoadFuncs( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	229	{
	230	int entries,
	231	i;
	232
	233	// Reset the error indicator
	234	WriteErrorCode( 0, NULL );
	235
	236	if ( argc > 0 ) return ( 40 );
	237	entries = sizeof(RxFunctionTbl) / sizeof(PSZ);
[24]	238	// 2015-05-06 SHL No need to load self (i.e. Sys2LoadFuncs), but do want to drop self
	239	for ( i = 1; i < entries; i++ )
[4]	240	RexxRegisterFunctionDll( RxFunctionTbl[i], SZ_LIBRARY_NAME, RxFunctionTbl[i] );
	241
[31]	242	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	243	return ( 0 );
	244	}
	245
	246
	247	/* ------------------------------------------------------------------------- *
	248	* Sys2DropFuncs *
	249	* *
	250	* Deregister all Sys2* REXX functions. *
	251	* *
	252	* REXX ARGUMENTS: None *
	253	* REXX RETURN VALUE: "" *
	254	* ------------------------------------------------------------------------- */
	255	ULONG APIENTRY Sys2DropFuncs( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	256	{
	257	int entries,
	258	i;
	259
	260	// Reset the error indicator
	261	WriteErrorCode( 0, NULL );
	262
	263	if ( argc > 0 ) return ( 40 );
	264	entries = sizeof(RxFunctionTbl) / sizeof(PSZ);
	265	for ( i = 0; i < entries; i++ )
	266	RexxDeregisterFunction( RxFunctionTbl[i] );
	267
[31]	268	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	269	return ( 0 );
	270	}
	271
	272
	273	/* ------------------------------------------------------------------------- *
	274	* Sys2Version *
	275	* *
	276	* Returns the current library version. *
	277	* *
	278	* REXX ARGUMENTS: None *
	279	* REXX RETURN VALUE: Current version in the form "major.minor.refresh" *
	280	* ------------------------------------------------------------------------- */
	281	ULONG APIENTRY Sys2Version( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	282	{
	283	CHAR szVersion[ 12 ];
	284
	285	// Reset the error indicator
	286	WriteErrorCode( 0, NULL );
	287
	288	if ( argc > 0 ) return ( 40 );
	289	sprintf( szVersion, "%s", SZ_VERSION );
	290
[31]	291	SaveResultString( prsResult, szVersion, strlen(szVersion) ); // 2016-02-20 SHL
[4]	292	return ( 0 );
	293	}
	294
	295
	296	/* ------------------------------------------------------------------------- *
	297	* Sys2PutClipboardText *
	298	* *
	299	* Write a string to the clipboard in plain-text format. Specifying either *
	300	* no value or an empty string in the first argument will simply clear the *
	301	* clipboard of CF_TEXT data. *
	302	* *
	303	* REXX ARGUMENTS: *
	304	* 1. String to be written to the clipboard (DEFAULT: "") *
	305	* 2. Flag indicating whether other clipboard formats should be cleared: *
	306	* Y = yes, call WinEmptyClipbrd() before writing text (DEFAULT) *
	307	* N = no, leave (non-CF_TEXT) clipboard data untouched *
	308	* *
	309	* REXX RETURN VALUE: 1 on success, 0 on failure *
	310	* ------------------------------------------------------------------------- */
	311	ULONG APIENTRY Sys2PutClipboardText( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	312	{
	313	PSZ pszShareMem; // text in clipboard
	314	ULONG ulRC = 0, // return code
	315	ulBytes = 0, // size of input string
	316	ulPType = 0; // process-type flag
	317	BOOL fEmptyCB = TRUE, // call WinEmptyClipbrd() first?
	318	fHabTerm = TRUE; // terminate HAB ourselves?
	319	HAB hab; // anchor-block handle (for Win*)
	320	HMQ hmq; // message-queue handle
	321	PPIB ppib; // process information block
	322	PTIB ptib; // thread information block
	323
	324
	325	// Reset the error indicator
	326	WriteErrorCode( 0, NULL );
	327
	328	// Make sure we have at least one valid argument (the input string)
	329	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
	330
	331	// The second argument is optional, but must be correct if specified
	332	if ( argc >= 2 ) {
	333	// second argument: flag to clear clipboard (Y/N, but also accept 0/1)
	334	if ( RXVALIDSTRING(argv[1]) ) {
	335	strupr( argv[1].strptr );
	336	if ( strcspn(argv[1].strptr, "YN01") > 0 ) return ( 40 );
	337	switch ( argv[1].strptr[0] ) {
	338	case 'N':
	339	case '0': fEmptyCB = FALSE; break;
	340	case 'Y':
	341	case '1':
	342	default : fEmptyCB = TRUE; break;
	343	}
	344	} else fEmptyCB = TRUE;
	345	}
	346
	347	// Initialize the PM API
	348	DosGetInfoBlocks( &ptib, &ppib );
	349	ulPType = ppib->pib_ultype;
[31]	350	ppib->pib_ultype = 3; // Morph to PM
[4]	351	hab = WinInitialize( 0 );
	352	if ( !hab ) {
	353	fHabTerm = FALSE;
	354	hab = 1;
	355	}
	356
	357	/* Try to create a message-queue if one doesn't exist. We don't need to
	358	* check the result, because it could fail if a message queue already exists
	359	* (in the calling process), which is also OK.
	360	*/
[31]	361	hmq = WinCreateMsgQueue( hab, 0 );
[4]	362
[31]	363	// 2016-02-20 SHL Sync return values with docs
	364
[4]	365	// Place the string on the clipboard as CF_TEXT
	366	ulRC = WinOpenClipbrd( hab );
	367	if ( ulRC ) {
	368
	369	if ( fEmptyCB ) WinEmptyClipbrd( hab );
	370
	371	ulBytes = argv[0].strlength + 1;
[31]	372	ulRC = DosAllocSharedMem( (PVOID) &pszShareMem,
	373	NULL,
	374	ulBytes,
[4]	375	PAG_READ \| PAG_WRITE \| PAG_COMMIT \| OBJ_GIVEABLE );
	376	if ( ulRC == 0 ) {
	377	memset( pszShareMem, 0, ulBytes );
[16]	378	strncpy( pszShareMem, argv[0].strptr, ulBytes - 1 );
[31]	379	if ( ! WinSetClipbrdData( hab, (ULONG) pszShareMem, CF_TEXT, CFI_POINTER ) ) {
	380	WriteErrorCode( ERRORIDERROR(WinGetLastError(hab)), "WinSetClipbrdData" );
	381	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
	382	}
[4]	383	else
[31]	384	SaveResultString( prsResult, PSZ_ONE, 1 ); // Success - 2016-02-20 SHL
[4]	385	} else {
	386	WriteErrorCode( ulRC, "DosAllocSharedMem");
[31]	387	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	388	}
	389
	390	WinCloseClipbrd( hab );
	391	} else {
[31]	392	// 2016-02-20 SHL Report PM error code
	393	WriteErrorCode( ERRORIDERROR(WinGetLastError(hab)), "WinOpenClipbrd" );
	394	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	395	}
	396
	397	if ( hmq != NULLHANDLE ) WinDestroyMsgQueue( hmq );
	398	if ( fHabTerm ) WinTerminate( hab );
[31]	399	ppib->pib_ultype = ulPType; // Restore
[4]	400
	401	return ( 0 );
	402	}
	403
	404
	405	/* ------------------------------------------------------------------------- *
	406	* Sys2GetClipboardText *
	407	* *
	408	* Retrieve a plain-text string from the clipboard if one is available. *
	409	* *
	410	* REXX ARGUMENTS: *
	411	* None. *
	412	* *
[31]	413	* REXX RETURN VALUE: The retrieved clipboard string or "" if fails. *
[4]	414	* ------------------------------------------------------------------------- */
	415	ULONG APIENTRY Sys2GetClipboardText( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	416	{
	417	PSZ pszClipText, // pointer to clipboard data
	418	pszLocalText; // our copy of the data (to return)
	419	ULONG ulRC = 0, // return code
	420	ulBytes = 0, // size in bytes of output string
	421	ulPType = 0; // process-type flag
	422	BOOL fHabTerm = TRUE; // terminate HAB ourselves?
	423	HAB hab; // anchor-block handle (for Win*)
	424	HMQ hmq; // message-queue handle
	425	PPIB ppib; // process information block
	426	PTIB ptib; // thread information block
	427
	428
	429	// Reset the error indicator
	430	WriteErrorCode( 0, NULL );
	431
	432	// Initialize the PM API
	433	DosGetInfoBlocks( &ptib, &ppib );
	434	ulPType = ppib->pib_ultype;
	435	ppib->pib_ultype = 3;
	436	hab = WinInitialize( 0 );
	437	if ( !hab ) {
	438	fHabTerm = FALSE;
	439	hab = 1;
	440	}
	441
	442	/* Note: A message-queue must exist before we can access the clipboard. We
	443	* don't actually use the returned value. In fact, we don't even
	444	* verify it, because it could be NULLHANDLE if this function was
	445	* called from a PM process (e.g. VX-REXX) - in which case, a message
	446	* queue should already exist, and we can proceed anyway.
	447	*/
	448	hmq = WinCreateMsgQueue( hab, 0 );
	449
	450	// Open the clipboard
	451	ulRC = WinOpenClipbrd( hab );
	452	if ( ulRC ) {
	453
	454	// Read plain text from the clipboard, if available
[31]	455	if (( pszClipText = (PSZ) WinQueryClipbrdData( hab, CF_TEXT ) ) != NULL ) {
[4]	456
[31]	457	ulBytes = strlen(pszClipText) + 1;
	458	if ( ( pszLocalText = (PSZ) malloc( ulBytes ) ) != NULL ) {
[4]	459	memset( pszLocalText, 0, ulBytes );
	460	strncpy( pszLocalText, pszClipText, ulBytes - 1 );
[31]	461	SaveResultString( prsResult, pszLocalText, ulBytes - 1 ); // 2016-02-20 SHL
[4]	462	free( pszLocalText );
	463	} else {
	464	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
[31]	465	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	466	}
	467
	468	} else {
	469	// Either no text exists, or clipboard is not readable
[31]	470	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	471	}
	472
	473	WinCloseClipbrd( hab );
	474	} else {
[31]	475	// 2016-02-20 SHL Report PM error code
	476	WriteErrorCode( ERRORIDERROR(WinGetLastError(hab)), "WinOpenClipbrd" );
	477	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	478	}
	479
	480	if ( hmq != NULLHANDLE ) WinDestroyMsgQueue( hmq );
	481	if ( fHabTerm ) WinTerminate( hab );
	482
	483	ppib->pib_ultype = ulPType;
	484
	485	return ( 0 );
	486	}
	487
	488
	489	/* ------------------------------------------------------------------------- *
	490	* Sys2QueryProcess *
	491	* *
	492	* Queries information about the specified process. *
	493	* *
	494	* REXX ARGUMENTS: *
	495	* 1. The process identifier (program name or process ID) (REQUIRED) *
	496	* 2. Flag indicicating the identifier type: *
	497	* 'P': decimal process ID *
	498	* 'H': hexadecimal process ID *
	499	* 'N': executable program name (with or without extension) (DEFAULT) *
	500	* *
	501	* REXX RETURN VALUE: *
	502	* A string of the format *
	503	* pid parent-pid process-type priority cpu-time executable-name *
	504	* "priority" is in hexadecimal notation, all other numbers are decimal. *
	505	* "" is returned if the process was not found or if an internal error *
	506	* occurred. *
	507	* ------------------------------------------------------------------------- */
	508	ULONG APIENTRY Sys2QueryProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	509	{
	510	PSZ pszProcName; // Requested process name
	511	UCHAR szFullName[ CCHMAXPATH ] = {0}, // Fully-qualified name
	512	szReturn[ US_PIDSTR_MAXZ ] = {0}; // Buffer for return value
	513	ULONG ulPID = 0, // Process ID
	514	ulPPID = 0, // Parent process ID
	515	ulType = 0, // Process type
	516	ulTime = 0; // Process CPU time
	517	USHORT usPrty = 0; // Process priority
	518	APIRET rc; // API return code
	519
	520
	521	// Reset the error indicator
	522	WriteErrorCode( 0, NULL );
	523
	524	// Make sure we have at least one valid argument (the input string)
	525	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
	526
	527	// Parse the ID type flag
[31]	528	if ( argc >= 2 && RXVALIDSTRING( argv[1] ) ) {
[4]	529	strupr( argv[1].strptr );
[31]	530	if ( strcspn(argv[1].strptr, "HNP") > 0 ) return ( 40 );
[4]	531	switch ( argv[1].strptr[0] ) {
	532
	533	case 'H': if (( sscanf( argv[0].strptr, "%X", &ulPID )) != 1 ) return ( 40 );
	534	pszProcName = NULL;
	535	break;
	536
	537	case 'P': if (( sscanf( argv[0].strptr, "%u", &ulPID )) != 1 ) return ( 40 );
	538	pszProcName = NULL;
	539	break;
	540
	541	default : pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
	542	if ( pszProcName == NULL ) {
	543	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
[31]	544	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	545	return ( 0 );
	546	}
	547	strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) );
	548	break;
	549	}
	550	} else {
	551	pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
	552	if ( pszProcName == NULL ) {
	553	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
[31]	554	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	555	return ( 0 );
	556	}
	557	strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) );
	558	}
	559
	560	// See if the requested process is running and get its PID/PPID
	561	rc = GetProcess( pszProcName, szFullName, &ulPID, &ulPPID, &ulType, &usPrty, &ulTime );
	562	if (( rc != NO_ERROR ) \|\| ( ulPID == 0 )) {
[31]	563	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	564	return ( 0 );
	565	}
	566
	567	sprintf( szReturn, "%u %u %u %04X %02u:%02u.%02u %s",
	568	ulPID, ulPPID, ulType, usPrty, TIME_SECONDS( ulTime ) / 60,
	569	TIME_SECONDS( ulTime ) % 60, TIME_HUNDREDTHS( ulTime ), szFullName );
	570
[31]	571	SaveResultString( prsResult, szReturn, strlen(szReturn) ); // 2016-02-20 SHL
[4]	572
	573	return ( 0 );
	574	}
	575
	576
	577	/* ------------------------------------------------------------------------- *
	578	* Sys2KillProcess *
	579	* *
	580	* Terminate the (first) running process with the specified executable name *
	581	* or process-ID. *
	582	* *
	583	* REXX ARGUMENTS: *
	584	* 1. The process identifier (program name or process ID) (REQUIRED) *
	585	* 2. Flag indicicating the identifier type: *
	586	* 'P': decimal process ID *
	587	* 'H': hexadecimal process ID *
	588	* 'N': executable program name (with or without extension) (DEFAULT) *
	589	* *
	590	* REXX RETURN VALUE: 1 on success or 0 on failure. *
	591	* ------------------------------------------------------------------------- */
	592	ULONG APIENTRY Sys2KillProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	593	{
	594	PSZ pszProcName; // Requested process name
	595	UCHAR szFullName[ CCHMAXPATH ] = {0}; // Fully-qualified name
	596	ULONG ulPID = 0, // Process ID
	597	ulPPID = 0, // Parent process ID (not used)
	598	ulType = 0, // Process type (not used)
	599	ulTime = 0; // Process CPU time (not used)
	600	USHORT usPrty = 0; // Process priority (not used)
	601	APIRET rc; // API return code
	602
	603
	604	// Reset the error indicator
	605	WriteErrorCode( 0, NULL );
	606
	607	// Make sure we have at least one valid argument (the input string)
	608	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
	609
	610	// Parse the ID type flag
	611	if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
	612	strupr( argv[1].strptr );
	613	if (strcspn(argv[1].strptr, "HNP") > 0 ) return ( 40 );
	614	switch ( argv[1].strptr[0] ) {
	615
	616	case 'H': if (( sscanf( argv[0].strptr, "%X", &ulPID )) != 1 ) return ( 40 );
	617	pszProcName = NULL;
	618	break;
	619
	620	case 'P': if (( sscanf( argv[0].strptr, "%u", &ulPID )) != 1 ) return ( 40 );
	621	pszProcName = NULL;
	622	break;
	623
	624	default : pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
	625	if ( pszProcName == NULL ) {
	626	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
[31]	627	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	628	return ( 0 );
	629	}
	630	strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) );
	631	break;
	632	}
	633	} else {
	634	pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
	635	if ( pszProcName == NULL ) {
	636	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
[31]	637	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	638	return ( 0 );
	639	}
	640	strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) );
	641	}
	642
[31]	643	if ( pszProcName ) {
[4]	644	// Get the process PID
	645	rc = GetProcess( pszProcName, szFullName, &ulPID, &ulPPID, &ulType, &usPrty, &ulTime );
	646	if (( rc != NO_ERROR ) \|\| ( ulPID == 0 )) {
[31]	647	free( pszProcName );
	648	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	649	return ( 0 );
	650	}
	651	}
	652
	653	// Now attempt to kill the process using DosKillProcess()
	654	rc = DosKillProcess( 1, ulPID );
	655	if ( rc != NO_ERROR ) {
	656	WriteErrorCode( rc, "DosKillProcess");
[31]	657	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	658	}
[31]	659	else
	660	SaveResultString( prsResult, PSZ_ONE, 1 ); // 2016-02-20 SHL
[4]	661
[31]	662	// 2016-02-20 SHL Avoid leak
	663	if ( pszProcName )
	664	free( pszProcName );
	665
[4]	666	return ( 0 );
	667	}
	668
	669
	670	/* ------------------------------------------------------------------------- *
	671	* Sys2QueryProcessList *
	672	* *
	673	* Gets the process ID of the specified executable, if it is running. *
	674	* The results will be returned in a stem variable, where stem.0 contains *
	675	* number of items, and each stem item is a string of the form: *
	676	* pid parent-pid process-type priority cpu-time executable-name *
	677	* "priority" is in hexadecimal notation, all other numbers are decimal. *
	678	* *
	679	* Notes: *
	680	* - "process-type" will be one of: *
	681	* 0 Full screen protect-mode session *
	682	* 1 Requires real mode. Dos emulation. *
	683	* 2 VIO windowable protect-mode session *
	684	* 3 Presentation Manager protect-mode session *
	685	* 4 Detached protect-mode process. *
	686	* - If "priority" is 0 then the priority class could not be determined. *
	687	* - If "executable-name" is "--" then the name could not be identified. *
	688	* *
	689	* REXX ARGUMENTS: *
	690	* 1. The name of the stem in which to return the results (REQUIRED) *
	691	* *
	692	* REXX RETURN VALUE: Number of processes found, or "" in case of error. *
	693	* ------------------------------------------------------------------------- */
	694	ULONG Sys2QueryProcessList( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	695	{
[30]	696	QSPTRREC *pBuf; // Data returned by DosQProcStatus/DosQuerySysState() // 2015-04-23 SHL
[4]	697	QSPREC *pPrec; // Pointer to process information block
	698	QSTREC *pTrec; // Pointer to thread information block
	699	CHAR szStem[ US_STEM_MAXZ ], // Buffers used for building strings ...
	700	szNumber[ US_INTEGER_MAXZ ], // ...
	701	szName[ CCHMAXPATH ], // Fully-qualified name of process
	702	szPInfo[ US_PIDSTR_MAXZ ]; // Stem item string
	703	ULONG ulCount, // Number of processes
	704	ulCPU; // Process CPU time
	705	USHORT usPriority, // Process priority class
	706	i; // Loop counter
	707	APIRET rc; // Return code
	708
	709
	710	// Reset the error indicator
	711	WriteErrorCode( 0, NULL );
	712
	713	// Do some validity checking on the arguments
	714	if (( argc != 1 ) \|\| // Make sure we have exactly one argument...
	715	( ! RXVALIDSTRING(argv[0]) ) \|\| // ...which is a valid REXX string...
	716	( RXSTRLEN(argv[0]) > US_STEM_MAXZ )) // ...and isn't too long.
	717	return ( 40 );
	718
	719	// Generate the stem variable name from the argument (stripping any final dot)
	720	if ( argv[0].strptr[ argv[0].strlength-1 ] == '.') argv[0].strlength--;
	721	strncpy( szStem, argv[0].strptr, RXSTRLEN(argv[0]) );
	722	szStem[ RXSTRLEN(argv[0]) ] = '\0';
	723
	724	#ifdef USE_DQPS
	725	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE );
	726	#else
[31]	727	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE ); // 2015-04-23 SHL
[4]	728	#endif
	729
	730	if ( pBuf == NULL ) {
	731	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
[31]	732	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	733	return ( 0 );
	734	}
	735
	736	#ifdef USE_DQPS
[30]	737	// Get running process information using 16-bit DosQProcStatus()
[4]	738	rc = DosQProcStatus( pBuf, UL_SSBUFSIZE );
	739	if ( rc != NO_ERROR ) {
	740	WriteErrorCode( rc, "DosQProcStatus");
[31]	741	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	742	return ( 0 );
	743	}
	744	#else
[30]	745	// Get running process information using 32-bit DosQuerySysState()
[4]	746	rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE );
	747	if ( rc != NO_ERROR ) {
	748	WriteErrorCode( rc, "DosQuerySysState");
[31]	749	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	750	return ( 0 );
	751	}
	752	#endif
	753
	754	// Now get the list of processes
	755	ulCount = 0;
[31]	756	# if 1 // 2016-02-25 SHL FIXME debug bad pointer
	757	// 2016-02-26 SHL FIXME to be gone when sure this can not occur
	758	if ( (ULONG)pBuf->pProcRec < 0x10000 ) {
	759	sprintf( szName, "rxutilex#%u pBuf->pProcRec 0x%x < 0x10000",
	760	__LINE__, (ULONG)pBuf->pProcRec );
	761	WriteErrorCode( ERROR_INVALID_ADDRESS, szName );
	762	SaveResultString( prsResult, NULL, 0 );
	763	free( pBuf );
[30]	764	return ( 0 );
	765	}
	766	# endif
	767
	768	for (pPrec = pBuf->pProcRec;
	769	;
[31]	770	pPrec = (QSPREC *)(pPrec->pThrdRec + pPrec->cTCB)
[30]	771	)
	772
	773	{
[31]	774	# if 0 // 2015-06-19 SHL FIXME debug bad pointer
	775	// 2016-02-26 SHL FIMXE to be gone when sure no longer needed
	776	if ( (ULONG)pPrec < 0x10000 ) {
	777	sprintf( szName, "rxutilex#%u pPrec 0x%x < 0x10000",
	778	__LINE__, (ULONG)pPrec );
	779	WriteErrorCode( ERROR_INVALID_ADDRESS, szName );
	780	SaveResultString( prsResult, NULL, 0 );
	781	free( pBuf );
	782	return ( 0 );
[30]	783	}
	784	# endif
	785
[31]	786	// Check for documented end marker - RecType not QS_PROCESS
	787	if ( pPrec->RecType != QS_PROCESS ) {
	788	# if 0 // 2016-02-26 SHL FIXME debug
	789	fprintf( stderr,
	790	"* rxutilex#%u RecType != QS_PROCESS "
	791	"ulCount %u pBuf %p pPrec %p ->RecType %x ->pThrdRec %p ->pid %u ->ppid %u ->type %u ->stat %u ->hmte %x ->cTCB %u\n",
	792	__LINE__, ulCount, pBuf, pPrec, pPrec->RecType, pPrec->pThrdRec,
	793	pPrec->pid, pPrec->ppid,
	794	pPrec->type, pPrec->stat, pPrec->hMte, pPrec->cTCB );
	795	# endif
	796	break; // Must be end of list
	797	}
[30]	798
[31]	799	// Check for alternate end marker - pThredRec NULL
	800	// This appears to be an undocumented end marker
	801	// Might be a defect - testing says only RecType is non-zero
	802	// 2015-06-12 SHL pThrdRec can be 0 - probably when process starting or dieing
	803	if ( (PVOID)pPrec->pThrdRec == NULL ) {
	804	# if 0 // 2016-02-26 SHL FIXME debug
	805	fprintf( stderr,
	806	"* rxutilex#%u pThrdRec NULL "
	807	"ulCount %u pBuf %p pPrec %p ->pThrdRec %p ->pid %u ->ppid %u ->type %u ->stat %u ->hmte %x ->cTCB %u\n",
	808	__LINE__, ulCount, pBuf, pPrec, pPrec->pThrdRec, pPrec->pid, pPrec->ppid,
	809	pPrec->type, pPrec->stat, pPrec->hMte, pPrec->cTCB );
	810	# endif
	811	break; // Must be end of list
[30]	812	}
[31]	813
	814	# if 1 // 2015-07-31 SHL FIXME debug bad pointer
	815	// 2016-02-26 SHL FIXME to be gone when sure can not occur
	816	if ( (ULONG)(pPrec->pThrdRec) < 0x10000 ) {
	817	sprintf( szName,
	818	"rxutilex#%u pPrec < 0x10000 "
	819	"ulCount %u pBuf %p pPrec %p ->pThrdRec %p ->pid %u ->ppid %u ->type %u ->stat %u ->hmte %x ->cTCB %u\n",
	820	__LINE__, ulCount, pBuf, pPrec, pPrec->pThrdRec, pPrec->pid, pPrec->ppid,
	821	pPrec->type, pPrec->stat, pPrec->hMte, pPrec->cTCB );
	822	WriteErrorCode( ERROR_INVALID_ADDRESS, szName );
	823	SaveResultString( prsResult, NULL, 0 );
	824	free( pBuf );
	825	return ( 0 );
	826	}
[30]	827	# endif
[31]	828	# if 1 // 2016-02-26 SHL FIXME debug bad count
	829	// 2016-02-26 SHL FIXME to be gone when sure can not occur
	830	// This is probably occurs only when pThrdRec NULL too which is already checked
	831	if ( !pPrec->cTCB ) {
	832	sprintf( szName, "rxutilex#%u cTCB 0 ulCount %u pBuf %p pPrec %p ->pid %u ->type %u ->stat %u\n",
	833	__LINE__, ulCount, pBuf, pPrec, pPrec->pid, pPrec->type, pPrec->stat );
	834	WriteErrorCode( ERROR_INVALID_DATA, szName );
	835	SaveResultString( prsResult, NULL, 0 );
	836	free( pBuf );
	837	return ( 0 );
	838	}
	839	# endif
[30]	840
[4]	841	ulCount++;
	842
	843	// Get the program name of each process (including path)
	844	if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
	845	sprintf( szName, "--");
	846	if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
	847	usPriority = 0;
	848
	849	// Get the CPU time of the process by querying each of its threads
	850	ulCPU = 0;
	851	pTrec = pPrec->pThrdRec;
	852	for ( i = 0; i < pPrec->cTCB; i++ ) {
	853	ulCPU += ( pTrec->systime + pTrec->usertime );
	854	pTrec++;
	855	}
	856
	857	// Now generate the stem item with all of this information
	858	sprintf( szPInfo, "%u %u %u %04X %02u:%02u.%02u %s",
	859	pPrec->pid, // PID
	860	pPrec->ppid, // Parent PID
	861	pPrec->type, // Process type
	862	usPriority, // Priority class
	863	TIME_SECONDS( ulCPU ) / 60, // CPU time (hours)
	864	TIME_SECONDS( ulCPU ) % 60, // CPU time (minutes)
	865	TIME_HUNDREDTHS( ulCPU ), // CPU time (seconds)
	866	szName ); // Executable name & path
	867	WriteStemElement( szStem, ulCount, szPInfo );
	868
[31]	869	# if 0 // 2015-07-31 SHL FIXME debug bad count
	870	// 2016-02-26 SHL FIXME to be gone when sure no longer needed
	871	if ( !pPrec->cTCB ) {
	872	sprintf( szName, "rxutilex#%u: cTCB 0 "
	873	"ulCount %u pBuf %p pPrec %p ->pThrdRec %p ->pid %u\n",
	874	__LINE__, ulCount, pBuf, pPrec, pPrec->pThrdRec, pPrec->pid );
	875	WriteErrorCode( ERROR_INVALID_DATA, szName );
	876	SaveResultString( prsResult, NULL, 0 );
	877	free( pBuf );
	878	return ( 0 );
[30]	879	}
	880	# endif
[31]	881	# if 0 // 2015-07-31 SHL FIXME debug bad pointer
	882	// 2016-02-26 SHL FIXME to be gone when sure no longer needed
	883	if ( (ULONG)pPrec->pThrdRec < 0x10000 ) {
	884	sprintf( szName,
	885	"rxutilex#%u: pBuf->pThrdRec < 0x10000 "
	886	"ulCount %u pBuf %p pPrec %p ->pThrdRec %p ->pid %u ->cTCB %u\n",
	887	__LINE__, ulCount, pBuf, pPrec, pPrec->pThrdRec, pPrec->pid, pPrec->cTCB );
	888	WriteErrorCode( rc, szName );
	889	SaveResultString( prsResult, NULL, 0 );
	890	free( pBuf );
	891	return ( 0 );
	892	}
	893	# endif
[30]	894	} // for
[4]	895
[31]	896	// Create the stem.0 element with the number of processes found
[4]	897	sprintf( szNumber, "%d", ulCount );
	898	WriteStemElement( szStem, 0, szNumber );
	899
	900	// And also return the number of processes as the REXX return string
[31]	901	SaveResultString( prsResult, szNumber, strlen(szNumber) ); // 2016-02-20 SHL
[4]	902
	903	free( pBuf );
	904	return ( 0 );
	905	}
	906
	907
	908	/* ------------------------------------------------------------------------- *
	909	* Sys2QueryPhysicalMemory *
	910	* *
	911	* Queries the amount of physical memory (RAM) installed in the system. *
	912	* *
	913	* REXX ARGUMENTS: None *
	914	* *
	915	* REXX RETURN VALUE: *
	916	* Integer representing the amount of installed memory, in KiB, or 0 if an *
	917	* error occurred. *
	918	* ------------------------------------------------------------------------- */
	919	ULONG APIENTRY Sys2QueryPhysicalMemory( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	920	{
	921	CHAR szMemSize[ US_INTEGER_MAXZ ];
	922	ULONG ulMemBytes = 0,
	923	ulMemKBytes = 0;
	924	APIRET rc = 0;
	925
	926	// Reset the error indicator
	927	WriteErrorCode( 0, NULL );
	928
	929	// Make sure we have no arguments
	930	if ( argc > 0 ) return ( 40 );
	931
	932	// Query installed memory in bytes
	933	rc = DosQuerySysInfo( QSV_TOTPHYSMEM, QSV_TOTPHYSMEM,
	934	&ulMemBytes, sizeof(ulMemBytes) );
	935	if ( rc != NO_ERROR ) {
	936	WriteErrorCode( rc, "DosQuerySysInfo");
[31]	937	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	938	return ( 0 );
	939	}
	940
	941	// Convert to binary kilobytes (any remainder is discarded)
	942	ulMemKBytes = ulMemBytes / 1024;
	943	sprintf( szMemSize, "%u", ulMemKBytes );
	944
	945	// Return the memory size as the REXX return string
[31]	946	SaveResultString( prsResult, szMemSize, strlen(szMemSize) ); // 2016-02-20 SHL
[4]	947
	948	return ( 0 );
	949	}
	950
	951
	952	/* ------------------------------------------------------------------------- *
	953	* Sys2QueryForegroundProcess *
	954	* *
	955	* Queries the PID of the current foreground process. *
	956	* *
	957	* REXX ARGUMENTS: None *
	958	* *
	959	* REXX RETURN VALUE: *
	960	* Integer representing the process ID (in decimal), or 0 if an error *
	961	* occurred. *
	962	* ------------------------------------------------------------------------- */
	963	ULONG APIENTRY Sys2QueryForegroundProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	964	{
	965	CHAR szPID[ US_INTEGER_MAXZ ];
	966	ULONG ulPID = 0;
	967	APIRET rc = 0;
	968
	969	// Reset the error indicator
	970	WriteErrorCode( 0, NULL );
	971
	972	// Make sure we have no arguments
	973	if ( argc > 0 ) return ( 40 );
	974
	975	// Query installed memory in bytes
	976	rc = DosQuerySysInfo( QSV_FOREGROUND_PROCESS,
	977	QSV_FOREGROUND_PROCESS,
	978	&ulPID, sizeof(ulPID) );
	979	if ( rc != NO_ERROR ) {
	980	WriteErrorCode( rc, "DosQuerySysInfo");
[31]	981	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	982	return ( 0 );
	983	}
	984	sprintf( szPID, "%u", ulPID );
	985
	986	// Return the PID as the REXX return string
[31]	987	SaveResultString( prsResult, szPID, strlen(szPID) ); // 2016-02-20 SHL
[4]	988
	989	return ( 0 );
	990	}
	991
	992
	993	/* ------------------------------------------------------------------------- *
	994	* Sys2ReplaceModule *
	995	* *
	996	* Unlocks and optionally replaces an in-use (locked) DLL or EXE. *
	997	* *
	998	* REXX ARGUMENTS: *
	999	* 1. The filespec of the module to be replaced. (REQUIRED) *
	1000	* 2. The filespec of the new module to replace it with. (DEFAULT: none) *
	1001	* 3. The filespec of the backup file to be created. (DEFAULT: none) *
	1002	* *
	1003	* REXX RETURN VALUE: *
	1004	* 1 on success, or 0 if an error occurred. *
	1005	* ------------------------------------------------------------------------- */
	1006	ULONG APIENTRY Sys2ReplaceModule( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1007	{
	1008	PSZ pszOldModule = NULL,
	1009	pszNewModule = NULL,
	1010	pszBackup = NULL;
	1011	APIRET rc = 0;
	1012
	1013	// Reset the error indicator
	1014	WriteErrorCode( 0, NULL );
	1015
	1016	// Make sure we have at least one valid argument (the module name)
	1017	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
	1018	pszOldModule = calloc( argv[0].strlength + 1, sizeof(UCHAR) );
	1019	if ( pszOldModule == NULL ) {
	1020	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
[31]	1021	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	1022	return ( 0 );
	1023	}
	1024	strncpy( pszOldModule, argv[0].strptr, argv[0].strlength );
	1025
	1026	// Second argument: new module name (optional, but must be correct if specified)
	1027	if ( argc >= 2 ) {
	1028	if ( RXVALIDSTRING(argv[1]) ) {
	1029	pszNewModule = calloc( argv[1].strlength + 1, sizeof(char) );
	1030	if ( pszNewModule == NULL ) {
	1031	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
[31]	1032	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	1033	return ( 0 );
	1034	}
	1035	strncpy( pszNewModule, argv[1].strptr, argv[1].strlength );
	1036	} else return ( 40 );
	1037	}
	1038
	1039	// Third argument: backup filename (optional, but must be correct if specified)
	1040	if ( argc >= 3 ) {
	1041	if ( RXVALIDSTRING(argv[2]) ) {
	1042	pszBackup = calloc( argv[2].strlength + 1, sizeof(char) );
	1043	if ( pszBackup == NULL ) {
	1044	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
[31]	1045	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	1046	return ( 0 );
	1047	}
	1048	strncpy( pszBackup, argv[2].strptr, argv[2].strlength );
	1049	} else return ( 40 );
	1050	}
	1051
	1052	// Now replace the module using DosReplaceModule
	1053	rc = DosReplaceModule( pszOldModule, pszNewModule, pszBackup );
	1054	if ( rc != NO_ERROR ) {
	1055	WriteErrorCode( rc, "DosReplaceModule");
[31]	1056	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[4]	1057	return ( 0 );
	1058	}
	1059
	1060	// Return 1 on success
[31]	1061	SaveResultString( prsResult, PSZ_ONE, 1 ); // 2016-02-20 SHL
[4]	1062
	1063	return ( 0 );
	1064	}
	1065
	1066
	1067	/* ------------------------------------------------------------------------- *
[21]	1068	* Sys2FormatNumber *
	1069	* *
	1070	* Format a number using locale-specific thousands separators. The input *
	1071	* number may be a positive or negative integer or floating point value. It *
	1072	* must not contain any separators already, and any decimal point which it *
	1073	* contains must be a period (rather than any localized decimal symbol). *
[42]	1074	* The maximum value is that of a signed 64-bit integer, or a long double. *
[21]	1075	* *
	1076	* REXX ARGUMENTS: *
[23]	1077	* 1. Number to be formatted. (REQUIRED) *
[43]	1078	* 2. Number of decimal places to use for floating point values *
	1079	* (max 18). Ignored for integer values. (DEFAULT: 2) *
[21]	1080	* *
[31]	1081	* REXX RETURN VALUE: The formatted number, or "" on error. *
[21]	1082	* ------------------------------------------------------------------------- */
	1083	ULONG APIENTRY Sys2FormatNumber( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1084	{
	1085	CHAR achNumber[ US_NUMSTR_MAXZ ]; // Formatted output string
[41]	1086	int iPrec; // Requested decimal precision
	1087	PSZ pszSep = NULL; // Thousands separator string
	1088	PSZ pszDec = NULL; // Decimal point string
[42]	1089	PSZ pszNeg = NULL; // Negative sign string
[41]	1090	#ifdef LEGACY_C_LOCALE
	1091	float fVal = 0; // Input value as floating point
[23]	1092	int iVal; // Input value as integer
[41]	1093	#else
[43]	1094	LONGLONG llVal = 0; // Input value as integer
	1095	long double ldVal = 0, // Input value as floating point
	1096	ldFrac = 0; // Input fraction portion
	1097	PSZ p, // Pointer to fraction
	1098	a; // Pointer to absolute value
	1099	CHAR achFrac[ US_FRACSTR_MAXZ ]; // Fraction portion as string
	1100	int rc = 0;
[23]	1101	#endif
[21]	1102
	1103	// Make sure we have at least one valid argument (the input number)
	1104	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
	1105
[23]	1106	#ifdef LEGACY_C_LOCALE
	1107
[22]	1108	// Use the locale settings from the environment
	1109	pszSep = nl_langinfo( THOUSEP );
	1110	if ( !pszSep \|\| !strlen(pszSep) ) {
	1111	/* If the current locale isn't known to the C runtime, use a common
	1112	* known locale for the same language, if possible.
	1113	*/
	1114	PSZ pszLang, p;
[31]	1115	if ( DosScanEnv( "LANG", &pszLang ) == NO_ERROR &&
	1116	pszLang &&
	1117	strlen(pszLang) >= 2 )
[22]	1118	{
	1119	p = strdup( pszLang );
	1120	if ( !strnicmp( p, "en_us", 2 )) setlocale( LC_NUMERIC, "EN_US");
	1121	else if ( !strnicmp( p, "en_uk", 2 )) setlocale( LC_NUMERIC, "EN_GB");
	1122	else if ( !strnicmp( p, "de", 2 )) setlocale( LC_NUMERIC, "DE_DE");
	1123	else if ( !strnicmp( p, "es", 2 )) setlocale( LC_NUMERIC, "ES_ES");
	1124	else if ( !strnicmp( p, "fr", 2 )) setlocale( LC_NUMERIC, "FR_FR");
	1125	else if ( !strnicmp( p, "it", 2 )) setlocale( LC_NUMERIC, "IT_IT");
	1126	else if ( !strnicmp( p, "ja", 2 )) setlocale( LC_NUMERIC, "JA_JP");
[41]	1127	/* -- it seems the VAC runtime doesn't recognize most of these...
[22]	1128	else if ( !strnicmp( p, "ar", 2 )) setlocale( LC_NUMERIC, "ar_AA");
	1129	else if ( !strnicmp( p, "be", 2 )) setlocale( LC_NUMERIC, "be_BY");
	1130	else if ( !strnicmp( p, "bg", 2 )) setlocale( LC_NUMERIC, "bg_BG");
	1131	else if ( !strnicmp( p, "be", 2 )) setlocale( LC_NUMERIC, "be_BY");
	1132	else if ( !strnicmp( p, "ca", 2 )) setlocale( LC_NUMERIC, "ca_ES");
	1133	else if ( !strnicmp( p, "cs", 2 )) setlocale( LC_NUMERIC, "cs_CZ");
	1134	else if ( !strnicmp( p, "da", 2 )) setlocale( LC_NUMERIC, "da_DK");
	1135	else if ( !strnicmp( p, "de", 2 )) setlocale( LC_NUMERIC, "de_DE");
	1136	else if ( !strnicmp( p, "el", 2 )) setlocale( LC_NUMERIC, "el_GR");
	1137	else if ( !strnicmp( p, "es", 2 )) setlocale( LC_NUMERIC, "es_ES");
	1138	else if ( !strnicmp( p, "fi", 2 )) setlocale( LC_NUMERIC, "fi_FI");
	1139	else if ( !strnicmp( p, "fr", 2 )) setlocale( LC_NUMERIC, "fr_FR");
	1140	else if ( !strnicmp( p, "hr", 2 )) setlocale( LC_NUMERIC, "hr_HR");
	1141	else if ( !strnicmp( p, "hu", 2 )) setlocale( LC_NUMERIC, "hu_HU");
	1142	else if ( !strnicmp( p, "is", 2 )) setlocale( LC_NUMERIC, "is_IS");
	1143	else if ( !strnicmp( p, "it", 2 )) setlocale( LC_NUMERIC, "it_IT");
	1144	else if ( !strnicmp( p, "iw", 2 )) setlocale( LC_NUMERIC, "iw_IL");
	1145	else if ( !strnicmp( p, "ja", 2 )) setlocale( LC_NUMERIC, "ja_JP");
	1146	else if ( !strnicmp( p, "ko", 2 )) setlocale( LC_NUMERIC, "ko_KR");
	1147	else if ( !strnicmp( p, "mk", 2 )) setlocale( LC_NUMERIC, "mk_MK");
	1148	else if ( !strnicmp( p, "nl", 2 )) setlocale( LC_NUMERIC, "nl_NL");
	1149	else if ( !strnicmp( p, "no", 2 )) setlocale( LC_NUMERIC, "no_NO");
	1150	else if ( !strnicmp( p, "pl", 2 )) setlocale( LC_NUMERIC, "pl_PL");
	1151	else if ( !strnicmp( p, "pt", 2 )) setlocale( LC_NUMERIC, "pt_PT");
	1152	else if ( !strnicmp( p, "ro", 2 )) setlocale( LC_NUMERIC, "ro_RO");
	1153	else if ( !strnicmp( p, "ru", 2 )) setlocale( LC_NUMERIC, "ru_RU");
	1154	else if ( !strnicmp( p, "sh", 2 )) setlocale( LC_NUMERIC, "sh_SP");
	1155	else if ( !strnicmp( p, "sk", 2 )) setlocale( LC_NUMERIC, "sk_SK");
	1156	else if ( !strnicmp( p, "sl", 2 )) setlocale( LC_NUMERIC, "sl_SI");
	1157	else if ( !strnicmp( p, "sq", 2 )) setlocale( LC_NUMERIC, "sq_AL");
	1158	else if ( !strnicmp( p, "sv", 2 )) setlocale( LC_NUMERIC, "sv_SE");
	1159	else if ( !strnicmp( p, "th", 2 )) setlocale( LC_NUMERIC, "th_TH");
	1160	else if ( !strnicmp( p, "tr", 2 )) setlocale( LC_NUMERIC, "tr_TR");
	1161	else if ( !strnicmp( p, "uk", 2 )) setlocale( LC_NUMERIC, "uk_UA");
	1162	else if ( !strnicmp( p, "zh", 2 )) setlocale( LC_NUMERIC, "zh_TW");
[41]	1163	-- */
[22]	1164	else setlocale( LC_NUMERIC, "EN_US");
	1165	free(p);
	1166	}
	1167	else setlocale( LC_NUMERIC, "en_us");
[21]	1168	}
[22]	1169	else setlocale( LC_NUMERIC, "");
[21]	1170
	1171	// Check for a decimal place and treat as float or integer accordingly
	1172	if ( strchr( argv[0].strptr, '.') != NULL ) {
	1173	if (( sscanf( argv[0].strptr, "%f", &fVal )) != 1 ) return ( 40 );
	1174	if ( argc >= 2 && ( RXVALIDSTRING(argv[1]) ) &&
	1175	(( sscanf( argv[1].strptr, "%d", &iPrec )) == 1 ))
	1176	{
	1177	// Use user-specified precision
	1178	sprintf( achNumber, "%'.*f", iPrec, fVal );
	1179	}
	1180	else
	1181	sprintf( achNumber, "%'.2f", fVal );
	1182	}
	1183	else {
	1184	if (( sscanf( argv[0].strptr, "%d", &iVal )) != 1 ) return ( 40 );
	1185	sprintf( achNumber, "%'d", iVal );
	1186	}
	1187
[42]	1188	// Return the formatted number
	1189	SaveResultString( prsResult, achNumber, strlen(achNumber) );
	1190
[23]	1191	#else
[41]	1192
	1193	rc = GetLocaleString( &pszSep, LOCI_sThousand );
	1194	if ( rc ) {
	1195	// GetLocaleString has already set the error indicator
	1196	SaveResultString( prsResult, NULL, 0 );
[42]	1197	goto finish;
[23]	1198	}
[41]	1199	rc = GetLocaleString( &pszDec, LOCI_sDecimal );
	1200	if ( rc ) {
	1201	// GetLocaleString has already set the error indicator
	1202	SaveResultString( prsResult, NULL, 0 );
[42]	1203	goto finish;
[41]	1204	}
[42]	1205	rc = GetLocaleString( &pszNeg, LOCI_sNegativeSign );
	1206	if ( rc ) {
	1207	// GetLocaleString has already set the error indicator
	1208	SaveResultString( prsResult, NULL, 0 );
	1209	goto finish;
	1210	}
[23]	1211
[42]	1212	// Check for negative value
	1213	//if ( argv[0].strptr == '-') bNeg = TRUE;
	1214
[23]	1215	// Check for a decimal place and treat as float or integer accordingly
	1216	if ( strchr( argv[0].strptr, '.') != NULL ) {
[41]	1217	if (( sscanf( argv[0].strptr, "%Lf", &ldVal )) != 1 ) return ( 40 );
	1218
	1219	llVal = ldVal;
	1220	ldFrac = ldVal - llVal;
[23]	1221	if ( argc >= 2 && ( RXVALIDSTRING(argv[1]) ) &&
	1222	(( sscanf( argv[1].strptr, "%d", &iPrec )) == 1 ))
	1223	{
	1224	// Use user-specified precision
[43]	1225	if ( iPrec > 18 ) iPrec = 18;
[41]	1226	sprintf( achFrac, "%.*Lf", iPrec, ldFrac );
[23]	1227	}
	1228	else
[41]	1229	sprintf( achFrac, "%.2Lf", ldFrac );
[42]	1230
[41]	1231	// Format the integer part
[42]	1232	a = achNumber;
	1233	if ( llVal < 0 ) {
	1234	sprintf( a, pszNeg );
	1235	a += strlen( pszNeg );
	1236	}
	1237	GroupNumber( a, llabs( llVal ), pszSep );
[41]	1238	// Append the fractional part
	1239	if (( p = strchr( achFrac, '.')) != NULL ) {
	1240	strncat( achNumber, pszDec, US_NUMSTR_MAXZ - 1 );
	1241	strncat( achNumber, p+1, US_NUMSTR_MAXZ - 1 );
	1242	}
[23]	1243	}
	1244	else {
[41]	1245	if (( sscanf( argv[0].strptr, "%lld", &llVal )) != 1 ) return ( 40 );
[42]	1246	a = achNumber;
	1247	if ( llVal < 0 ) {
	1248	sprintf( a, pszNeg );
	1249	a += strlen( pszNeg );
	1250	}
	1251	GroupNumber( a, llabs( llVal ), pszSep );
[23]	1252	}
	1253
[42]	1254	// Return the formatted number
	1255	SaveResultString( prsResult, achNumber, strlen(achNumber) );
	1256
	1257	finish:
	1258	if ( pszSep ) free( pszSep );
	1259	if ( pszDec ) free( pszDec );
	1260	if ( pszNeg ) free( pszNeg );
	1261
[23]	1262	#endif
	1263
[21]	1264	return ( 0 );
	1265	}
	1266
	1267
	1268	/* ------------------------------------------------------------------------- *
[4]	1269	* Sys2FormatTime *
	1270	* *
	1271	* Convert a number of seconds from the epoch (1970-01-01 0:00:00 UTC) into *
	1272	* a formatted date and time string. *
	1273	* *
	1274	* REXX ARGUMENTS: *
	1275	* 1. Number of seconds (a positive integer) to be converted. (REQUIRED) *
	1276	* 2. Format type, one of: *
	1277	* D = return in the form 'yyyy-mm-dd hh:mm:ss (w)' where w *
	1278	* represents the weekday (0-6 where 0=Sunday) (DEFAULT) *
	1279	* I = return in ISO8601 combined form 'yyyy-mm-ddThh:mm:ss[Z]' *
	1280	* L = return in the form 'day month year (weekday) time' where month *
	1281	* and weekday are language-dependent abbreviations *
	1282	* Note: With D and I, time is returned in 24-hour format; L may vary. *
	1283	* 3. TZ conversion flag (indicates whether to convert to UTC from local *
	1284	* time), one of: *
	1285	* U = return in Coordinated Universal Time *
	1286	* L = convert to local time using the current TZ (DEFAULT) *
	1287	* *
[31]	1288	* REXX RETURN VALUE: The formatted time string, or "" on error. *
[4]	1289	* ------------------------------------------------------------------------- */
	1290	ULONG APIENTRY Sys2FormatTime( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1291	{
	1292	UCHAR szFormat[ US_TIMESTR_MAXZ ] = {0}, // strftime() format specifier
	1293	szTime[ US_TIMESTR_MAXZ ] = {0}; // Formatted time string
	1294	BYTE flFormat = FL_TIME_DEFAULT; // Time format flag
	1295	BOOL fUTC = FALSE; // UTC/local conversion flag
	1296	PSZ pszTZ, // Pointer to TZ environment var
	1297	pszSetTZ;
[18]	1298	int iEpoch; // Input epoch time
[4]	1299	time_t ttSeconds; // Input timestamp (seconds)
	1300	struct tm *timeptr; // Timestamp structure
	1301	size_t stRC; // return code from strftime()
	1302
	1303	// Reset the error indicator
	1304	WriteErrorCode( 0, NULL );
	1305
	1306	// All arguments are optional but must be correct if specified
	1307
	1308	if ( argc >= 1 && RXVALIDSTRING(argv[0]) ) {
	1309	// first argument: epoch time value
[18]	1310	if (( sscanf( argv[0].strptr, "%d", &iEpoch )) != 1 ) return ( 40 );
	1311	ttSeconds = (time_t) iEpoch;
[4]	1312	}
	1313
	1314	if ( argc >= 2 ) {
	1315	// second argument: format flag
	1316	if ( RXVALIDSTRING(argv[1]) ) {
	1317	strupr( argv[1].strptr );
	1318	if ( strcspn(argv[1].strptr, "DIL") > 0 ) return ( 40 );
	1319	switch ( argv[1].strptr[0] ) {
	1320	case 'I': flFormat = FL_TIME_ISO8601; break;
	1321	case 'L': flFormat = FL_TIME_LOCALE; break;
	1322	default : flFormat = FL_TIME_DEFAULT; break;
	1323	}
	1324	}
	1325	}
	1326
	1327	if ( argc >= 3 ) {
	1328	// third argument: conversion flag
	1329	if ( RXVALIDSTRING(argv[2]) ) {
	1330	strupr( argv[2].strptr );
	1331	if ( strcspn(argv[2].strptr, "UL") > 0 ) return ( 40 );
	1332	switch ( argv[2].strptr[0] ) {
	1333	case 'U': fUTC = TRUE; break;
	1334	default : fUTC = FALSE; break;
	1335	}
	1336	}
	1337	}
	1338
	1339	/* These next 4 lines really shouldn't be necessary, but without them
	1340	* getenv() and (apparently) tzset() may see the value of TZ as NULL
	1341	* if the environment variable was changed in the REXX script.
	1342	*/
	1343	DosScanEnv("TZ", &pszTZ );
[31]	1344	pszSetTZ = (PSZ) malloc( strlen(pszTZ) + 5 );
[21]	1345	if ( pszSetTZ ) {
	1346	sprintf( pszSetTZ, "TZ=%s", pszTZ );
	1347	putenv( pszSetTZ );
	1348	}
[4]	1349
	1350	// Use the locale and timezone settings from the environment
	1351	tzset();
	1352	setlocale( LC_TIME, "");
	1353
	1354	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) {
	1355	ttSeconds = time( NULL );
	1356	if ( ttSeconds == -1 ) {
	1357	WriteErrorCode( ttSeconds, "time");
[31]	1358	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[21]	1359	if ( pszSetTZ ) free( pszSetTZ );
[4]	1360	return 0;
	1361	}
	1362	}
	1363
	1364	if ( fUTC ) {
	1365	timeptr = gmtime( &ttSeconds );
	1366	if ( !timeptr ) {
	1367	WriteErrorCode( 1, "gmtime");
[31]	1368	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL // 2016-02-20 SHL
[21]	1369	if ( pszSetTZ ) free( pszSetTZ );
[4]	1370	return 0;
	1371	}
	1372	}
	1373	else {
	1374	timeptr = localtime( &ttSeconds );
	1375	if ( !timeptr ) {
	1376	WriteErrorCode( 1, "localtime");
[31]	1377	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[21]	1378	if ( pszSetTZ ) free( pszSetTZ );
[4]	1379	return 0;
	1380	}
	1381	}
	1382
	1383	switch ( flFormat ) {
	1384	default:
	1385	case FL_TIME_DEFAULT:
	1386	sprintf( szFormat, "%%Y-%%m-%%d %%T (%%w)");
	1387	break;
	1388
	1389	case FL_TIME_ISO8601:
	1390	sprintf( szFormat, "%%Y-%%m-%%dT%%T");
	1391	if ( fUTC ) strcat( szFormat, "Z");
	1392	break;
	1393
	1394	case FL_TIME_LOCALE:
	1395	sprintf( szFormat, "%%e %%b %%Y (%%a) %%X");
	1396	break;
	1397	}
	1398
	1399	stRC = strftime( szTime, US_TIMESTR_MAXZ-1, szFormat, timeptr );
	1400	if ( stRC == NO_ERROR ) {
	1401	WriteErrorCode( stRC, "strftime");
[31]	1402	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[21]	1403	if ( pszSetTZ ) free( pszSetTZ );
[4]	1404	return ( 0 );
	1405	}
	1406
	1407	// Return the formatted time string
[31]	1408	SaveResultString( prsResult, szTime, strlen(szTime) ); // 2016-02-20 SHL
[4]	1409
[21]	1410	if ( pszSetTZ ) free( pszSetTZ );
[4]	1411	return ( 0 );
	1412	}
	1413
	1414
	1415	/* ------------------------------------------------------------------------- *
	1416	* Sys2GetEpochTime *
	1417	* *
	1418	* Convert formatted date and time into a number of seconds (UTC) from the *
	1419	* epoch (defined as 1970-01-01 0:00:00). The input time is assumed to *
	1420	* refer to the current timezone as defined in the TZ environment variable. *
	1421	* *
	1422	* If no parameters are specified, the current system time is used. If at *
	1423	* least one parameter is specified, then any missing parameter is assumed *
	1424	* to be its minimum possible value. *
	1425	* *
	1426	* Due to limitations in time_t, dates later than 2037 are not supported; *
	1427	* the IBM library seems to convert them all to January 1 1970 00:00:00 UTC. *
	1428	* *
	1429	* REXX ARGUMENTS: *
	1430	* 1. The year (0-99 or 1970+) (value <70 is assumed to be 20xx) *
	1431	* 2. The month (1-12) *
	1432	* 3. The day (1-31) *
	1433	* 4. Hours (0-23) *
	1434	* 5. Minutes (0-59) *
	1435	* 6. Seconds (0-61) *
	1436	* *
	1437	* REXX RETURN VALUE: The number of seconds since the epoch, or 0 on error. *
	1438	* ------------------------------------------------------------------------- */
	1439	ULONG APIENTRY Sys2GetEpochTime( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1440	{
	1441	ULONG ulYear = 1970, // Input year
	1442	ulMonth = 1, // Input month
	1443	ulDay = 1, // Input day
	1444	ulHour = 0, // Input hours
	1445	ulMin = 0, // Input minutes
	1446	ulSec = 0; // Input seconds
	1447	BOOL fYear = FALSE, // Year parameter specified?
	1448	fMonth = FALSE, // Month parameter specified?
	1449	fDay = FALSE, // Day parameter specified?
	1450	fHour = FALSE, // Hours parameter specified?
	1451	fMin = FALSE, // Minutes parameter specified?
	1452	fSec = FALSE; // Seconds parameter specified?
	1453	//SHORT sDST = 0; // Input time is DST?
	1454	time_t timeval; // Calculated epoch time
	1455	struct tm tsTime = {0}; // Time structure for mktime()
	1456	UCHAR szEpochTime[ US_INTEGER_MAXZ ]; // Output string
	1457	PSZ pszTZ,
	1458	pszSetTZ;
	1459
	1460
	1461	// Reset the error indicator
	1462	WriteErrorCode( 0, NULL );
	1463
	1464	// Parse the various time items
	1465	if ( argc >= 1 && RXVALIDSTRING(argv[0]) ) {
	1466	if (( sscanf( argv[0].strptr, "%u", &ulYear )) != 1 ) return ( 40 );
	1467	if ( ulYear < 100 ) {
	1468	ulYear += (ulYear < 70) ? 2000 : 1900;
	1469	}
	1470	if ( ulYear < 1970 ) return ( 40 );
	1471	fYear = TRUE;
	1472	}
	1473	if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
	1474	if (( sscanf( argv[1].strptr, "%u", &ulMonth )) != 1 ) return ( 40 );
	1475	if ( ulMonth < 1 \|\| ulMonth > 12 ) return ( 40 );
	1476	fMonth = TRUE;
	1477	}
	1478	if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
	1479	if (( sscanf( argv[2].strptr, "%u", &ulDay )) != 1 ) return ( 40 );
	1480	if ( ulDay < 1 \|\| ulDay > 31 ) return ( 40 );
	1481	fDay = TRUE;
	1482	}
	1483	if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
	1484	if (( sscanf( argv[3].strptr, "%u", &ulHour )) != 1 ) return ( 40 );
	1485	if ( ulHour > 23 ) return ( 40 );
	1486	fHour = TRUE;
	1487	}
	1488	if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
	1489	if (( sscanf( argv[4].strptr, "%u", &ulMin )) != 1 ) return ( 40 );
	1490	if ( ulMin > 59 ) return ( 40 );
	1491	fMin = TRUE;
	1492	}
	1493	if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
	1494	if (( sscanf( argv[5].strptr, "%u", &ulSec )) != 1 ) return ( 40 );
	1495	if ( ulSec > 61 ) return ( 40 );
	1496	fSec = TRUE;
	1497	}
	1498	if ( argc >= 7 ) return ( 40 );
	1499	/*
	1500	// Parse the conversion flag
	1501	if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
	1502	strupr( argv[6].strptr );
	1503	if ( strcspn(argv[6].strptr, "SD") > 0 ) return ( 40 );
	1504	switch ( argv[6].strptr[0] ) {
	1505	case 'S': sDST = 0; break;
	1506	case 'D': sDST = 1; break;
	1507	default : sDST = -1; break;
	1508	}
	1509	}
	1510	*/
	1511
	1512	/* These next 4 lines really shouldn't be necessary, but without them
	1513	* getenv() and (apparently) tzset() may see the value of TZ as NULL
	1514	* if the environment variable was changed in the REXX script.
	1515	*/
	1516	DosScanEnv("TZ", &pszTZ );
[31]	1517	pszSetTZ = (PSZ) malloc( strlen(pszTZ) + 5 );
[4]	1518	sprintf( pszSetTZ, "TZ=%s", pszTZ );
	1519	putenv( pszSetTZ );
	1520
	1521	// This seems to conflict with time() under some shells -AT
	1522	tzset();
	1523
	1524	// Use the locale settings from the environment
	1525	setlocale( LC_TIME, "");
	1526
	1527	if ( !fYear && !fMonth && !fDay && !fHour && !fMin && !fSec ) {
	1528	timeval = time( NULL );
	1529	if ( timeval == -1 ) {
	1530	WriteErrorCode( timeval, "time");
[31]	1531	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[16]	1532	free( pszSetTZ );
[4]	1533	return 0;
	1534	}
	1535	}
	1536	else {
	1537	//printf("TZ=%s\n", getenv("TZ"));
	1538	tsTime.tm_sec = ulSec;
	1539	tsTime.tm_min = ulMin;
	1540	tsTime.tm_hour = ulHour;
	1541	tsTime.tm_mday = ulDay;
	1542	tsTime.tm_mon = ulMonth - 1;
	1543	tsTime.tm_year = ulYear - 1900;
	1544	tsTime.tm_isdst = -1;
	1545	timeval = mktime( &tsTime );
	1546	if ( timeval == -1 ) {
	1547	WriteErrorCode( timeval, "mktime");
[31]	1548	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[16]	1549	free( pszSetTZ );
[4]	1550	return 0;
	1551	}
	1552	}
	1553
	1554	// Return the calculated time value
[18]	1555	#if __IBMC__ >= 360 \|\| __IBMCPP__ >= 360
	1556	sprintf( szEpochTime, "%.0f", timeval );
	1557	#else
	1558	sprintf( szEpochTime, "%d", timeval );
	1559	#endif
[31]	1560	SaveResultString( prsResult, szEpochTime, strlen(szEpochTime) ); // 2016-02-20 SHL
[4]	1561
	1562	free( pszSetTZ );
	1563	return ( 0 );
	1564	}
	1565
	1566
	1567	/* ------------------------------------------------------------------------- *
	1568	* Sys2LocateDLL *
	1569	* *
	1570	* Search for an installed or loaded DLL by module name. *
	1571	* Code derived from 'whichdll' by Alessandro Cantatore (public domain). *
	1572	* *
	1573	* REXX ARGUMENTS: *
[29]	1574	* 1. The name of the DLL to search for. (REQUIRED) *
	1575	* 2. Flag to limit search context, must be one of: *
	1576	* ALL : Search for both loaded and loadable DLLs (DEFAULT) *
	1577	* LOADEDONLY: Search only for currently-loaded DLLs *
	1578	* Only the first letter (A/L) is significant. *
[4]	1579	* *
	1580	* REXX RETURN VALUE: *
[31]	1581	* The fully-qualified path of the DLL, if found (or "" if not found). *
[4]	1582	* ------------------------------------------------------------------------- */
	1583	ULONG APIENTRY Sys2LocateDLL( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1584	{
	1585	HMODULE hmod;
	1586	CHAR achModuleName[ CCHMAXPATH ];
[29]	1587	BOOL bLoadedOnly = FALSE,
	1588	bUnload = FALSE;
[4]	1589	APIRET rc;
	1590
	1591	// Reset the error indicator
	1592	WriteErrorCode( 0, NULL );
	1593
[29]	1594	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
[4]	1595
[29]	1596	// Second argument: flag
	1597	if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
	1598	strupr( argv[1].strptr );
	1599	if ( strcspn(argv[1].strptr, "AL") > 0 ) return ( 40 );
	1600	switch ( argv[1].strptr[0] ) {
	1601	case 'A': bLoadedOnly = FALSE; break;
	1602	case 'L': bLoadedOnly = TRUE; break;
	1603	default : return ( 40 );
	1604	}
	1605	}
	1606
[4]	1607	// See if the DLL is already loaded
	1608	rc = DosQueryModuleHandle( argv[0].strptr, &hmod );
	1609	if ( rc ) {
[29]	1610	// Guess not...
	1611	if ( bLoadedOnly ) {
	1612	// Just return
[31]	1613	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[29]	1614	return 0;
	1615	}
	1616	// Try to load it now
[4]	1617	rc = DosLoadModule( NULL, 0, argv[0].strptr, &hmod );
	1618	if ( rc ) {
	1619	WriteErrorCode( rc, "DosLoadModule");
[31]	1620	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	1621	return 0;
	1622	}
	1623	bUnload = TRUE;
	1624	}
	1625
	1626	// Get the full path name of the DLL
	1627	rc = DosQueryModuleName( hmod, CCHMAXPATH, achModuleName );
	1628	if ( rc ) {
	1629	WriteErrorCode( rc, "DosQueryModuleName");
[31]	1630	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[4]	1631	if ( bUnload ) DosFreeModule( hmod );
	1632	return 0;
	1633	}
	1634
	1635	// Free the module if we loaded it ourselves
	1636	if ( bUnload ) DosFreeModule( hmod );
	1637
	1638	// Return the full path name
[31]	1639	SaveResultString( prsResult, achModuleName, strlen(achModuleName) ); // 2016-02-20 SHL
[4]	1640
	1641	return 0;
	1642	}
	1643
	1644
[16]	1645	/* ------------------------------------------------------------------------- *
	1646	* Sys2CreateNamedPipe *
	1647	* *
	1648	* Create a named pipe with the specified name and parameters. Only byte *
	1649	* mode is supported; message mode is not. *
	1650	* *
	1651	* REXX ARGUMENTS: *
	1652	* 1. The name of the pipe, in the form "\PIPE\something". (REQUIRED) *
	1653	* 2. The size of the outbound buffer, in bytes. (REQUIRED) *
	1654	* 3. The size of the inbound buffer, in bytes. (REQUIRED) *
	1655	* 4. The pipe's timeout value, in milliseconds. (DEFAULT: 3000) *
	1656	* 5. The number of simultaneous instances of this pipe which are allowed. *
	1657	* Must be between 1 and 254, or 0 indicating no limit. (DEFAULT: 1) *
	1658	* 6. Pipe blocking mode, one of: *
	1659	* W = WAIT mode, read and write block waiting for data. (DEFAULT) *
	1660	* N = NOWAIT mode, read and write return immediately. *
	1661	* 7. Pipe mode, one of: *
	1662	* I = Inbound pipe (DEFAULT) *
	1663	* O = Outbound pipe *
	1664	* D = Duplex (inbound/outbound) pipe *
	1665	* 8. Privacy/inheritance flag, one of: *
	1666	* 0 = The pipe handle is inherited by child processes. (DEFAULT) *
	1667	* 1 = The pipe handle is private to the current process. *
	1668	* 9. Write-through flag, one of: *
	1669	* 0 = Allow delayed writes (write-behind) to remote pipes. (DEFAULT) *
	1670	* 1 = Force immediate writes (write-through) to remote pipes. *
	1671	* *
	1672	* REXX RETURN VALUE: *
[31]	1673	* A four-byte pipe handle or 0 if create fails *
[16]	1674	* ------------------------------------------------------------------------- */
	1675	ULONG APIENTRY Sys2CreateNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1676	{
	1677	HPIPE hp;
	1678	PSZ pszNPName;
	1679	LONG iLimit;
	1680	ULONG ulBufOut,
	1681	ulBufIn,
	1682	ulTimeout = 3000,
	1683	flOpen = 0,
	1684	flPipe = 1;
	1685	CHAR achHandle[ 9 ];
	1686	APIRET rc;
[4]	1687
[16]	1688	// Reset the error indicator
	1689	WriteErrorCode( 0, NULL );
	1690
	1691	// Make sure we have at least three valid arguments (pipe name and sizes)
	1692	if ( argc < 3 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\|
	1693	( !RXVALIDSTRING(argv[1]) ) \|\| ( !RXVALIDSTRING(argv[2]) ))
	1694	return ( 40 );
	1695
	1696	// (Validate the first argument last to simplify error processing)
	1697
	1698	// Second argument: pipe outbound buffer size
	1699	if (( sscanf( argv[1].strptr, "%u", &ulBufOut )) != 1 ) return ( 40 );
	1700
	1701	// Third argument: pipe outbound buffer size
	1702	if (( sscanf( argv[2].strptr, "%u", &ulBufIn )) != 1 ) return ( 40 );
	1703
	1704	// Fourth argument: pipe timeout value
	1705	if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
	1706	if (( sscanf( argv[3].strptr, "%u", &ulTimeout )) != 1 ) return ( 40 );
	1707	}
	1708
	1709	// Fifth argument: instances limit
	1710	if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
	1711	if (( sscanf( argv[4].strptr, "%d", &iLimit )) != 1 ) return ( 40 );
	1712	if (( iLimit > 1 ) && ( iLimit < 255 ))
	1713	flPipe = iLimit;
	1714	else if ( !iLimit \|\| ( iLimit == -1 ))
	1715	flPipe = NP_UNLIMITED_INSTANCES;
	1716	else
	1717	return ( 40 );
	1718	}
	1719
	1720	// Sixth argument: blocking mode
	1721	if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
	1722	strupr( argv[5].strptr );
	1723	if ( argv[5].strptr[0] == 'N' )
	1724	flPipe \|= NP_NOWAIT;
	1725	else if ( argv[5].strptr[0] != 'W' )
	1726	return ( 40 );
	1727	}
	1728
	1729	// Seventh argument: pipe mode (direction)
	1730	if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
	1731	strupr( argv[6].strptr );
	1732	if (strcspn(argv[6].strptr, "IOD") > 0 ) return ( 40 );
	1733	switch ( argv[6].strptr[0] ) {
	1734	case 'O': flOpen \|= NP_ACCESS_OUTBOUND; break;
	1735	case 'D': flOpen \|= NP_ACCESS_DUPLEX; break;
	1736	default : break; // default is 0
	1737	}
	1738	}
	1739
	1740	// Eighth argument: inheritance mode
	1741	if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
	1742	strupr( argv[7].strptr );
	1743	if ( argv[7].strptr[0] == '1' )
	1744	flOpen \|= NP_NOINHERIT;
	1745	else if ( argv[7].strptr[0] != '0' )
	1746	return ( 40 );
	1747	}
	1748
	1749	// Ninth argument: write mode
	1750	if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
	1751	strupr( argv[8].strptr );
	1752	if ( argv[8].strptr[0] == '1' )
	1753	flOpen \|= NP_NOWRITEBEHIND;
	1754	else if ( argv[8].strptr[0] != '0' )
	1755	return ( 40 );
	1756	}
	1757
	1758	// Now the first argument: pipe name
	1759	pszNPName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
	1760	if ( pszNPName == NULL ) {
	1761	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
[31]	1762	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[16]	1763	return ( 0 );
	1764	}
	1765	strncpy( pszNPName, argv[0].strptr, RXSTRLEN(argv[0]) );
	1766
	1767	// All good, now create the pipe
	1768	rc = DosCreateNPipe( pszNPName, &hp, flOpen, flPipe, ulBufOut, ulBufIn, ulTimeout );
	1769	if (rc) {
	1770	WriteErrorCode( rc, "DosCreateNPipe");
[31]	1771	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[16]	1772	return 0;
	1773	}
	1774
	1775	// Return the handle as the REXX result string
	1776	sprintf( achHandle, "%8X", hp );
[31]	1777	SaveResultString( prsResult, achHandle, strlen(achHandle) ); // 2016-02-20 SHL
[16]	1778
	1779	free( pszNPName );
	1780	return ( 0 );
	1781	}
	1782
	1783
	1784	/* ------------------------------------------------------------------------- *
	1785	* Sys2ConnectNamedPipe *
	1786	* *
	1787	* Start 'listening' by allowing clients to connect to a previously-created *
	1788	* named pipe. *
	1789	* *
	1790	* REXX ARGUMENTS: *
	1791	* 1. The pipe handle, as returned by Sys2CreateNamedPipe. (REQUIRED) *
	1792	* *
	1793	* REXX RETURN VALUE: *
	1794	* 1 on success, or 0 if an error occurred. *
	1795	* ------------------------------------------------------------------------- */
	1796	ULONG APIENTRY Sys2ConnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1797	{
	1798	HPIPE hp;
[26]	1799	ULONG ulState = 0;
[16]	1800	APIRET rc;
	1801
	1802	// Reset the error indicator
	1803	WriteErrorCode( 0, NULL );
	1804
	1805	// Parse the handle
	1806	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
	1807	if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
	1808
[26]	1809	// Determine the pipe mode
	1810	DosQueryNPHState( hp, &ulState );
	1811
[16]	1812	// Connect the pipe
	1813	rc = DosConnectNPipe( hp );
[26]	1814
	1815	// A non-blocking pipe returns ERROR_PIPE_NOT_CONNECTED on success
	1816	if ((( ulState & NP_NOWAIT ) && ( rc != ERROR_PIPE_NOT_CONNECTED )) \|\|
	1817	( rc != NO_ERROR ))
	1818	{
[16]	1819	WriteErrorCode( rc, "DosConnectNPipe");
[31]	1820	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[16]	1821	return ( 0 );
	1822	}
	1823
	1824	// Return 1 on success
[31]	1825	SaveResultString( prsResult, PSZ_ONE, 1 ); // 2016-02-20 SHL
[16]	1826	return ( 0 );
	1827	}
	1828
	1829
	1830	/* ------------------------------------------------------------------------- *
	1831	* Sys2DisconnectNamedPipe *
	1832	* *
	1833	* Unlocks a named pipe after a client has closed its connection. *
	1834	* *
	1835	* REXX ARGUMENTS: *
	1836	* 1. The pipe handle, as returned by Sys2CreateNamedPipe. (REQUIRED) *
	1837	* *
	1838	* REXX RETURN VALUE: *
	1839	* 1 on success, or 0 if an error occurred. *
	1840	* ------------------------------------------------------------------------- */
	1841	ULONG APIENTRY Sys2DisconnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1842	{
	1843	HPIPE hp;
	1844	APIRET rc;
	1845
	1846	// Reset the error indicator
	1847	WriteErrorCode( 0, NULL );
	1848
	1849	// Parse the handle
	1850	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
	1851	if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
	1852
	1853	// Connect the pipe
	1854	rc = DosDisConnectNPipe( hp );
	1855	if ( rc != NO_ERROR ) {
	1856	WriteErrorCode( rc, "DosDisConnectNPipe");
[31]	1857	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[16]	1858	return ( 0 );
	1859	}
	1860
	1861	// Return 1 on success
[31]	1862	SaveResultString( prsResult, PSZ_ONE, 1 ); // 2016-02-20 SHL
[16]	1863	return ( 0 );
	1864	}
	1865
	1866
	1867	/* ------------------------------------------------------------------------- *
	1868	* Sys2CheckNamedPipe *
	1869	* *
	1870	* Check the status of a named pipe. *
	1871	* *
	1872	* REXX ARGUMENTS: *
	1873	* 1. The pipe handle (from Sys2CreateNamedPipe or DosOpen). (REQUIRED) *
	1874	* *
	1875	* REXX RETURN VALUE: *
	1876	* String of the format "bytes status", where bytes is the number of bytes *
	1877	* currently waiting in the pipe, and status is one of: DISCONNECTED, *
[31]	1878	* LISTENING, CONNECTED, or CLOSING or "" if API error *
[16]	1879	* ------------------------------------------------------------------------- */
	1880	ULONG APIENTRY Sys2CheckNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1881	{
	1882	HPIPE hp;
	1883	ULONG cbActual, ulState;
	1884	AVAILDATA avd;
	1885	CHAR szStatus[ US_PIPESTATUS_MAXZ ];
	1886	APIRET rc;
	1887
	1888	// Reset the error indicator
	1889	WriteErrorCode( 0, NULL );
	1890
	1891	// Parse the handle
	1892	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
	1893	if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
	1894
	1895	rc = DosPeekNPipe( hp, NULL, 0, &cbActual, &avd, &ulState );
	1896	if ( rc != NO_ERROR ) {
	1897	WriteErrorCode( rc, "DosPeekNPipe");
[31]	1898	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[16]	1899	return ( 0 );
	1900	}
	1901	sprintf( szStatus, "%u ", avd.cbpipe );
	1902	switch ( ulState ) {
	1903	case NP_STATE_DISCONNECTED: strncat( szStatus, "DISCONNECTED", US_PIPESTATUS_MAXZ-1 ); break;
	1904	case NP_STATE_LISTENING: strncat( szStatus, "LISTENING", US_PIPESTATUS_MAXZ-1 ); break;
	1905	case NP_STATE_CONNECTED: strncat( szStatus, "CONNECTED", US_PIPESTATUS_MAXZ-1 ); break;
	1906	case NP_STATE_CLOSING: strncat( szStatus, "CLOSING", US_PIPESTATUS_MAXZ-1 ); break;
	1907	default: strncat( szStatus, "UNKNOWN", US_PIPESTATUS_MAXZ-1 ); break;
	1908	}
	1909
[31]	1910	SaveResultString( prsResult, szStatus, strlen(szStatus) ); // 2016-02-20 SHL
	1911
[16]	1912	return ( 0 );
	1913	}
	1914
	1915
	1916	/* ------------------------------------------------------------------------- *
	1917	* Sys2Open *
	1918	* *
	1919	* Wrapper to DosOpenL: open a file or stream (with >2GB support). *
	1920	* Direct-DASD mode is not supported by this function, nor is setting the *
	1921	* initial extended attributes. *
	1922	* *
	1923	* REXX ARGUMENTS: *
	1924	* 1. Name of file or stream to open. (REQUIRED) *
	1925	* 2. Open action flags, must be either "O" (open if exists), "R" (replace *
	1926	* if exists), or nothing (fail if exists), optionally followed by "C" *
	1927	* (create if file does not exist). If "C" is not specified, the *
	1928	* operation will fail if the file does not exist. Note that a value *
	1929	* of "" alone will therefore fail automatically. (DEFAULT: "O") *
	1930	* In summary, the possible combinations are: *
	1931	* O = Open only (if file exists, open it; if not, fail) *
	1932	* OC= Open/create (if file exists, open it; if not, create it) *
	1933	* R = Replace only (if file exists, replace it; if not, fail) *
	1934	* RC= Replace/create (if file exists, replace it; if not, create it) *
	1935	* C = Create only (if file exists, fail; if not, create it) *
	1936	* (empty) = No-op (if file exists, fail; if not, fail) *
	1937	* 3. Access mode flags, one or both of: (DEFAULT: "RW") *
	1938	* R = Open file with read access. *
	1939	* W = Open file with write access. *
	1940	* 4. Sharing mode flags, any combination of: (DEFAULT: "W") *
	1941	* R = Deny read access to other processes *
	1942	* W = Deny write access to other processes *
	1943	* 5. Deny legacy DosOpen access, one of: *
	1944	* 0 = Allow DosOpen to access the file (DEFAULT) *
	1945	* 1 = Deny access using the DosOpen API *
	1946	* 6. Privacy/inheritance flag, one of: *
	1947	* 0 = The file handle is inherited by child processes. (DEFAULT) *
	1948	* 1 = The file handle is private to the current process. *
	1949	* 7. Initial file attributes when creating a file: (DEFAULT: "") *
	1950	* A = Archive attribute set *
	1951	* D = Directory attribute set *
	1952	* S = System attribute set *
	1953	* H = Hidden attribute set *
	1954	* R = Read-only attribute set *
	1955	* 8. Initial file size when creating or replacing a file; ignored if *
	1956	* access mode is read-only. (DEFAULT: 0) *
	1957	* 9. I/O mode flags, any or all of: (DEFAULT: "") *
	1958	* T = Write-through mode (default is normal write) *
	1959	* N = No-cache mode (default is to use filesystem cache) *
	1960	* S = Sequential access *
	1961	* R = Random access *
	1962	* * S and R can combine as follows: *
	1963	* Neither: No locality known (default) *
	1964	* S only: Mainly sequential access *
	1965	* R only: Mainly random access *
	1966	* Both: Random/sequential (i.e. random with some locality) *
	1967	* *
	1968	* REXX RETURN VALUE: *
	1969	* File handle, or "" in case of error. *
	1970	* ------------------------------------------------------------------------- */
	1971	ULONG APIENTRY Sys2Open( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	1972	{
	1973	PSZ pszFile;
	1974	HFILE hf;
	1975	ULONG fsAction = 0,
	1976	fsMode = 0,
	1977	ulResult = 0,
	1978	ulAttr = FILE_NORMAL;
	1979	LONGLONG llSize = {0};
	1980	CHAR achHandle[ 9 ];
	1981	APIRET rc;
	1982
	1983
	1984	// Reset the error indicator
	1985	WriteErrorCode( 0, NULL );
	1986
	1987	// Make sure we have at least one valid argument (the file name)
	1988	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
	1989	return ( 40 );
	1990
	1991	// (Validate the first argument last to simplify error processing)
	1992
	1993	// Second argument: open action
	1994	if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
	1995	strupr( argv[1].strptr );
	1996	if ( strcspn(argv[1].strptr, "OCR") > 0 ) return ( 40 );
	1997	if ( strchr(argv[1].strptr, 'O'))
	1998	fsAction \|= OPEN_ACTION_OPEN_IF_EXISTS;
	1999	else if ( strchr(argv[1].strptr, 'R'))
	2000	fsAction \|= OPEN_ACTION_REPLACE_IF_EXISTS;
	2001	if ( strchr(argv[1].strptr, 'C'))
	2002	fsAction \|= OPEN_ACTION_CREATE_IF_NEW;
	2003	}
	2004	else
	2005	fsAction = OPEN_ACTION_OPEN_IF_EXISTS;
	2006
	2007	// Third argument: access mode
	2008	if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
	2009	strupr( argv[2].strptr );
	2010	if ( strcspn(argv[2].strptr, "RW") > 0 ) return ( 40 );
	2011	if ( strchr(argv[2].strptr, 'R')) {
	2012	if (strchr(argv[2].strptr, 'W'))
	2013	fsMode = OPEN_ACCESS_READWRITE;
	2014	else
	2015	fsMode = OPEN_ACCESS_READONLY;
	2016	}
	2017	else if (strchr(argv[2].strptr, 'W'))
	2018	fsMode = OPEN_ACCESS_WRITEONLY;
	2019	else
	2020	return ( 40 );
	2021	}
	2022	else
	2023	fsMode = OPEN_ACCESS_READWRITE;
	2024
	2025	// Fourth argument: sharing mode
	2026	if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
	2027	strupr( argv[3].strptr );
	2028	if ( strcspn(argv[3].strptr, "RW") > 0 ) return ( 40 );
	2029	if ( strchr(argv[3].strptr, 'R')) {
	2030	if (strchr(argv[3].strptr, 'W'))
	2031	fsMode \|= OPEN_SHARE_DENYREADWRITE;
	2032	else
	2033	fsMode \|= OPEN_SHARE_DENYREAD;
	2034	}
	2035	else if (strchr(argv[3].strptr, 'W'))
	2036	fsMode \|= OPEN_SHARE_DENYWRITE;
	2037	else
	2038	fsMode \|= OPEN_SHARE_DENYNONE;
	2039	}
	2040	else
[39]	2041	fsMode \|= OPEN_SHARE_DENYNONE;
[16]	2042
	2043	// Fifth argument: deny legacy mode
	2044	if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
	2045	strupr( argv[4].strptr );
	2046	if ( argv[4].strptr[0] == '1' )
	2047	fsMode \|= OPEN_SHARE_DENYLEGACY;
	2048	else if ( argv[4].strptr[0] != '0' )
	2049	return ( 40 );
	2050	}
	2051
	2052	// Sixth argument: inheritance mode
	2053	if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
	2054	strupr( argv[5].strptr );
	2055	if ( argv[5].strptr[0] == '1' )
	2056	fsMode \|= OPEN_FLAGS_NOINHERIT;
	2057	else if ( argv[5].strptr[0] != '0' )
	2058	return ( 40 );
	2059	}
	2060
	2061	// Seventh argument: attributes
	2062	if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
	2063	strupr( argv[6].strptr );
	2064	if (strcspn(argv[6].strptr, "ADSHR") > 0 ) return ( 40 );
	2065	if ( strchr(argv[6].strptr, 'A')) ulAttr \|= FILE_ARCHIVED;
	2066	if ( strchr(argv[6].strptr, 'D')) ulAttr \|= FILE_DIRECTORY;
	2067	if ( strchr(argv[6].strptr, 'S')) ulAttr \|= FILE_SYSTEM;
	2068	if ( strchr(argv[6].strptr, 'H')) ulAttr \|= FILE_HIDDEN;
	2069	if ( strchr(argv[6].strptr, 'R')) ulAttr \|= FILE_READONLY;
	2070	}
	2071
	2072	// Eighth argument: initial size
	2073	if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
	2074	if (( sscanf( argv[7].strptr, "%lld", &llSize )) != 1 ) return ( 40 );
	2075	}
	2076
	2077	// Ninth argument: I/O mode flags
	2078	if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
	2079	strupr( argv[8].strptr );
	2080	if (strcspn(argv[8].strptr, "TNSR") > 0 ) return ( 40 );
	2081	if ( strchr(argv[8].strptr, 'T')) fsMode \|= OPEN_FLAGS_WRITE_THROUGH;
	2082	if ( strchr(argv[8].strptr, 'N')) fsMode \|= OPEN_FLAGS_NO_CACHE;
	2083	if ( strchr(argv[8].strptr, 'S')) fsMode \|= OPEN_FLAGS_SEQUENTIAL;
	2084	if ( strchr(argv[8].strptr, 'R')) fsMode \|= OPEN_FLAGS_RANDOM;
	2085	}
	2086
	2087	// Now the first argument: file name
	2088	pszFile = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
	2089	if ( pszFile == NULL ) {
	2090	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
[31]	2091	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[16]	2092	return ( 0 );
	2093	}
	2094	strncpy( pszFile, argv[0].strptr, RXSTRLEN(argv[0]) );
	2095
	2096	// Try and open the file
	2097	rc = DosOpenL( pszFile, &hf, &ulResult, llSize, ulAttr, fsAction, fsMode, NULL );
	2098	if (rc) {
	2099	WriteErrorCode( rc, "DosOpenL");
[31]	2100	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[16]	2101	free( pszFile );
	2102	return ( 0 );
	2103	}
	2104
	2105	// Return the handle as the REXX result string
	2106	sprintf( achHandle, "%8X", hf );
[31]	2107	SaveResultString( prsResult, achHandle, strlen(achHandle) ); // 2016-02-20 SHL
[16]	2108
	2109	free( pszFile );
	2110	return ( 0 );
	2111	}
	2112
	2113
	2114	/* ------------------------------------------------------------------------- *
	2115	* Sys2Close *
	2116	* *
[17]	2117	* Wrapper to DosClose: close a file/stream. *
[16]	2118	* *
	2119	* REXX ARGUMENTS: *
	2120	* 1. File handle (returned by Sys2Open) (REQUIRED) *
	2121	* *
	2122	* REXX RETURN VALUE: *
	2123	* 1 on success, or 0 if an error occurred. *
	2124	* ------------------------------------------------------------------------- */
	2125	ULONG APIENTRY Sys2Close( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2126	{
	2127	HFILE hf;
	2128	APIRET rc;
	2129
	2130	// Reset the error indicator
	2131	WriteErrorCode( 0, NULL );
	2132
	2133	// Make sure we have exactly one valid argument (the file handle)
	2134	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
	2135	return ( 40 );
	2136	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
	2137
	2138	// Close the file
	2139	rc = DosClose( hf );
	2140	if ( rc != NO_ERROR ) {
	2141	WriteErrorCode( rc, "DosClose");
[31]	2142	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[16]	2143	}
	2144	else {
[31]	2145	SaveResultString( prsResult, PSZ_ONE, 1 ); // 2016-02-20 SHL
[16]	2146	}
	2147
	2148	return ( 0 );
	2149	}
	2150
	2151
	2152	/* ------------------------------------------------------------------------- *
	2153	* Sys2Seek *
	2154	* *
	2155	* Wrapper to DosSetFilePtrL: move the read/write pointer to the specified *
	2156	* location in a stream. *
	2157	* *
	2158	* REXX ARGUMENTS: *
	2159	* 1. File handle (returned by Sys2Open) (REQUIRED) *
	2160	* 2. The signed distance in bytes to move (REQUIRED) *
	2161	* 3. Move method, one of: *
	2162	* B = Beginning of file *
	2163	* C = Current position (DEFAULT) *
	2164	* E = End of file *
	2165	* *
	2166	* REXX RETURN VALUE: *
[31]	2167	* The new file position, in bytes or "" if error *
[16]	2168	* ------------------------------------------------------------------------- */
	2169	ULONG APIENTRY Sys2Seek( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2170	{
	2171	HFILE hf;
	2172	LONGLONG llPos,
	2173	llActual;
	2174	ULONG ulMethod = FILE_CURRENT;
	2175	CHAR achActual[ US_LONGLONG_MAXZ ];
	2176	APIRET rc;
	2177
	2178	// Reset the error indicator
	2179	WriteErrorCode( 0, NULL );
	2180
	2181	// Make sure we have at least two valid arguments
	2182	if ( argc < 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
	2183	return ( 40 );
	2184
	2185	// First argument: file handle
	2186	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
	2187
	2188	// Second argument: requested offset
	2189	if (( sscanf( argv[1].strptr, "%lld", &llPos )) != 1 ) return ( 40 );
	2190
	2191	// Third argument: starting position
	2192	if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
	2193	strupr( argv[2].strptr );
	2194	if ( strcspn(argv[2].strptr, "BCE") > 0 ) return ( 40 );
[17]	2195	switch ( argv[2].strptr[0] ) {
[16]	2196	case 'B': ulMethod = FILE_BEGIN; break;
	2197	case 'E': ulMethod = FILE_END; break;
	2198	default : ulMethod = FILE_CURRENT; break;
	2199	}
	2200	}
	2201
	2202	rc = DosSetFilePtrL( hf, llPos, ulMethod, &llActual );
	2203	if ( rc != NO_ERROR ) {
	2204	WriteErrorCode( rc, "DosSetFilePtrL");
[31]	2205	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[16]	2206	return ( 0 );
	2207	}
	2208
	2209	// Return the new position as the REXX result string
	2210	sprintf( achActual, "%lld", llActual );
[31]	2211	SaveResultString( prsResult, achActual, strlen(achActual) ); // 2016-02-20 SHL
[16]	2212
	2213	return ( 0 );
	2214	}
	2215
	2216
	2217	/* ------------------------------------------------------------------------- *
[48]	2218	* Sys2SetSize *
	2219	* *
	2220	* Wrapper to DosSetFileSizeL: set the size of a file opened with Sys2Open. *
	2221	* *
	2222	* REXX ARGUMENTS: *
	2223	* 1. File handle (returned by Sys2Open) (REQUIRED) *
	2224	* 2. The new size of the file (REQUIRED) *
	2225	* *
	2226	* REXX RETURN VALUE: *
	2227	* 1 on success, or 0 if an error occurred. *
	2228	* ------------------------------------------------------------------------- */
	2229	ULONG APIENTRY Sys2SetSize( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2230	{
	2231	HFILE hf;
	2232	LONGLONG llSize;
	2233	APIRET rc;
	2234
	2235	// Reset the error indicator
	2236	WriteErrorCode( 0, NULL );
	2237
	2238	// Make sure we have two valid arguments
	2239	if ( argc < 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
	2240	return ( 40 );
	2241
	2242	// First argument: file handle
	2243	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
	2244
	2245	// Second argument: requested size
	2246	if (( sscanf( argv[1].strptr, "%lld", &llSize )) != 1 ) return ( 40 );
	2247
	2248	rc = DosSetFileSizeL( hf, llSize );
	2249	if ( rc != NO_ERROR ) {
	2250	WriteErrorCode( rc, "DosSetFileSizeL");
	2251	SaveResultString( prsResult, PSZ_ZERO, 1 );
	2252	}
	2253	else {
	2254	SaveResultString( prsResult, PSZ_ONE, 1 );
	2255	}
	2256
	2257	return ( 0 );
	2258	}
	2259
	2260
	2261	/* ------------------------------------------------------------------------- *
[39]	2262	* Sys2BytesRemaining *
	2263	* *
	2264	* Return the number bytes that remain in a stream following the current *
	2265	* read/write position. *
	2266	* *
	2267	* REXX ARGUMENTS: *
	2268	* 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
	2269	* *
	2270	* REXX RETURN VALUE: *
	2271	* The number of bytes remaining. In case of error, 0 will be returned and *
	2272	* SYS2ERR will be set. *
	2273	* ------------------------------------------------------------------------- */
	2274	ULONG APIENTRY Sys2BytesRemaining( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2275	{
	2276	HFILE hf;
	2277	FILESTATUS3L fst3l = {0};
	2278	LONGLONG ll = {0},
	2279	llPos,
	2280	llSize;
	2281	CHAR achActual[ US_LONGLONG_MAXZ ];
	2282	APIRET rc;
	2283
	2284	// Reset the error indicator
	2285	WriteErrorCode( 0, NULL );
	2286
	2287	// Make sure we have one valid argument
	2288	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
	2289
	2290	// First argument: handle
	2291	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
	2292
	2293	// Get the current position
	2294	rc = DosSetFilePtrL( hf, ll, FILE_CURRENT, &llPos );
	2295	if ( rc != NO_ERROR ) {
	2296	WriteErrorCode( rc, "DosSetFilePtrL");
	2297	SaveResultString( prsResult, NULL, 0 );
	2298	return ( 0 );
	2299	}
	2300
	2301	// Get the total file size
	2302	rc = DosQueryFileInfo( hf, FIL_STANDARDL, &fst3l, sizeof( fst3l ));
	2303	if ( rc != NO_ERROR ) {
	2304	WriteErrorCode( rc, "DosQueryFileInfoL");
	2305	SaveResultString( prsResult, NULL, 0 );
	2306	return ( 0 );
	2307	}
	2308	llSize = fst3l.cbFile - llPos;
	2309
	2310	// Return the position as the REXX result string
	2311	sprintf( achActual, "%lld", llSize );
	2312	SaveResultString( prsResult, achActual, strlen(achActual) );
	2313
	2314	return ( 0 );
	2315	}
	2316
	2317
	2318	/* ------------------------------------------------------------------------- *
[16]	2319	* Sys2Read *
	2320	* *
	2321	* Wrapper to DosRead: read bytes from a previously-opened stream. *
	2322	* *
	2323	* REXX ARGUMENTS: *
	2324	* 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
	2325	* 2. Number of bytes to read (REQUIRED) *
	2326	* *
	2327	* REXX RETURN VALUE: *
	2328	* String containing the bytes read, or "" in case of error. *
	2329	* ------------------------------------------------------------------------- */
	2330	ULONG APIENTRY Sys2Read( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2331	{
	2332	HFILE hf;
	2333	ULONG cb,
	2334	cbActual;
	2335	PSZ pszData;
	2336	APIRET rc;
	2337
	2338	// Reset the error indicator
	2339	WriteErrorCode( 0, NULL );
	2340
	2341	// Make sure we have two valid arguments
	2342	if ( argc != 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
	2343	return ( 40 );
	2344
	2345	// First argument: handle
	2346	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
	2347
	2348	// Second argument: number of bytes to read
	2349	if (( sscanf( argv[1].strptr, "%u", &cb )) != 1 ) return ( 40 );
	2350	if ( cb < 1 ) return ( 40 );
	2351	pszData = (PSZ) malloc( cb );
	2352
	2353	rc = DosRead( hf, pszData, cb, &cbActual );
	2354	if ( rc \|\| !cbActual ) {
	2355	WriteErrorCode( rc, "DosRead");
[31]	2356	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
[16]	2357	goto cleanup;
	2358	}
[31]	2359	SaveResultString( prsResult, pszData, cbActual ); // 2016-02-20 SHL
[16]	2360
	2361	cleanup:
	2362	free( pszData );
	2363	return ( 0 );
	2364	}
	2365
	2366
	2367	/* ------------------------------------------------------------------------- *
[39]	2368	* Sys2ReadLine *
	2369	* *
	2370	* Read a line (up to the next LF byte) from a previously-opened stream. *
	2371	* Only line feed (0x0A) bytes are treated as line-end characters; they will *
	2372	* be stripped from the result string. Carriage return bytes (0x0D) will *
	2373	* be skipped over but otherwise ignored. *
	2374	* *
	2375	* REXX ARGUMENTS: *
	2376	* 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
	2377	* *
	2378	* REXX RETURN VALUE: *
	2379	* String containing the text read. In the event of error, this will be "" *
	2380	* and SYS2ERR will be set. *
	2381	* ------------------------------------------------------------------------- */
	2382	ULONG APIENTRY Sys2ReadLine( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2383	{
	2384	HFILE hf;
	2385	ULONG cbBuf = 0,
	2386	cbTotal = 0,
	2387	cbActual = 0;
	2388	PSZ pszData;
	2389	BOOL fEOL = FALSE;
	2390	CHAR ch;
	2391	APIRET rc;
	2392
	2393	// Reset the error indicator
	2394	WriteErrorCode( 0, NULL );
	2395
	2396	// Make sure we have one valid argument
	2397	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
	2398
	2399	// First argument: handle
	2400	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
	2401
	2402	cbBuf = 1024;
	2403	pszData = (PSZ) malloc( cbBuf );
	2404	while ( !fEOL ) {
	2405	rc = DosRead( hf, &ch, 1, &cbActual );
	2406	if ( rc ) {
	2407	WriteErrorCode( rc, "DosRead");
	2408	SaveResultString( prsResult, NULL, 0 ); // 2016-02-20 SHL
	2409	goto cleanup;
	2410	}
	2411	if ( !cbActual \|\| ch == '\n') {
	2412	fEOL = TRUE;
	2413	break;
	2414	}
	2415	else if ( ch == '\r')
	2416	continue;
	2417	if ( cbTotal >= cbBuf ) {
	2418	cbBuf += 256;
	2419	pszData = (PSZ) realloc( pszData, cbBuf );
	2420	}
	2421	pszData[ cbTotal++ ] = ch;
	2422	}
	2423	SaveResultString( prsResult, pszData, cbTotal ); // 2016-02-20 SHL
	2424
	2425	cleanup:
	2426	free( pszData );
	2427	return ( 0 );
	2428	}
	2429
	2430
	2431	/* ------------------------------------------------------------------------- *
[16]	2432	* Sys2Write *
	2433	* *
	2434	* Wrapper to DosWrite: write bytes to a previously-opened stream. *
	2435	* *
	2436	* REXX ARGUMENTS: *
	2437	* 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
	2438	* 2. Data to be written (REQUIRED) *
	2439	* *
	2440	* REXX RETURN VALUE: *
[17]	2441	* Number of bytes written. *
[16]	2442	* ------------------------------------------------------------------------- */
	2443	ULONG APIENTRY Sys2Write( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2444	{
	2445	HFILE hf;
	2446	ULONG cbActual;
[17]	2447	CHAR szActual[ US_INTEGER_MAXZ ];
[16]	2448	APIRET rc;
	2449
	2450	// Reset the error indicator
	2451	WriteErrorCode( 0, NULL );
	2452
	2453	// Make sure we have two valid arguments
	2454	if ( argc != 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
	2455	return ( 40 );
	2456
	2457	// First argument: handle
	2458	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
	2459
	2460	// (Second argument can be left in standard RXSTRING form)
	2461
[17]	2462	rc = DosWrite( hf, argv[1].strptr, argv[1].strlength, &cbActual );
[16]	2463	if ( rc != NO_ERROR ) {
	2464	WriteErrorCode( rc, "DosWrite");
[31]	2465	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[17]	2466	return ( 0 );
[16]	2467	}
	2468
[17]	2469	sprintf( szActual, "%d", cbActual );
[31]	2470	SaveResultString( prsResult, szActual, strlen(szActual) ); // 2016-02-20 SHL
[16]	2471	return ( 0 );
	2472	}
	2473
	2474
[25]	2475	/* ------------------------------------------------------------------------- *
	2476	* Sys2SyncBuffer *
	2477	* *
	2478	* Wrapper to DosResetBuffer: for external files, write the buffer to disk; *
	2479	* for pipes, block until the far end of the pipe has read the contents. *
	2480	* *
	2481	* REXX ARGUMENTS: *
	2482	* 1. File handle (returned by Sys2Open) (REQUIRED) *
	2483	* *
	2484	* REXX RETURN VALUE: *
	2485	* 1 on success, or 0 if an error occurred. *
	2486	* ------------------------------------------------------------------------- */
	2487	ULONG APIENTRY Sys2SyncBuffer( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2488	{
	2489	HFILE hf;
	2490	APIRET rc;
	2491
	2492	// Reset the error indicator
	2493	WriteErrorCode( 0, NULL );
	2494
	2495	// Make sure we have exactly one valid argument (the file handle)
	2496	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
	2497	return ( 40 );
	2498	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
	2499
	2500	// Sync the buffer
	2501	rc = DosResetBuffer( hf );
	2502	if ( rc != NO_ERROR ) {
	2503	WriteErrorCode( rc, "DosResetBuffer");
[31]	2504	SaveResultString( prsResult, PSZ_ZERO, 1 ); // 2016-02-20 SHL
[25]	2505	}
	2506	else {
[31]	2507	SaveResultString( prsResult, PSZ_ONE, 1 ); // 2016-02-20 SHL
[25]	2508	}
	2509
	2510	return ( 0 );
	2511	}
	2512
	2513
[36]	2514	/* ------------------------------------------------------------------------- *
	2515	* Sys2QueryDriveInfo *
	2516	* *
	2517	* Get non-filesystem-dependent information about a logical drive (volume). *
	2518	* *
	2519	* REXX ARGUMENTS: *
	2520	* 1. Drive/volume letter to query, trailing colon optional. (REQUIRED) *
	2521	* *
	2522	* REXX RETURN VALUE: *
	2523	* On success, returns a string in the format *
	2524	* <drive> <size> <type> <flag> *
	2525	* where <drive> is the uppercase drive letter followed by a colon, *
	2526	* <size> is the total size of the drive/volume in binary kilobytes,*
	2527	* <type> is one of: *
	2528	* FLOPPY_5L - 48 TPI low-density diskette drive *
	2529	* FLOPPY_5H - 96 TPI high-density diskette drive *
	2530	* FLOPPY_3L - 3.5-inch 720KB drive *
	2531	* FLOPPY_3H - 3.5-inch high-density 1.44MB diskette drive *
	2532	* FLOPPY_3X - 3.5-inch ext-density 2.88MB diskette drive *
	2533	* FLOPPY_8L - 8-inch single-density diskette drive *
	2534	* FLOPPY_8H - 8-inch double-density diskette drive *
	2535	* OTHER - other (including CD drive with no media) *
	2536	* HDD - hard disk drive (including PRM) *
	2537	* TAPE - tape drive *
	2538	* OPTICAL - read/write optical drive *
	2539	* and <flag> is 1 for non-partitionable removable media (e.g. floppies) *
	2540	* or 0 otherwise (including both fixed and PRM disks) *
	2541	* ------------------------------------------------------------------------- */
	2542	ULONG APIENTRY Sys2QueryDriveInfo( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2543	{
	2544	BIOSPARAMETERBLOCK data;
	2545	CHAR szDiskInfo[ US_DISKINFO_MAXZ ];
	2546	UCHAR achPP[ 2 ],
	2547	chVol;
	2548	ULONG cbPP,
	2549	cbData,
	2550	ulSectors,
	2551	ulSize;
	2552	BOOL bRemovable;
	2553	APIRET rc;
[25]	2554
[36]	2555
	2556	// Reset the error indicator
	2557	WriteErrorCode( 0, NULL );
	2558
	2559	// Make sure we have exactly one valid argument (the drive letter)
	2560	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
	2561	return ( 40 );
	2562	chVol = toupper( argv[0].strptr[0] );
	2563	if (( chVol < 'A') \|\| ( chVol > 'Z'))
	2564	return ( 40 );
	2565
	2566	cbPP = 2;
	2567	achPP[ 0 ] = 0;
	2568	achPP[ 1 ] = chVol - 65;
	2569	cbData = sizeof( data );
	2570	rc = DosDevIOCtl( (HFILE) -1, IOCTL_DISK, DSK_GETDEVICEPARAMS,
	2571	(PVOID) achPP, 2, &cbPP, &data, cbData, &cbData );
	2572	if ( rc != NO_ERROR ) {
	2573	WriteErrorCode( rc, "DosDevIOCtl");
	2574	SaveResultString( prsResult, NULL, 0 );
	2575	return ( 0 );
	2576	}
	2577
	2578	ulSectors = data.cSectors? data.cSectors: data.cLargeSectors;
	2579	ulSize = (data.usBytesPerSector > 1024) ?
	2580	(ULONG) (ulSectors * ( data.usBytesPerSector / 1024 )) :
	2581	(ULONG) (ulSectors / ( 1024 / data.usBytesPerSector ));
	2582	bRemovable = !( data.fsDeviceAttr & 1 );
	2583
	2584	sprintf( szDiskInfo, "%c: %u ", chVol, ulSize );
	2585	switch( data.bDeviceType ) {
	2586	case 0: // 48 TPI low-density diskette drive
	2587	strncat( szDiskInfo, "FLOPPY_5L", US_DISKINFO_MAXZ-1 );
	2588	break;
	2589	case 1: // 96 TPI high-density diskette drive
	2590	strncat( szDiskInfo, "FLOPPY_5H", US_DISKINFO_MAXZ-1 );
	2591	break;
	2592	case 2: // Small (3.5-inch) 720KB drive
	2593	strncat( szDiskInfo, "FLOPPY_3L", US_DISKINFO_MAXZ-1 );
	2594	break;
	2595	case 3: // 8-inch single-density diskette drive
	2596	strncat( szDiskInfo, "FLOPPY_8L", US_DISKINFO_MAXZ-1 );
	2597	break;
	2598	case 4: // 8-inch double-density diskette drive
	2599	strncat( szDiskInfo, "FLOPPY_8H", US_DISKINFO_MAXZ-1 );
	2600	break;
	2601	case 5: // Fixed disk
	2602	strncat( szDiskInfo, "HDD", US_DISKINFO_MAXZ-1 );
	2603	break;
	2604	case 6: // Tape drive
	2605	strncat( szDiskInfo, "TAPE", US_DISKINFO_MAXZ-1 );
	2606	break;
	2607	case 7: // Other (includes 1.44MB 3.5-inch diskette drive)
	2608	if ( ulSize == 1440 )
	2609	strncat( szDiskInfo, "FLOPPY_3H", US_DISKINFO_MAXZ-1 );
	2610	else
	2611	strncat( szDiskInfo, "OTHER", US_DISKINFO_MAXZ-1 );
	2612	break;
	2613	case 8: // R/W optical disk
	2614	strncat( szDiskInfo, "OPTICAL", US_DISKINFO_MAXZ-1 );
	2615	break;
	2616	case 9: // 3.5-inch 4.0MB diskette drive (2.88MB formatted)
	2617	strncat( szDiskInfo, "FLOPPY_3X", US_DISKINFO_MAXZ-1 );
	2618	break;
	2619	default:
	2620	strncat( szDiskInfo, "UNKNOWN", US_DISKINFO_MAXZ-1 );
	2621	break;
	2622	}
	2623	strncat( szDiskInfo, ( bRemovable? " 1": " 0" ), US_DISKINFO_MAXZ-1 );
	2624
	2625	SaveResultString( prsResult, szDiskInfo, strlen(szDiskInfo) );
	2626	return ( 0 );
	2627	}
	2628
	2629
	2630
[40]	2631	/* ------------------------------------------------------------------------- *
	2632	* Sys2QuerySysValue *
	2633	* *
	2634	* Query the given system value. *
	2635	* *
	2636	* REXX ARGUMENTS: *
	2637	* 1. The system value identifier (REQUIRED) *
	2638	* *
	2639	* REXX RETURN VALUE: The requested system value, or "" on error. *
	2640	* ------------------------------------------------------------------------- */
	2641	ULONG APIENTRY Sys2QuerySysValue( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2642	{
	2643	CHAR szResult[ US_INTEGER_MAXZ ];
	2644	LONG lID,
	2645	lValue;
	2646
	2647	// Reset the error indicator
	2648	WriteErrorCode( 0, NULL );
	2649
	2650	// Make sure we have exactly one valid argument
	2651	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
	2652
	2653	// Parse the identifier
	2654	lID = -1;
	2655	strupr( argv[0].strptr );
	2656	if (( sscanf( argv[0].strptr, "%d", &lID )) != 1 ) {
	2657	if ( ! stricmp( argv[0].strptr, "ALARM")) lID = SV_ALARM;
	2658	else if ( ! stricmp( argv[0].strptr, "ALTMNEMONIC")) lID = SV_ALTMNEMONIC;
	2659	else if ( ! stricmp( argv[0].strptr, "ANIMATIONSPEED")) lID = SV_ANIMATIONSPEED;
	2660	else if ( ! stricmp( argv[0].strptr, "ANIMATION")) lID = SV_ANIMATION;
	2661	else if ( ! stricmp( argv[0].strptr, "BEGINDRAG")) lID = SV_BEGINDRAG;
	2662	else if ( ! stricmp( argv[0].strptr, "BEGINDRAGKB")) lID = SV_BEGINDRAGKB;
	2663	else if ( ! stricmp( argv[0].strptr, "BEGINSELECT")) lID = SV_BEGINSELECT;
	2664	else if ( ! stricmp( argv[0].strptr, "BEGINSELECTKB")) lID = SV_BEGINSELECTKB;
	2665	else if ( ! stricmp( argv[0].strptr, "CHORDTIME")) lID = SV_CHORDTIME;
	2666	else if ( ! stricmp( argv[0].strptr, "CICONTEXTLINES")) lID = SV_CICONTEXTLINES;
	2667	else if ( ! stricmp( argv[0].strptr, "CMOUSEBUTTONS")) lID = SV_CMOUSEBUTTONS;
	2668	else if ( ! stricmp( argv[0].strptr, "CONTEXTHELPKB")) lID = SV_CONTEXTHELPKB;
	2669	else if ( ! stricmp( argv[0].strptr, "CONTEXTHELP")) lID = SV_CONTEXTHELP;
	2670	else if ( ! stricmp( argv[0].strptr, "CONTEXTMENU")) lID = SV_CONTEXTMENU;
	2671	else if ( ! stricmp( argv[0].strptr, "CONTEXTMENUKB")) lID = SV_CONTEXTMENUKB;
	2672	else if ( ! stricmp( argv[0].strptr, "CPOINTERBUTTONS")) lID = SV_CPOINTERBUTTONS;
	2673	else if ( ! stricmp( argv[0].strptr, "CTIMERS")) lID = SV_CTIMERS;
	2674	else if ( ! stricmp( argv[0].strptr, "CURSORLEVEL")) lID = SV_CURSORLEVEL;
	2675	else if ( ! stricmp( argv[0].strptr, "CURSORRATE")) lID = SV_CURSORRATE;
	2676	else if ( ! stricmp( argv[0].strptr, "CXALIGN")) lID = SV_CXALIGN;
	2677	else if ( ! stricmp( argv[0].strptr, "CXBORDER")) lID = SV_CXBORDER;
	2678	else if ( ! stricmp( argv[0].strptr, "CXBYTEALIGN")) lID = SV_CXBYTEALIGN;
	2679	else if ( ! stricmp( argv[0].strptr, "CXCHORD")) lID = SV_CXCHORD;
	2680	else if ( ! stricmp( argv[0].strptr, "CXDBLCLK")) lID = SV_CXDBLCLK;
	2681	else if ( ! stricmp( argv[0].strptr, "CXDLGFRAME")) lID = SV_CXDLGFRAME;
	2682	else if ( ! stricmp( argv[0].strptr, "CXFULLSCREEN")) lID = SV_CXFULLSCREEN;
	2683	else if ( ! stricmp( argv[0].strptr, "CXHSCROLLARROW")) lID = SV_CXHSCROLLARROW;
	2684	else if ( ! stricmp( argv[0].strptr, "CXHSLIDER")) lID = SV_CXHSLIDER;
	2685	else if ( ! stricmp( argv[0].strptr, "CXICONTEXTWIDTH")) lID = SV_CXICONTEXTWIDTH;
	2686	else if ( ! stricmp( argv[0].strptr, "CXICON")) lID = SV_CXICON;
	2687	else if ( ! stricmp( argv[0].strptr, "CXMINMAXBUTTON")) lID = SV_CXMINMAXBUTTON;
	2688	else if ( ! stricmp( argv[0].strptr, "CXMOTIONSTART")) lID = SV_CXMOTIONSTART;
	2689	else if ( ! stricmp( argv[0].strptr, "CXPOINTER")) lID = SV_CXPOINTER;
	2690	else if ( ! stricmp( argv[0].strptr, "CXSCREEN")) lID = SV_CXSCREEN;
	2691	else if ( ! stricmp( argv[0].strptr, "CXSIZEBORDER")) lID = SV_CXSIZEBORDER;
	2692	else if ( ! stricmp( argv[0].strptr, "CXVSCROLL")) lID = SV_CXVSCROLL;
	2693	else if ( ! stricmp( argv[0].strptr, "CYALIGN")) lID = SV_CYALIGN;
	2694	else if ( ! stricmp( argv[0].strptr, "CYBORDER")) lID = SV_CYBORDER;
	2695	else if ( ! stricmp( argv[0].strptr, "CYBYTEALIGN")) lID = SV_CYBYTEALIGN;
	2696	else if ( ! stricmp( argv[0].strptr, "CYCHORD")) lID = SV_CYCHORD;
	2697	else if ( ! stricmp( argv[0].strptr, "CYDBLCLK")) lID = SV_CYDBLCLK;
	2698	else if ( ! stricmp( argv[0].strptr, "CYDLGFRAME")) lID = SV_CYDLGFRAME;
	2699	else if ( ! stricmp( argv[0].strptr, "CYFULLSCREEN")) lID = SV_CYFULLSCREEN;
	2700	else if ( ! stricmp( argv[0].strptr, "CYHSCROLL")) lID = SV_CYHSCROLL;
	2701	else if ( ! stricmp( argv[0].strptr, "CYICON")) lID = SV_CYICON;
	2702	else if ( ! stricmp( argv[0].strptr, "CYMENU")) lID = SV_CYMENU;
	2703	else if ( ! stricmp( argv[0].strptr, "CYMINMAXBUTTON")) lID = SV_CYMINMAXBUTTON;
	2704	else if ( ! stricmp( argv[0].strptr, "CYMOTIONSTART")) lID = SV_CYMOTIONSTART;
	2705	else if ( ! stricmp( argv[0].strptr, "CYPOINTER")) lID = SV_CYPOINTER;
	2706	else if ( ! stricmp( argv[0].strptr, "CYSCREEN")) lID = SV_CYSCREEN;
	2707	else if ( ! stricmp( argv[0].strptr, "CYSIZEBORDER")) lID = SV_CYSIZEBORDER;
	2708	else if ( ! stricmp( argv[0].strptr, "CYTITLEBAR")) lID = SV_CYTITLEBAR;
	2709	else if ( ! stricmp( argv[0].strptr, "CYVSCROLLARROW")) lID = SV_CYVSCROLLARROW;
	2710	else if ( ! stricmp( argv[0].strptr, "CYVSLIDER")) lID = SV_CYVSLIDER;
	2711	else if ( ! stricmp( argv[0].strptr, "DBLCLKTIME")) lID = SV_DBLCLKTIME;
	2712	else if ( ! stricmp( argv[0].strptr, "DEBUG")) lID = SV_DEBUG;
	2713	else if ( ! stricmp( argv[0].strptr, "ENDDRAG")) lID = SV_ENDDRAG;
	2714	else if ( ! stricmp( argv[0].strptr, "ENDDRAGKB")) lID = SV_ENDDRAGKB;
	2715	else if ( ! stricmp( argv[0].strptr, "ENDSELECTKB")) lID = SV_ENDSELECTKB;
	2716	else if ( ! stricmp( argv[0].strptr, "ENDSELECT")) lID = SV_ENDSELECT;
	2717	else if ( ! stricmp( argv[0].strptr, "ERRORDURATION")) lID = SV_ERRORDURATION;
	2718	else if ( ! stricmp( argv[0].strptr, "ERRORFREQ")) lID = SV_ERRORFREQ;
	2719	else if ( ! stricmp( argv[0].strptr, "FIRSTSCROLLRATE")) lID = SV_FIRSTSCROLLRATE;
	2720	else if ( ! stricmp( argv[0].strptr, "INSERTMODE")) lID = SV_INSERTMODE;
	2721	else if ( ! stricmp( argv[0].strptr, "KBDALTERED")) lID = SV_KBDALTERED;
	2722	else if ( ! stricmp( argv[0].strptr, "LOCKSTARTINPUT")) lID = SV_LOCKSTARTINPUT;
	2723	else if ( ! stricmp( argv[0].strptr, "MENUROLLDOWNDELAY")) lID = SV_MENUROLLDOWNDELAY;
	2724	else if ( ! stricmp( argv[0].strptr, "MENUROLLUPDELAY")) lID = SV_MENUROLLUPDELAY;
	2725	else if ( ! stricmp( argv[0].strptr, "MONOICONS")) lID = SV_MONOICONS;
	2726	else if ( ! stricmp( argv[0].strptr, "MOUSEPRESENT")) lID = SV_MOUSEPRESENT;
	2727	else if ( ! stricmp( argv[0].strptr, "NOTEDURATION")) lID = SV_NOTEDURATION;
	2728	else if ( ! stricmp( argv[0].strptr, "NOTEFREQ")) lID = SV_NOTEFREQ;
	2729	else if ( ! stricmp( argv[0].strptr, "NUMBEREDLISTS")) lID = SV_NUMBEREDLISTS;
	2730	else if ( ! stricmp( argv[0].strptr, "OPEN")) lID = SV_OPEN;
	2731	else if ( ! stricmp( argv[0].strptr, "OPENKB")) lID = SV_OPENKB;
	2732	else if ( ! stricmp( argv[0].strptr, "POINTERLEVEL")) lID = SV_POINTERLEVEL;
	2733	else if ( ! stricmp( argv[0].strptr, "PRINTSCREEN")) lID = SV_PRINTSCREEN;
	2734	else if ( ! stricmp( argv[0].strptr, "SCROLLRATE")) lID = SV_SCROLLRATE;
	2735	else if ( ! stricmp( argv[0].strptr, "SELECTKB")) lID = SV_SELECTKB;
	2736	else if ( ! stricmp( argv[0].strptr, "SETLIGHTS")) lID = SV_SETLIGHTS;
	2737	else if ( ! stricmp( argv[0].strptr, "SINGLESELECT")) lID = SV_SINGLESELECT;
	2738	else if ( ! stricmp( argv[0].strptr, "SWAPBUTTON")) lID = SV_SWAPBUTTON;
	2739	else if ( ! stricmp( argv[0].strptr, "TASKLISTMOUSEACCESS")) lID = SV_TASKLISTMOUSEACCESS;
	2740	else if ( ! stricmp( argv[0].strptr, "TEXTEDIT")) lID = SV_TEXTEDIT;
	2741	else if ( ! stricmp( argv[0].strptr, "TEXTEDITKB")) lID = SV_TEXTEDITKB;
	2742	else if ( ! stricmp( argv[0].strptr, "TRACKRECTLEVEL")) lID = SV_TRACKRECTLEVEL;
	2743	else if ( ! stricmp( argv[0].strptr, "WARNINGDURATION")) lID = SV_WARNINGDURATION;
	2744	else if ( ! stricmp( argv[0].strptr, "WARNINGFREQ")) lID = SV_WARNINGFREQ;
	2745	}
	2746	if ( lID < 0 ) return ( 40 );
	2747
	2748	lValue = WinQuerySysValue( HWND_DESKTOP, lID );
	2749	if ( lValue == 0 ) {
	2750	/* Not elegant but probably true if the function failed. Anyway,
	2751	* we don't have a HAB so we can't really use WinGetLastError()...
	2752	*/
	2753	WriteErrorCode( PMERR_PARAMETER_OUT_OF_RANGE, "WinQuerySysValue");
	2754	SaveResultString( prsResult, PSZ_ZERO, 1 );
	2755	return ( 0 );
	2756	}
	2757
	2758	// Return the value as the REXX return string
	2759	sprintf( szResult, "%d", lValue );
	2760	SaveResultString( prsResult, szResult, strlen(szResult) );
	2761
	2762	return ( 0 );
	2763	}
	2764
	2765
[47]	2766	/* ------------------------------------------------------------------------- *
	2767	* Sys2Exec *
	2768	* *
	2769	* Wrapper to DosExecPgm. *
	2770	* *
	2771	* REXX ARGUMENTS: *
	2772	* 1. Name of executable program (REQUIRED) *
	2773	* 2. Arguments to pass to program (default "") *
	2774	* 3. Execution mode flag, one of: *
	2775	* 'W' or 'S': Wait for program to return (EXEC_SYNC) *
	2776	* 'N' or 'A': No wait (EXEC_ASYNC) *
	2777	* 'D' or 'B': Detach process (EXEC_BACKGROUND) *
	2778	* *
	2779	* REXX RETURN VALUE: *
	2780	* If EXEC_SYNC mode was requested, returns the termination status from *
	2781	* the started session. Otherwise, returns the process ID. *
	2782	* ------------------------------------------------------------------------- */
	2783	ULONG APIENTRY Sys2Exec( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
	2784	{
	2785	RESULTCODES st_RC = {0};
	2786	CHAR szLoadErr[ CCHMAXPATH ] = {0},
	2787	szTerminate[ US_INTEGER_MAXZ ];
	2788	PSZ pszProg,
	2789	pszArgs,
	2790	s;
	2791	ULONG cbArgs,
	2792	ulExec;
	2793	APIRET rc;
[40]	2794
[47]	2795	// Reset the error indicator
	2796	WriteErrorCode( 0, NULL );
	2797
	2798	// Make sure we have at least one valid argument
	2799	if (( argc < 1 ) \|\| ( !RXVALIDSTRING( argv[0]) ))
	2800	return ( 40 );
	2801
	2802	// Second argument is optional but must be a valid string if specified
	2803	if (( argc >= 2 ) && ( !RXVALIDSTRING(argv[1]) ))
	2804	return ( 40 );
	2805
	2806	// Third argument: execution mode flag
	2807	if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
	2808	strupr( argv[2].strptr );
	2809	switch ( argv[2].strptr[0] ) {
	2810	case 'N':
	2811	case 'A': ulExec = EXEC_ASYNC; break;
	2812	case 'W':
	2813	case 'S': ulExec = EXEC_SYNC; break;
	2814	case 'D':
	2815	case 'B': ulExec = EXEC_BACKGROUND; break;
	2816	default: return ( 40 );
	2817	}
	2818	}
	2819
	2820	// Build the argument strings (first arg must be the program name)
	2821	pszProg = strrchr( argv[0].strptr, '\\');
	2822	if ( pszProg == NULL )
	2823	pszProg = strrchr( argv[0].strptr, ':');
	2824	if ( pszProg == NULL )
	2825	pszProg = argv[0].strptr;
	2826	cbArgs = strlen( pszProg + 1 );
	2827	if ( argc >= 2 ) {
	2828	cbArgs += argv[1].strlength + 1;
	2829	}
	2830	pszArgs = calloc( cbArgs + 1, sizeof(char) );
	2831	if ( pszArgs == NULL ) {
	2832	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
	2833	SaveResultString( prsResult, NULL, 0 );
	2834	return ( 0 );
	2835	}
	2836
	2837	// Concatenate the program and argument strings, null-separated
	2838	// (We use 0x1A while building the string to avoid termination issues)
	2839	if ( argc >= 2 )
	2840	sprintf( pszArgs, "%s\x1A%s\x1A", pszProg, argv[1].strptr );
	2841	else
	2842	sprintf( pszArgs, "%s\x1A", pszProg );
	2843	// Now replace the 0x1A's with nulls (starting from string end)
	2844	while (( s = strrchr( pszArgs, 0x1A )) != NULL )
	2845	*s = 0;
	2846
	2847	// Launch the program
	2848	rc = DosExecPgm( szLoadErr, sizeof( szLoadErr), ulExec,
	2849	pszArgs, NULL, &st_RC, pszProg );
	2850	if ( rc != NO_ERROR ) {
	2851	WriteErrorCode( rc, "DosExecPgm");
	2852	SaveResultString( prsResult, PSZ_ZERO, 1 );
	2853	return ( 0 );
	2854	}
	2855
	2856	sprintf( szTerminate, "%u", st_RC.codeTerminate );
	2857	SaveResultString( prsResult, szTerminate, strlen(szTerminate) );
	2858	return ( 0 );
	2859	}
	2860
	2861
[4]	2862	// -------------------------------------------------------------------------
	2863	// INTERNAL FUNCTIONS
	2864	// -------------------------------------------------------------------------
	2865
	2866
	2867	/* ------------------------------------------------------------------------- *
	2868	* GetProcess *
	2869	* *
	2870	* Gets information about the specified process (if found). If pszProgram *
	2871	* is NULL, the search is done on the process ID in pulPID; otherwise, the *
	2872	* search is done on the executable name in pszProgram (which may or may not *
	2873	* include the extension). *
	2874	* *
	2875	* ARGUMENTS: *
	2876	* PSZ pszProgram : The requested executable (process name). (I) *
	2877	* PSZ pszFullName: The returned fully-qualified process name. (O) *
	2878	* PULONG pulPID : The process ID. (IO) *
	2879	* PULONG pulPPID : The returned process parent ID. (O) *
	2880	* PULONG pulType : The returned process type. (O) *
	2881	* PUSHORT pusPriority: The returned process priority. (O) *
	2882	* PULONG pulCPU : The returned process CPU time. (O) *
	2883	* *
	2884	* RETURNS: ULONG *
	2885	* 0 on success, or a non-zero API return code in the case of an error. *
	2886	* ------------------------------------------------------------------------- */
[31]	2887	// 2016-02-20 SHL Rework to avoid traps
	2888	ULONG GetProcess( PCSZ pszProgram,
[4]	2889	PSZ pszFullName,
	2890	PULONG pulPID,
	2891	PULONG pulPPID,
	2892	PULONG pulType,
	2893	PUSHORT pusPriority,
	2894	PULONG pulCPU )
	2895	{
	2896	#ifdef USE_DQPS
	2897	QSPTRREC *pBuf; // Data returned by DosQProcStatus()
	2898	#else
[31]	2899	QSPTRREC *pBuf; // Data returned by DosQuerySysState() // 2015-04-23 SHL
[4]	2900	#endif
	2901	QSPREC *pPrec; // Pointer to process information block
	2902	QSTREC *pTrec; // Pointer to thread information block
	2903	CHAR szName[ CCHMAXPATH ] = {0}, // Fully-qualified name of process
	2904	szNoExt[ CCHMAXPATH ] = {0}; // Program name without extension
[20]	2905	PPIB ppib; // pointer to current process info block
[4]	2906	PSZ pszCurrent, // Program name of a queried process
	2907	c; // Pointer to substring
	2908	ULONG ulCPU; // Process CPU time
	2909	USHORT usPriority, // Process priority class
	2910	i; // index
	2911	BOOL fMatch = FALSE; // The current process is a match?
	2912	APIRET rc; // Return code
	2913
[20]	2914	// Use current process when PID is 0 and program name is not specified
	2915	if (( pszProgram == NULL ) && ( *pulPID == 0 )) {
	2916	rc = DosGetInfoBlocks( NULL, &ppib );
	2917	if ( rc != NO_ERROR ) {
	2918	WriteErrorCode( rc, "DosGetInfoBlocks");
	2919	return ( rc );
	2920	}
	2921	*pulPID = ppib->pib_ulpid;
	2922	}
	2923
[4]	2924	#ifdef USE_DQPS
	2925	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE );
	2926	#else
[31]	2927	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE ); // 2015-04-23 SHL
[4]	2928	#endif
	2929
	2930	if ( pBuf == NULL ) {
	2931	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
	2932	return ( ERROR_NOT_ENOUGH_MEMORY );
	2933	}
	2934
	2935	#ifdef USE_DQPS
	2936	// Get running process information using DosQProcStatus()
	2937	rc = DosQProcStatus( pBuf, UL_SSBUFSIZE );
	2938	if ( rc != NO_ERROR ) {
	2939	WriteErrorCode( rc, "DosQProcStatus");
	2940	return ( rc );
	2941	}
	2942	pPrec = pBuf->pProcRec;
	2943	#else
	2944	// Get running process information using DosQuerySysState()
	2945	rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE );
	2946	if ( rc != NO_ERROR ) {
	2947	WriteErrorCode( rc, "DosQuerySysState");
[31]	2948	free( pBuf );
[4]	2949	return ( rc );
	2950	}
[31]	2951	pPrec = (QSPREC )(((QSPTRREC)pBuf) -> pProcRec); // 2015-04-23 SHL
[4]	2952	#endif
	2953
	2954	*pulPPID = 0;
	2955	*pulType = 0;
	2956	*pusPriority = 0;
	2957	*pulCPU = 0;
	2958	if ( pszProgram != NULL ) *pulPID = 0;
	2959	else if ( *pulPID == 0 ) return 0;
	2960
[31]	2961	# if 1 // 2016-02-25 SHL FIXME debug bad pointer
	2962	// 2016-02-26 SHL FIXME to be gone when sure can not occur
	2963	if ( (ULONG)pPrec < 0x10000 ) {
	2964	sprintf( szName, "rxutilex#%u pPrec 0x%x < 0x10000", __LINE__, (ULONG)pPrec );
	2965	WriteErrorCode( ERROR_INVALID_ADDRESS, szName);
	2966	free( pBuf );
	2967	return ( 0 );
	2968	}
	2969	# endif
	2970
[4]	2971	// Now look for the specified process
[31]	2972	// List ends with RecType not QS_PROCESS or pThrdRec NULL
	2973	while ( pPrec->RecType == QS_PROCESS && pPrec->pThrdRec != NULL && !fMatch ) {
[4]	2974
	2975	if ( pszProgram == NULL ) {
[31]	2976	// Match by pid
[4]	2977	if ( pPrec->pid == *pulPID ) {
	2978	fMatch = TRUE;
	2979	// Get the program name
	2980	if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
	2981	sprintf( pszFullName, "--");
	2982	else
	2983	strcpy( pszFullName, szName );
	2984
	2985	// Get the process priority
	2986	if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
	2987	usPriority = 0;
	2988
	2989	// Get the CPU time of the process by querying each of its threads
	2990	ulCPU = 0;
	2991	pTrec = pPrec->pThrdRec;
	2992	for ( i = 0; i < pPrec->cTCB; i++ ) {
	2993	ulCPU += ( pTrec->systime + pTrec->usertime );
	2994	pTrec++;
	2995	}
	2996
	2997	*pulPPID = pPrec->ppid;
	2998	*pulType = pPrec->type;
	2999	*pusPriority = usPriority;
	3000	*pulCPU = ulCPU;
	3001	}
	3002	}
	3003	else {
	3004	// Get the program name (without the path)
	3005	if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
	3006	sprintf( pszCurrent, "--");
	3007	else
	3008	pszCurrent = strrchr( szName, '\\') + 1;
	3009
	3010	// Create a copy without the extension
	3011	strcpy( szNoExt, pszCurrent );
[31]	3012	if ( ( c = strrchr( szNoExt, '.') ) != NULL )
	3013	memset( c, 0, strlen(c) );
	3014	if ( pszCurrent != NULL &&
	3015	( stricmp(pszCurrent, pszProgram) == 0 \|\| stricmp(szNoExt, pszProgram) == 0 ) )
[4]	3016	{
	3017	fMatch = TRUE;
	3018
	3019	// Get the process priority
	3020	if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
	3021	usPriority = 0;
	3022
	3023	// Get the CPU time of the process by querying each of its threads
	3024	ulCPU = 0;
	3025	pTrec = pPrec->pThrdRec;
	3026	for ( i = 0; i < pPrec->cTCB; i++ ) {
	3027	ulCPU += ( pTrec->systime + pTrec->usertime );
	3028	pTrec++;
	3029	}
	3030
	3031	*pulPID = pPrec->pid;
	3032	*pulPPID = pPrec->ppid;
	3033	*pulType = pPrec->type;
	3034	*pusPriority = usPriority;
	3035	*pulCPU = ulCPU;
	3036	strcpy( pszFullName, szName );
	3037	}
	3038	}
[31]	3039	pPrec = (QSPREC *)(pPrec->pThrdRec + pPrec->cTCB);
	3040
	3041	# if 1 // 2016-02-25 SHL FIXME debug pointer - can this occur?
	3042	// 2016-02-26 SHL FIXME to be gone when sure can not occur
	3043	if ( (ULONG)pPrec < 0x10000 ) {
	3044	sprintf( szName, "rxutilex#%u pPrec 0x%x < 0x10000", __LINE__, (ULONG)pPrec );
	3045	WriteErrorCode( ERROR_INVALID_ADDRESS, szName);
	3046	free( pBuf );
	3047	return ( 0 );
	3048	}
	3049	# endif
	3050
	3051	} // while
[4]	3052	if ( !fMatch ) *pulPID = 0;
	3053
	3054	free( pBuf );
	3055	return ( 0 );
	3056	}
	3057
	3058
[41]	3059	#ifndef LEGACY_C_LOCALE
[36]	3060
[41]	3061	/* ------------------------------------------------------------------------- *
	3062	* GetLocaleString *
	3063	* *
	3064	* Get the requested representation string for the current locale. *
	3065	* The argument is a pointer to a string which will be allocated by this *
	3066	* function. It is the caller's responsibility to free() it. *
	3067	* *
	3068	* ARGUMENTS: *
	3069	* PSZ ppszItem: Pointer to string to be allocated. (O)
	3070	* LocaleItem item: Locale item to query. (I) *
	3071	* *
	3072	* RETURNS: int *
	3073	* The ULS function return code. *
	3074	* ------------------------------------------------------------------------- */
	3075	int GetLocaleString( PSZ *ppszItem, LocaleItem item )
	3076	{
	3077	UconvObject uconv = NULL;
	3078	LocaleObject locale = NULL;
	3079	UniChar *puzSep;
	3080	int rc = 0;
	3081	int buf_size;
	3082	PSZ pszBuffer;
[36]	3083
[41]	3084	rc = UniCreateLocaleObject( UNI_MBS_STRING_POINTER, "", &locale );
	3085	if ( rc != ULS_SUCCESS ) {
	3086	WriteErrorCode( rc, "UniCreateLocaleObject");
	3087	return ( rc );
	3088	}
	3089	rc = UniQueryLocaleItem( locale, item, &puzSep );
	3090	if ( rc == ULS_SUCCESS ) {
	3091	buf_size = UniStrlen( puzSep ) * 3;
	3092	pszBuffer = (PSZ) calloc( 1, buf_size + 1 );
	3093	if ( pszBuffer ) {
	3094	if ( UniCreateUconvObject(L"", &uconv ) == ULS_SUCCESS ) {
	3095	if ( UniStrFromUcs( uconv, pszBuffer, puzSep, buf_size ))
	3096	sprintf( pszBuffer, "%ls", puzSep );
	3097	UniFreeUconvObject( uconv );
	3098	}
	3099	else
	3100	sprintf( pszBuffer, "%ls", puzSep );
	3101	*ppszItem = pszBuffer;
	3102	}
	3103	else {
	3104	rc = ERROR_NOT_ENOUGH_MEMORY;
	3105	WriteErrorCode( rc, "calloc");
	3106	}
	3107	UniFreeMem( puzSep );
	3108	}
	3109	else WriteErrorCode( rc, "UniQueryLocaleItem");
	3110
	3111	UniFreeLocaleObject( locale );
	3112	return ( rc );
	3113	}
	3114
	3115
	3116	/* ------------------------------------------------------------------------- *
	3117	* GroupNumber *
	3118	* *
	3119	* Format an unsigned number into three-digit (thousands) groups, separated *
	3120	* by the designated separator string. The output buffer must be allocated, *
	3121	* and must be large enough to hold a 64-bit integer with the added *
	3122	* separators, i.e. 20 + (separator length * 6 ). This function does not *
	3123	* perform any bounds checking, so the caller must ensure this. *
	3124	* *
	3125	* ARGUMENTS: *
	3126	* PSZ buf: The output string buffer. (IO) *
	3127	* ULONGLONG val: The number value to format. (I) *
	3128	* PSZ sep: The group-separator string. (I) *
	3129	* *
	3130	* RETURNS: N/A *
	3131	* ------------------------------------------------------------------------- */
	3132	void GroupNumber( PSZ buf, ULONGLONG val, PSZ sep )
	3133	{
	3134	if ( val < 1000 ) {
	3135	sprintf( buf, "%u", val );
	3136	return;
	3137	}
	3138	GroupNumber( buf, val / 1000, sep );
	3139	sprintf( buf+strlen(buf), "%s%03u", sep, val % 1000 );
	3140	}
	3141
	3142	#endif // #ifndef LEGACY_C_LOCALE
	3143
	3144
[33]	3145	#ifdef NO_SHARED_SOURCE
	3146
[36]	3147	/****
	3148	**** MOVED TO shfuncs.c
	3149	****/
	3150
[4]	3151	/* ------------------------------------------------------------------------- *
	3152	* SaveResultString *
	3153	* *
	3154	* Writes new string contents to the specified RXSTRING, allocating any *
[31]	3155	* additional memory that may be required. *
[4]	3156	* *
	3157	* ARGUMENTS: *
	3158	* PRXSTRING prsResult: Pointer to an existing RXSTRING for writing. *
[31]	3159	* PCH pchBytes : The string contents to write to prsResult or NULL *
	3160	* ULONG ulBytes : The number of bytes in pchBytes to write 0..N. *
[4]	3161	* *
	3162	* RETURNS: BOOL *
	3163	* TRUE if prsResult was successfully updated. FALSE otherwise. *
	3164	* ------------------------------------------------------------------------- */
[31]	3165	BOOL SaveResultString( PRXSTRING prsResult, PCSZ pchBytes, ULONG ulBytes )
[4]	3166	{
	3167	ULONG ulRC;
	3168	PCH pchNew;
	3169
[31]	3170	// 2016-02-20 SHL Rework for easier usage
	3171	if (!pchBytes)
[36]	3172	ulBytes = 0; // Sync for caller
[4]	3173	if ( ulBytes > 256 ) {
	3174	// REXX provides 256 bytes by default; allocate more if necessary
	3175	ulRC = DosAllocMem( (PVOID) &pchNew, ulBytes, PAG_WRITE \| PAG_COMMIT );
	3176	if ( ulRC != 0 ) {
	3177	WriteErrorCode( ulRC, "DosAllocMem");
[31]	3178	prsResult->strlength = 0; // 2016-02-20 SHL Force result to empty string
[4]	3179	return ( FALSE );
	3180	}
[24]	3181	// 2015-06-03 SHL dropped DosFreeMem(prsResult->strptr);
	3182	// 2015-06-03 SHL Pointer not allocated by DosAllocMem
[4]	3183	prsResult->strptr = pchNew;
	3184	}
[31]	3185	if (ulBytes)
[36]	3186	memcpy( prsResult->strptr, pchBytes, ulBytes );
[4]	3187	prsResult->strlength = ulBytes;
	3188
	3189	return ( TRUE );
	3190	}
	3191
	3192
	3193	/* ------------------------------------------------------------------------- *
	3194	* WriteStemElement *
	3195	* *
	3196	* Creates a stem element (compound variable) in the calling REXX program *
	3197	* using the REXX shared variable pool interface. *
	3198	* *
	3199	* ARGUMENTS: *
	3200	* PSZ pszStem : The name of the stem (before the '.') *
	3201	* ULONG ulIndex : The number of the stem element (after the '.') *
	3202	* PSZ pszValue : The value to write to the compound variable. *
	3203	* *
	3204	* RETURNS: BOOL *
	3205	* TRUE on success, FALSE on failure. *
	3206	* ------------------------------------------------------------------------- */
[31]	3207	// 2016-02-20 SHL
	3208	BOOL WriteStemElement( PCSZ pszStem, ULONG ulIndex, PCSZ pszValue )
[4]	3209	{
	3210	SHVBLOCK shvVar; // REXX shared variable pool block
	3211	ULONG ulRc,
	3212	ulBytes;
[24]	3213	CHAR szCompoundName[ US_COMPOUND_MAXZ ];
[4]	3214
	3215	sprintf( szCompoundName, "%s.%d", pszStem, ulIndex );
	3216	if ( pszValue == NULL ) {
[24]	3217	pszValue = "";
[4]	3218	ulBytes = 0;
	3219	} else {
[24]	3220	// 2015-06-03 SHL Was using DosAllocMem and leaking memory
	3221	// REXX API does not free this kind of buffer
[31]	3222	ulBytes = strlen(pszValue);
[29]	3223	}
[4]	3224	MAKERXSTRING( shvVar.shvname, szCompoundName, strlen(szCompoundName) );
[31]	3225	shvVar.shvvalue.strptr = (PCH)pszValue;
[4]	3226	shvVar.shvvalue.strlength = ulBytes;
	3227	shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
	3228	shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
	3229	shvVar.shvcode = RXSHV_SYSET;
	3230	shvVar.shvnext = NULL;
	3231	ulRc = RexxVariablePool( &shvVar );
	3232	if ( ulRc > 1 ) {
	3233	WriteErrorCode( shvVar.shvret, "RexxVariablePool (SHVBLOCK.shvret)");
	3234	return FALSE;
	3235	}
	3236	return TRUE;
	3237
	3238	}
	3239
	3240
	3241	/* ------------------------------------------------------------------------- *
	3242	* WriteErrorCode *
	3243	* *
	3244	* Writes an error code to a special variable in the calling REXX program *
	3245	* using the REXX shared variable pool interface. This is used to return *
	3246	* API error codes to the REXX program, since the REXX functions themselves *
	3247	* normally return string values. *
	3248	* *
	3249	* ARGUMENTS: *
	3250	* ULONG ulError : The error code returned by the failing API call. *
	3251	* PSZ pszContext: A string describing the API call that failed. *
	3252	* *
	3253	* RETURNS: N/A *
	3254	* ------------------------------------------------------------------------- */
[31]	3255	void WriteErrorCode( ULONG ulError, PCSZ pszContext )
[4]	3256	{
	3257	SHVBLOCK shvVar; // REXX shared variable pool block
	3258	ULONG ulRc;
	3259	CHAR szErrorText[ US_ERRSTR_MAXZ ];
	3260
	3261	if ( pszContext == NULL )
[17]	3262	sprintf( szErrorText, "%u", ulError );
[4]	3263	else
[17]	3264	sprintf( szErrorText, "%u: %s", ulError, pszContext );
[4]	3265	MAKERXSTRING( shvVar.shvname, SZ_ERROR_NAME, strlen(SZ_ERROR_NAME) );
[31]	3266	MAKERXSTRING( shvVar.shvvalue, szErrorText, strlen(szErrorText) );
[4]	3267	shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
	3268	shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
	3269	shvVar.shvcode = RXSHV_SYSET;
	3270	shvVar.shvnext = NULL;
[31]	3271	shvVar.shvret = 0; // 2016-02-26 SHL
[4]	3272	ulRc = RexxVariablePool( &shvVar );
[31]	3273	// 2016-02-26 SHL Correct if
	3274	if ( ulRc & ~RXSHV_NEWV )
	3275	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
[4]	3276	}
	3277
[41]	3278	#endif // #ifdef NO_SHARED_SOURCE
[36]	3279

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: rxutilex/trunk/rxutilex.c@ 48

Download in other formats: