Context Navigation

source: rxutilex/trunk/rxutilex.c@ 40

Last change on this file since 40 was 40, checked in by Alex Taylor, 7 years ago
Add Sys2QuerySysValue function
File size: 136.7 KB

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

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

Download in other formats: