Context Navigation

source: rxutilex/trunk/rxutilex.c@ 41

Last change on this file since 41 was 41, checked in by Alex Taylor, 7 years ago
Rewrote Sys2FormatNumber to support LONGLONG and use current locale info from ULS API
File size: 141.0 KB

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

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

Download in other formats: