Context Navigation

source: rxutilex/trunk/rxutilex.c@ 30

Last change on this file since 30 was 30, checked in by Alex Taylor, 10 years ago
Applied updates (from SHL) to improve stability of process listing.
File size: 110.4 KB

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

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

Download in other formats: