Context Navigation

source: rxutilex/trunk/rxutilex.c@ 40

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

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

Download in other formats: