Context Navigation

source: rxutilex/trunk/rxutilex.c@ 31

Last change on this file since 31 was 31, checked in by Alex Taylor, 9 years ago
Fixes to return string handling plus workaround for unexpected DosQuerySysState return data (from SHL).
File size: 116.1 KB

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

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

Download in other formats: