Context Navigation

source: rxutilex/trunk/rxutilex.c@ 30

Last change on this file since 30 was 30, checked in by Alex Taylor, 10 years ago
Applied updates (from SHL) to improve stability of process listing.
File size: 110.4 KB

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

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

Download in other formats: