Context Navigation

source: rxutilex/trunk/rxutilex.c@ 18

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

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

Download in other formats: