Context Navigation

rxutilex.c@ 48

Last change on this file since 48 was 48, checked in by Alex Taylor, 6 years ago
Add Sys2SetSize
File size: 148.2 KB

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

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

Context Navigation

source: rxutilex/trunk/rxutilex.c@ 48

Download in other formats: