Context Navigation

source: rxutilex/trunk/rxutilex.c@ 33

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

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

Download in other formats: