Context Navigation

source: rxutilex/trunk/rxutilex.c@ 47

Last change on this file since 47 was 47, checked in by Alex Taylor, 6 years ago
Add Sys2Exec function (DosExecPgm wrapper)
File size: 146.3 KB

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

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

Download in other formats: