Context Navigation

source: rxutilex/trunk/rxutilex.c@ 21

Last change on this file since 21 was 21, checked in by Alex Taylor, 11 years ago
Implemented Sys2FormatNumber() function.
File size: 99.7 KB

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

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

Download in other formats: