Context Navigation

source: rxutilex/trunk/rxutilex.c@ 26

Last change on this file since 26 was 26, checked in by Alex Taylor, 10 years ago
Sys2ConnectNamedPipe now returns 1 on success when pipe is in NOWAIT mode.
File size: 107.2 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.2" // 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 sSHL
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	#ifdef USE_DQPS
655	QSPTRREC *pBuf; // Data returned by DosQProcStatus()
656	#else
657	QSPTRREC *pBuf; // Data returned by DosQuerySysState() // 2015-04-23 SHL
658	#endif
659	QSPREC *pPrec; // Pointer to process information block
660	QSTREC *pTrec; // Pointer to thread information block
661	CHAR szStem[ US_STEM_MAXZ ], // Buffers used for building strings ...
662	szNumber[ US_INTEGER_MAXZ ], // ...
663	szName[ CCHMAXPATH ], // Fully-qualified name of process
664	szPInfo[ US_PIDSTR_MAXZ ]; // Stem item string
665	ULONG ulCount, // Number of processes
666	ulCPU; // Process CPU time
667	USHORT usPriority, // Process priority class
668	i; // Loop counter
669	APIRET rc; // Return code
670
671
672	// Reset the error indicator
673	WriteErrorCode( 0, NULL );
674
675	// Do some validity checking on the arguments
676	if (( argc != 1 ) \|\| // Make sure we have exactly one argument...
677	( ! RXVALIDSTRING(argv[0]) ) \|\| // ...which is a valid REXX string...
678	( RXSTRLEN(argv[0]) > US_STEM_MAXZ )) // ...and isn't too long.
679	return ( 40 );
680
681	// Generate the stem variable name from the argument (stripping any final dot)
682	if ( argv[0].strptr[ argv[0].strlength-1 ] == '.') argv[0].strlength--;
683	strncpy( szStem, argv[0].strptr, RXSTRLEN(argv[0]) );
684	szStem[ RXSTRLEN(argv[0]) ] = '\0';
685
686	#ifdef USE_DQPS
687	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE );
688	#else
689	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE ); // 2015-04-23 SHL
690	#endif
691
692	if ( pBuf == NULL ) {
693	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
694	MAKERXSTRING( *prsResult, "", 0 );
695	return ( 0 );
696	}
697
698	#ifdef USE_DQPS
699	// Get running process information using DosQProcStatus()
700	rc = DosQProcStatus( pBuf, UL_SSBUFSIZE );
701	if ( rc != NO_ERROR ) {
702	WriteErrorCode( rc, "DosQProcStatus");
703	MAKERXSTRING( *prsResult, "", 0 );
704	return ( 0 );
705	}
706	pPrec = pBuf->pProcRec; // 2015-04-23 SHL
707	#else
708	// Get running process information using DosQuerySysState()
709	rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE );
710	if ( rc != NO_ERROR ) {
711	WriteErrorCode( rc, "DosQuerySysState");
712	MAKERXSTRING( *prsResult, "", 0 );
713	return ( 0 );
714	}
715	pPrec = pBuf->pProcRec;
716	#endif
717
718	// Now get the list of processes
719	ulCount = 0;
720	while ( pPrec->RecType == 1 ) {
721	ulCount++;
722
723	// Get the program name of each process (including path)
724	if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
725	sprintf( szName, "--");
726	if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
727	usPriority = 0;
728
729	// Get the CPU time of the process by querying each of its threads
730	ulCPU = 0;
731	pTrec = pPrec->pThrdRec;
732	for ( i = 0; i < pPrec->cTCB; i++ ) {
733	ulCPU += ( pTrec->systime + pTrec->usertime );
734	pTrec++;
735	}
736
737	// Now generate the stem item with all of this information
738	sprintf( szPInfo, "%u %u %u %04X %02u:%02u.%02u %s",
739	pPrec->pid, // PID
740	pPrec->ppid, // Parent PID
741	pPrec->type, // Process type
742	usPriority, // Priority class
743	TIME_SECONDS( ulCPU ) / 60, // CPU time (hours)
744	TIME_SECONDS( ulCPU ) % 60, // CPU time (minutes)
745	TIME_HUNDREDTHS( ulCPU ), // CPU time (seconds)
746	szName ); // Executable name & path
747	WriteStemElement( szStem, ulCount, szPInfo );
748
749	pPrec = (QSPREC ) ( (PBYTE) (pPrec->pThrdRec) + ( pPrec->cTCB sizeof(QSTREC) ) );
750	}
751
752	// Create the "0" stem element with the number of processes found
753	sprintf( szNumber, "%d", ulCount );
754	WriteStemElement( szStem, 0, szNumber );
755
756	// And also return the number of processes as the REXX return string
757	MAKERXSTRING( *prsResult, szNumber, strlen(szNumber) );
758
759	free( pBuf );
760	return ( 0 );
761	}
762
763
764	/* ------------------------------------------------------------------------- *
765	* Sys2QueryPhysicalMemory *
766	* *
767	* Queries the amount of physical memory (RAM) installed in the system. *
768	* *
769	* REXX ARGUMENTS: None *
770	* *
771	* REXX RETURN VALUE: *
772	* Integer representing the amount of installed memory, in KiB, or 0 if an *
773	* error occurred. *
774	* ------------------------------------------------------------------------- */
775	ULONG APIENTRY Sys2QueryPhysicalMemory( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
776	{
777	CHAR szMemSize[ US_INTEGER_MAXZ ];
778	ULONG ulMemBytes = 0,
779	ulMemKBytes = 0;
780	APIRET rc = 0;
781
782	// Reset the error indicator
783	WriteErrorCode( 0, NULL );
784
785	// Make sure we have no arguments
786	if ( argc > 0 ) return ( 40 );
787
788	// Query installed memory in bytes
789	rc = DosQuerySysInfo( QSV_TOTPHYSMEM, QSV_TOTPHYSMEM,
790	&ulMemBytes, sizeof(ulMemBytes) );
791	if ( rc != NO_ERROR ) {
792	WriteErrorCode( rc, "DosQuerySysInfo");
793	MAKERXSTRING( *prsResult, "0", 1 );
794	return ( 0 );
795	}
796
797	// Convert to binary kilobytes (any remainder is discarded)
798	ulMemKBytes = ulMemBytes / 1024;
799	sprintf( szMemSize, "%u", ulMemKBytes );
800
801	// Return the memory size as the REXX return string
802	MAKERXSTRING( *prsResult, szMemSize, strlen(szMemSize) );
803
804	return ( 0 );
805	}
806
807
808	/* ------------------------------------------------------------------------- *
809	* Sys2QueryForegroundProcess *
810	* *
811	* Queries the PID of the current foreground process. *
812	* *
813	* REXX ARGUMENTS: None *
814	* *
815	* REXX RETURN VALUE: *
816	* Integer representing the process ID (in decimal), or 0 if an error *
817	* occurred. *
818	* ------------------------------------------------------------------------- */
819	ULONG APIENTRY Sys2QueryForegroundProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
820	{
821	CHAR szPID[ US_INTEGER_MAXZ ];
822	ULONG ulPID = 0;
823	APIRET rc = 0;
824
825	// Reset the error indicator
826	WriteErrorCode( 0, NULL );
827
828	// Make sure we have no arguments
829	if ( argc > 0 ) return ( 40 );
830
831	// Query installed memory in bytes
832	rc = DosQuerySysInfo( QSV_FOREGROUND_PROCESS,
833	QSV_FOREGROUND_PROCESS,
834	&ulPID, sizeof(ulPID) );
835	if ( rc != NO_ERROR ) {
836	WriteErrorCode( rc, "DosQuerySysInfo");
837	MAKERXSTRING( *prsResult, "0", 1 );
838	return ( 0 );
839	}
840	sprintf( szPID, "%u", ulPID );
841
842	// Return the PID as the REXX return string
843	MAKERXSTRING( *prsResult, szPID, strlen(szPID) );
844
845	return ( 0 );
846	}
847
848
849	/* ------------------------------------------------------------------------- *
850	* Sys2ReplaceModule *
851	* *
852	* Unlocks and optionally replaces an in-use (locked) DLL or EXE. *
853	* *
854	* REXX ARGUMENTS: *
855	* 1. The filespec of the module to be replaced. (REQUIRED) *
856	* 2. The filespec of the new module to replace it with. (DEFAULT: none) *
857	* 3. The filespec of the backup file to be created. (DEFAULT: none) *
858	* *
859	* REXX RETURN VALUE: *
860	* 1 on success, or 0 if an error occurred. *
861	* ------------------------------------------------------------------------- */
862	ULONG APIENTRY Sys2ReplaceModule( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
863	{
864	PSZ pszOldModule = NULL,
865	pszNewModule = NULL,
866	pszBackup = NULL;
867	APIRET rc = 0;
868
869	// Reset the error indicator
870	WriteErrorCode( 0, NULL );
871
872	// Make sure we have at least one valid argument (the module name)
873	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
874	pszOldModule = calloc( argv[0].strlength + 1, sizeof(UCHAR) );
875	if ( pszOldModule == NULL ) {
876	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
877	MAKERXSTRING( *prsResult, "0", 1 );
878	return ( 0 );
879	}
880	strncpy( pszOldModule, argv[0].strptr, argv[0].strlength );
881
882	// Second argument: new module name (optional, but must be correct if specified)
883	if ( argc >= 2 ) {
884	if ( RXVALIDSTRING(argv[1]) ) {
885	pszNewModule = calloc( argv[1].strlength + 1, sizeof(char) );
886	if ( pszNewModule == NULL ) {
887	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
888	MAKERXSTRING( *prsResult, "0", 1 );
889	return ( 0 );
890	}
891	strncpy( pszNewModule, argv[1].strptr, argv[1].strlength );
892	} else return ( 40 );
893	}
894
895	// Third argument: backup filename (optional, but must be correct if specified)
896	if ( argc >= 3 ) {
897	if ( RXVALIDSTRING(argv[2]) ) {
898	pszBackup = calloc( argv[2].strlength + 1, sizeof(char) );
899	if ( pszBackup == NULL ) {
900	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
901	MAKERXSTRING( *prsResult, "0", 1 );
902	return ( 0 );
903	}
904	strncpy( pszBackup, argv[2].strptr, argv[2].strlength );
905	} else return ( 40 );
906	}
907
908	// Now replace the module using DosReplaceModule
909	rc = DosReplaceModule( pszOldModule, pszNewModule, pszBackup );
910	if ( rc != NO_ERROR ) {
911	WriteErrorCode( rc, "DosReplaceModule");
912	MAKERXSTRING( *prsResult, "0", 1 );
913	return ( 0 );
914	}
915
916	// Return 1 on success
917	MAKERXSTRING( *prsResult, "1", 1 );
918
919	return ( 0 );
920	}
921
922
923	/* ------------------------------------------------------------------------- *
924	* Sys2FormatNumber *
925	* *
926	* Format a number using locale-specific thousands separators. The input *
927	* number may be a positive or negative integer or floating point value. It *
928	* must not contain any separators already, and any decimal point which it *
929	* contains must be a period (rather than any localized decimal symbol). *
930	* *
931	* REXX ARGUMENTS: *
932	* 1. Number to be formatted. (REQUIRED) *
933	* 2. Number of decimal places to use for floating point *
934	* values. Ignored for integer values. (DEFAULT: 2) *
935	* *
936	* REXX RETURN VALUE: The formatted number, or '' on error. *
937	* ------------------------------------------------------------------------- */
938	ULONG APIENTRY Sys2FormatNumber( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
939	{
940	CHAR achNumber[ US_NUMSTR_MAXZ ]; // Formatted output string
941	float fVal; // Input value as floating point
942	int iVal; // Input value as integer
943	int iPrec; // Requested decimal precision
944	PSZ pszSep = NULL; // Separator string
945	#ifndef LEGACY_C_LOCALE
946	CHAR achTemp[ US_NUMSTR_MAXZ ]; // Temporary buffer
947	LocaleObject locale = NULL; // ULS locale object
948	struct UniLconv *punilc = NULL; // ULS locale conventions structure
949	CHAR *p = NULL; // Moving pointers within buffers
950	CHAR *q = NULL; // ...
951	int rc = 0;
952	#endif
953
954	// Make sure we have at least one valid argument (the input number)
955	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
956
957	#ifdef LEGACY_C_LOCALE
958
959	// Use the locale settings from the environment
960	pszSep = nl_langinfo( THOUSEP );
961	if ( !pszSep \|\| !strlen(pszSep) ) {
962	/* If the current locale isn't known to the C runtime, use a common
963	* known locale for the same language, if possible.
964	*/
965	PSZ pszLang, p;
966	if (( DosScanEnv("LANG", &pszLang ) == NO_ERROR ) &&
967	pszLang && ( strlen( pszLang ) >= 2 ))
968	{
969	p = strdup( pszLang );
970	if ( !strnicmp( p, "en_us", 2 )) setlocale( LC_NUMERIC, "EN_US");
971	else if ( !strnicmp( p, "en_uk", 2 )) setlocale( LC_NUMERIC, "EN_GB");
972	else if ( !strnicmp( p, "de", 2 )) setlocale( LC_NUMERIC, "DE_DE");
973	else if ( !strnicmp( p, "es", 2 )) setlocale( LC_NUMERIC, "ES_ES");
974	else if ( !strnicmp( p, "fr", 2 )) setlocale( LC_NUMERIC, "FR_FR");
975	else if ( !strnicmp( p, "it", 2 )) setlocale( LC_NUMERIC, "IT_IT");
976	else if ( !strnicmp( p, "ja", 2 )) setlocale( LC_NUMERIC, "JA_JP");
977	/*
978	else if ( !strnicmp( p, "ar", 2 )) setlocale( LC_NUMERIC, "ar_AA");
979	else if ( !strnicmp( p, "be", 2 )) setlocale( LC_NUMERIC, "be_BY");
980	else if ( !strnicmp( p, "bg", 2 )) setlocale( LC_NUMERIC, "bg_BG");
981	else if ( !strnicmp( p, "be", 2 )) setlocale( LC_NUMERIC, "be_BY");
982	else if ( !strnicmp( p, "ca", 2 )) setlocale( LC_NUMERIC, "ca_ES");
983	else if ( !strnicmp( p, "cs", 2 )) setlocale( LC_NUMERIC, "cs_CZ");
984	else if ( !strnicmp( p, "da", 2 )) setlocale( LC_NUMERIC, "da_DK");
985	else if ( !strnicmp( p, "de", 2 )) setlocale( LC_NUMERIC, "de_DE");
986	else if ( !strnicmp( p, "el", 2 )) setlocale( LC_NUMERIC, "el_GR");
987	else if ( !strnicmp( p, "es", 2 )) setlocale( LC_NUMERIC, "es_ES");
988	else if ( !strnicmp( p, "fi", 2 )) setlocale( LC_NUMERIC, "fi_FI");
989	else if ( !strnicmp( p, "fr", 2 )) setlocale( LC_NUMERIC, "fr_FR");
990	else if ( !strnicmp( p, "hr", 2 )) setlocale( LC_NUMERIC, "hr_HR");
991	else if ( !strnicmp( p, "hu", 2 )) setlocale( LC_NUMERIC, "hu_HU");
992	else if ( !strnicmp( p, "is", 2 )) setlocale( LC_NUMERIC, "is_IS");
993	else if ( !strnicmp( p, "it", 2 )) setlocale( LC_NUMERIC, "it_IT");
994	else if ( !strnicmp( p, "iw", 2 )) setlocale( LC_NUMERIC, "iw_IL");
995	else if ( !strnicmp( p, "ja", 2 )) setlocale( LC_NUMERIC, "ja_JP");
996	else if ( !strnicmp( p, "ko", 2 )) setlocale( LC_NUMERIC, "ko_KR");
997	else if ( !strnicmp( p, "mk", 2 )) setlocale( LC_NUMERIC, "mk_MK");
998	else if ( !strnicmp( p, "nl", 2 )) setlocale( LC_NUMERIC, "nl_NL");
999	else if ( !strnicmp( p, "no", 2 )) setlocale( LC_NUMERIC, "no_NO");
1000	else if ( !strnicmp( p, "pl", 2 )) setlocale( LC_NUMERIC, "pl_PL");
1001	else if ( !strnicmp( p, "pt", 2 )) setlocale( LC_NUMERIC, "pt_PT");
1002	else if ( !strnicmp( p, "ro", 2 )) setlocale( LC_NUMERIC, "ro_RO");
1003	else if ( !strnicmp( p, "ru", 2 )) setlocale( LC_NUMERIC, "ru_RU");
1004	else if ( !strnicmp( p, "sh", 2 )) setlocale( LC_NUMERIC, "sh_SP");
1005	else if ( !strnicmp( p, "sk", 2 )) setlocale( LC_NUMERIC, "sk_SK");
1006	else if ( !strnicmp( p, "sl", 2 )) setlocale( LC_NUMERIC, "sl_SI");
1007	else if ( !strnicmp( p, "sq", 2 )) setlocale( LC_NUMERIC, "sq_AL");
1008	else if ( !strnicmp( p, "sv", 2 )) setlocale( LC_NUMERIC, "sv_SE");
1009	else if ( !strnicmp( p, "th", 2 )) setlocale( LC_NUMERIC, "th_TH");
1010	else if ( !strnicmp( p, "tr", 2 )) setlocale( LC_NUMERIC, "tr_TR");
1011	else if ( !strnicmp( p, "uk", 2 )) setlocale( LC_NUMERIC, "uk_UA");
1012	else if ( !strnicmp( p, "zh", 2 )) setlocale( LC_NUMERIC, "zh_TW");
1013	*/
1014	else setlocale( LC_NUMERIC, "EN_US");
1015	free(p);
1016	}
1017	else setlocale( LC_NUMERIC, "en_us");
1018	}
1019	else setlocale( LC_NUMERIC, "");
1020
1021	// Check for a decimal place and treat as float or integer accordingly
1022	if ( strchr( argv[0].strptr, '.') != NULL ) {
1023	if (( sscanf( argv[0].strptr, "%f", &fVal )) != 1 ) return ( 40 );
1024	if ( argc >= 2 && ( RXVALIDSTRING(argv[1]) ) &&
1025	(( sscanf( argv[1].strptr, "%d", &iPrec )) == 1 ))
1026	{
1027	// Use user-specified precision
1028	sprintf( achNumber, "%'.*f", iPrec, fVal );
1029	}
1030	else
1031	sprintf( achNumber, "%'.2f", fVal );
1032	}
1033	else {
1034	if (( sscanf( argv[0].strptr, "%d", &iVal )) != 1 ) return ( 40 );
1035	sprintf( achNumber, "%'d", iVal );
1036	}
1037
1038	#else
1039	rc = UniCreateLocaleObject( UNI_MBS_STRING_POINTER, "", &locale );
1040	if ( rc != ULS_SUCCESS ) {
1041	WriteErrorCode( rc, "UniCreateLocaleObject");
1042	MAKERXSTRING( *prsResult, "", 0 );
1043	return ( 0 );
1044	}
1045	rc = UniQueryLocaleInfo(locale_object, &puni_lconv);
1046	if ( rc != ULS_SUCCESS ) {
1047	WriteErrorCode( rc, "UniQueryLocaleInfo");
1048	MAKERXSTRING( *prsResult, "", 0 );
1049	return ( 0 );
1050	}
1051
1052	// Check for a decimal place and treat as float or integer accordingly
1053	if ( strchr( argv[0].strptr, '.') != NULL ) {
1054	if (( sscanf( argv[0].strptr, "%f", &fVal )) != 1 ) return ( 40 );
1055	if ( argc >= 2 && ( RXVALIDSTRING(argv[1]) ) &&
1056	(( sscanf( argv[1].strptr, "%d", &iPrec )) == 1 ))
1057	{
1058	// Use user-specified precision
1059	sprintf( achNumber, "%.*f", iPrec, fVal );
1060	}
1061	else
1062	sprintf( achNumber, "%.2f", fVal );
1063	}
1064	else {
1065	if (( sscanf( argv[0].strptr, "%d", &iVal )) != 1 ) return ( 40 );
1066	sprintf( achNumber, "%d", iVal );
1067	}
1068
1069	#endif
1070
1071	// Return the formatted number
1072	MAKERXSTRING( *prsResult, achNumber, strlen( achNumber ));
1073
1074	return ( 0 );
1075	}
1076
1077
1078	/* ------------------------------------------------------------------------- *
1079	* Sys2FormatTime *
1080	* *
1081	* Convert a number of seconds from the epoch (1970-01-01 0:00:00 UTC) into *
1082	* a formatted date and time string. *
1083	* *
1084	* REXX ARGUMENTS: *
1085	* 1. Number of seconds (a positive integer) to be converted. (REQUIRED) *
1086	* 2. Format type, one of: *
1087	* D = return in the form 'yyyy-mm-dd hh:mm:ss (w)' where w *
1088	* represents the weekday (0-6 where 0=Sunday) (DEFAULT) *
1089	* I = return in ISO8601 combined form 'yyyy-mm-ddThh:mm:ss[Z]' *
1090	* L = return in the form 'day month year (weekday) time' where month *
1091	* and weekday are language-dependent abbreviations *
1092	* Note: With D and I, time is returned in 24-hour format; L may vary. *
1093	* 3. TZ conversion flag (indicates whether to convert to UTC from local *
1094	* time), one of: *
1095	* U = return in Coordinated Universal Time *
1096	* L = convert to local time using the current TZ (DEFAULT) *
1097	* *
1098	* REXX RETURN VALUE: The formatted time string, or '' on error. *
1099	* ------------------------------------------------------------------------- */
1100	ULONG APIENTRY Sys2FormatTime( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1101	{
1102	UCHAR szFormat[ US_TIMESTR_MAXZ ] = {0}, // strftime() format specifier
1103	szTime[ US_TIMESTR_MAXZ ] = {0}; // Formatted time string
1104	BYTE flFormat = FL_TIME_DEFAULT; // Time format flag
1105	BOOL fUTC = FALSE; // UTC/local conversion flag
1106	PSZ pszTZ, // Pointer to TZ environment var
1107	pszSetTZ;
1108	int iEpoch; // Input epoch time
1109	time_t ttSeconds; // Input timestamp (seconds)
1110	struct tm *timeptr; // Timestamp structure
1111	size_t stRC; // return code from strftime()
1112
1113	// Reset the error indicator
1114	WriteErrorCode( 0, NULL );
1115
1116	// All arguments are optional but must be correct if specified
1117
1118	if ( argc >= 1 && RXVALIDSTRING(argv[0]) ) {
1119	// first argument: epoch time value
1120	if (( sscanf( argv[0].strptr, "%d", &iEpoch )) != 1 ) return ( 40 );
1121	ttSeconds = (time_t) iEpoch;
1122	}
1123
1124	if ( argc >= 2 ) {
1125	// second argument: format flag
1126	if ( RXVALIDSTRING(argv[1]) ) {
1127	strupr( argv[1].strptr );
1128	if ( strcspn(argv[1].strptr, "DIL") > 0 ) return ( 40 );
1129	switch ( argv[1].strptr[0] ) {
1130	case 'I': flFormat = FL_TIME_ISO8601; break;
1131	case 'L': flFormat = FL_TIME_LOCALE; break;
1132	default : flFormat = FL_TIME_DEFAULT; break;
1133	}
1134	}
1135	}
1136
1137	if ( argc >= 3 ) {
1138	// third argument: conversion flag
1139	if ( RXVALIDSTRING(argv[2]) ) {
1140	strupr( argv[2].strptr );
1141	if ( strcspn(argv[2].strptr, "UL") > 0 ) return ( 40 );
1142	switch ( argv[2].strptr[0] ) {
1143	case 'U': fUTC = TRUE; break;
1144	default : fUTC = FALSE; break;
1145	}
1146	}
1147	}
1148
1149	/* These next 4 lines really shouldn't be necessary, but without them
1150	* getenv() and (apparently) tzset() may see the value of TZ as NULL
1151	* if the environment variable was changed in the REXX script.
1152	*/
1153	DosScanEnv("TZ", &pszTZ );
1154	pszSetTZ = (PSZ) malloc( strlen( pszTZ ) + 5 );
1155	if ( pszSetTZ ) {
1156	sprintf( pszSetTZ, "TZ=%s", pszTZ );
1157	putenv( pszSetTZ );
1158	}
1159
1160	// Use the locale and timezone settings from the environment
1161	tzset();
1162	setlocale( LC_TIME, "");
1163
1164	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) {
1165	ttSeconds = time( NULL );
1166	if ( ttSeconds == -1 ) {
1167	WriteErrorCode( ttSeconds, "time");
1168	MAKERXSTRING( *prsResult, "", 0 );
1169	if ( pszSetTZ ) free( pszSetTZ );
1170	return 0;
1171	}
1172	}
1173
1174	if ( fUTC ) {
1175	timeptr = gmtime( &ttSeconds );
1176	if ( !timeptr ) {
1177	WriteErrorCode( 1, "gmtime");
1178	MAKERXSTRING( *prsResult, "0", 1 );
1179	if ( pszSetTZ ) free( pszSetTZ );
1180	return 0;
1181	}
1182	}
1183	else {
1184	timeptr = localtime( &ttSeconds );
1185	if ( !timeptr ) {
1186	WriteErrorCode( 1, "localtime");
1187	MAKERXSTRING( *prsResult, "0", 1 );
1188	if ( pszSetTZ ) free( pszSetTZ );
1189	return 0;
1190	}
1191	}
1192
1193	switch ( flFormat ) {
1194	default:
1195	case FL_TIME_DEFAULT:
1196	sprintf( szFormat, "%%Y-%%m-%%d %%T (%%w)");
1197	break;
1198
1199	case FL_TIME_ISO8601:
1200	sprintf( szFormat, "%%Y-%%m-%%dT%%T");
1201	if ( fUTC ) strcat( szFormat, "Z");
1202	break;
1203
1204	case FL_TIME_LOCALE:
1205	sprintf( szFormat, "%%e %%b %%Y (%%a) %%X");
1206	break;
1207	}
1208
1209	stRC = strftime( szTime, US_TIMESTR_MAXZ-1, szFormat, timeptr );
1210	if ( stRC == NO_ERROR ) {
1211	WriteErrorCode( stRC, "strftime");
1212	MAKERXSTRING( *prsResult, "", 0 );
1213	if ( pszSetTZ ) free( pszSetTZ );
1214	return ( 0 );
1215	}
1216
1217	// Return the formatted time string
1218	MAKERXSTRING( *prsResult, szTime, strlen(szTime) );
1219
1220	if ( pszSetTZ ) free( pszSetTZ );
1221	return ( 0 );
1222	}
1223
1224
1225	/* ------------------------------------------------------------------------- *
1226	* Sys2GetEpochTime *
1227	* *
1228	* Convert formatted date and time into a number of seconds (UTC) from the *
1229	* epoch (defined as 1970-01-01 0:00:00). The input time is assumed to *
1230	* refer to the current timezone as defined in the TZ environment variable. *
1231	* *
1232	* If no parameters are specified, the current system time is used. If at *
1233	* least one parameter is specified, then any missing parameter is assumed *
1234	* to be its minimum possible value. *
1235	* *
1236	* Due to limitations in time_t, dates later than 2037 are not supported; *
1237	* the IBM library seems to convert them all to January 1 1970 00:00:00 UTC. *
1238	* *
1239	* REXX ARGUMENTS: *
1240	* 1. The year (0-99 or 1970+) (value <70 is assumed to be 20xx) *
1241	* 2. The month (1-12) *
1242	* 3. The day (1-31) *
1243	* 4. Hours (0-23) *
1244	* 5. Minutes (0-59) *
1245	* 6. Seconds (0-61) *
1246	* *
1247	* REXX RETURN VALUE: The number of seconds since the epoch, or 0 on error. *
1248	* ------------------------------------------------------------------------- */
1249	ULONG APIENTRY Sys2GetEpochTime( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1250	{
1251	ULONG ulYear = 1970, // Input year
1252	ulMonth = 1, // Input month
1253	ulDay = 1, // Input day
1254	ulHour = 0, // Input hours
1255	ulMin = 0, // Input minutes
1256	ulSec = 0; // Input seconds
1257	BOOL fYear = FALSE, // Year parameter specified?
1258	fMonth = FALSE, // Month parameter specified?
1259	fDay = FALSE, // Day parameter specified?
1260	fHour = FALSE, // Hours parameter specified?
1261	fMin = FALSE, // Minutes parameter specified?
1262	fSec = FALSE; // Seconds parameter specified?
1263	//SHORT sDST = 0; // Input time is DST?
1264	time_t timeval; // Calculated epoch time
1265	struct tm tsTime = {0}; // Time structure for mktime()
1266	UCHAR szEpochTime[ US_INTEGER_MAXZ ]; // Output string
1267	PSZ pszTZ,
1268	pszSetTZ;
1269
1270
1271	// Reset the error indicator
1272	WriteErrorCode( 0, NULL );
1273
1274	// Parse the various time items
1275	if ( argc >= 1 && RXVALIDSTRING(argv[0]) ) {
1276	if (( sscanf( argv[0].strptr, "%u", &ulYear )) != 1 ) return ( 40 );
1277	if ( ulYear < 100 ) {
1278	ulYear += (ulYear < 70) ? 2000 : 1900;
1279	}
1280	if ( ulYear < 1970 ) return ( 40 );
1281	fYear = TRUE;
1282	}
1283	if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
1284	if (( sscanf( argv[1].strptr, "%u", &ulMonth )) != 1 ) return ( 40 );
1285	if ( ulMonth < 1 \|\| ulMonth > 12 ) return ( 40 );
1286	fMonth = TRUE;
1287	}
1288	if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
1289	if (( sscanf( argv[2].strptr, "%u", &ulDay )) != 1 ) return ( 40 );
1290	if ( ulDay < 1 \|\| ulDay > 31 ) return ( 40 );
1291	fDay = TRUE;
1292	}
1293	if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
1294	if (( sscanf( argv[3].strptr, "%u", &ulHour )) != 1 ) return ( 40 );
1295	if ( ulHour > 23 ) return ( 40 );
1296	fHour = TRUE;
1297	}
1298	if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
1299	if (( sscanf( argv[4].strptr, "%u", &ulMin )) != 1 ) return ( 40 );
1300	if ( ulMin > 59 ) return ( 40 );
1301	fMin = TRUE;
1302	}
1303	if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
1304	if (( sscanf( argv[5].strptr, "%u", &ulSec )) != 1 ) return ( 40 );
1305	if ( ulSec > 61 ) return ( 40 );
1306	fSec = TRUE;
1307	}
1308	if ( argc >= 7 ) return ( 40 );
1309	/*
1310	// Parse the conversion flag
1311	if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
1312	strupr( argv[6].strptr );
1313	if ( strcspn(argv[6].strptr, "SD") > 0 ) return ( 40 );
1314	switch ( argv[6].strptr[0] ) {
1315	case 'S': sDST = 0; break;
1316	case 'D': sDST = 1; break;
1317	default : sDST = -1; break;
1318	}
1319	}
1320	*/
1321
1322	/* These next 4 lines really shouldn't be necessary, but without them
1323	* getenv() and (apparently) tzset() may see the value of TZ as NULL
1324	* if the environment variable was changed in the REXX script.
1325	*/
1326	DosScanEnv("TZ", &pszTZ );
1327	pszSetTZ = (PSZ) malloc( strlen( pszTZ ) + 5 );
1328	sprintf( pszSetTZ, "TZ=%s", pszTZ );
1329	putenv( pszSetTZ );
1330
1331	// This seems to conflict with time() under some shells -AT
1332	tzset();
1333
1334	// Use the locale settings from the environment
1335	setlocale( LC_TIME, "");
1336
1337	if ( !fYear && !fMonth && !fDay && !fHour && !fMin && !fSec ) {
1338	timeval = time( NULL );
1339	if ( timeval == -1 ) {
1340	WriteErrorCode( timeval, "time");
1341	MAKERXSTRING( *prsResult, "0", 1 );
1342	free( pszSetTZ );
1343	return 0;
1344	}
1345	}
1346	else {
1347	//printf("TZ=%s\n", getenv("TZ"));
1348	tsTime.tm_sec = ulSec;
1349	tsTime.tm_min = ulMin;
1350	tsTime.tm_hour = ulHour;
1351	tsTime.tm_mday = ulDay;
1352	tsTime.tm_mon = ulMonth - 1;
1353	tsTime.tm_year = ulYear - 1900;
1354	tsTime.tm_isdst = -1;
1355	timeval = mktime( &tsTime );
1356	if ( timeval == -1 ) {
1357	WriteErrorCode( timeval, "mktime");
1358	MAKERXSTRING( *prsResult, "0", 1 );
1359	free( pszSetTZ );
1360	return 0;
1361	}
1362	}
1363
1364	// Return the calculated time value
1365	#if __IBMC__ >= 360 \|\| __IBMCPP__ >= 360
1366	sprintf( szEpochTime, "%.0f", timeval );
1367	#else
1368	sprintf( szEpochTime, "%d", timeval );
1369	#endif
1370	MAKERXSTRING( *prsResult, szEpochTime, strlen(szEpochTime) );
1371
1372	free( pszSetTZ );
1373	return ( 0 );
1374	}
1375
1376
1377	/* ------------------------------------------------------------------------- *
1378	* Sys2LocateDLL *
1379	* *
1380	* Search for an installed or loaded DLL by module name. *
1381	* Code derived from 'whichdll' by Alessandro Cantatore (public domain). *
1382	* *
1383	* REXX ARGUMENTS: *
1384	* 1. The name of the DLL to search for. (REQUIRED) *
1385	* *
1386	* REXX RETURN VALUE: *
1387	* The fully-qualified path of the DLL, if found (or '' if not found). *
1388	* ------------------------------------------------------------------------- */
1389	ULONG APIENTRY Sys2LocateDLL( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1390	{
1391	HMODULE hmod;
1392	CHAR achModuleName[ CCHMAXPATH ];
1393	BOOL bUnload = FALSE;
1394	APIRET rc;
1395
1396	// Reset the error indicator
1397	WriteErrorCode( 0, NULL );
1398
1399	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1400
1401	// See if the DLL is already loaded
1402	rc = DosQueryModuleHandle( argv[0].strptr, &hmod );
1403	if ( rc ) {
1404	// Guess not; try to load it now
1405	rc = DosLoadModule( NULL, 0, argv[0].strptr, &hmod );
1406	if ( rc ) {
1407	WriteErrorCode( rc, "DosLoadModule");
1408	MAKERXSTRING( *prsResult, "", 0 );
1409	return 0;
1410	}
1411	bUnload = TRUE;
1412	}
1413
1414	// Get the full path name of the DLL
1415	rc = DosQueryModuleName( hmod, CCHMAXPATH, achModuleName );
1416	if ( rc ) {
1417	WriteErrorCode( rc, "DosQueryModuleName");
1418	MAKERXSTRING( *prsResult, "", 0 );
1419	if ( bUnload ) DosFreeModule( hmod );
1420	return 0;
1421	}
1422
1423	// Free the module if we loaded it ourselves
1424	if ( bUnload ) DosFreeModule( hmod );
1425
1426	// Return the full path name
1427	if ( ! SaveResultString( prsResult, achModuleName, strlen( achModuleName ))) {
1428	MAKERXSTRING( *prsResult, "", 0 );
1429	}
1430
1431	return 0;
1432	}
1433
1434
1435	/* ------------------------------------------------------------------------- *
1436	* Sys2CreateNamedPipe *
1437	* *
1438	* Create a named pipe with the specified name and parameters. Only byte *
1439	* mode is supported; message mode is not. *
1440	* *
1441	* REXX ARGUMENTS: *
1442	* 1. The name of the pipe, in the form "\PIPE\something". (REQUIRED) *
1443	* 2. The size of the outbound buffer, in bytes. (REQUIRED) *
1444	* 3. The size of the inbound buffer, in bytes. (REQUIRED) *
1445	* 4. The pipe's timeout value, in milliseconds. (DEFAULT: 3000) *
1446	* 5. The number of simultaneous instances of this pipe which are allowed. *
1447	* Must be between 1 and 254, or 0 indicating no limit. (DEFAULT: 1) *
1448	* 6. Pipe blocking mode, one of: *
1449	* W = WAIT mode, read and write block waiting for data. (DEFAULT) *
1450	* N = NOWAIT mode, read and write return immediately. *
1451	* 7. Pipe mode, one of: *
1452	* I = Inbound pipe (DEFAULT) *
1453	* O = Outbound pipe *
1454	* D = Duplex (inbound/outbound) pipe *
1455	* 8. Privacy/inheritance flag, one of: *
1456	* 0 = The pipe handle is inherited by child processes. (DEFAULT) *
1457	* 1 = The pipe handle is private to the current process. *
1458	* 9. Write-through flag, one of: *
1459	* 0 = Allow delayed writes (write-behind) to remote pipes. (DEFAULT) *
1460	* 1 = Force immediate writes (write-through) to remote pipes. *
1461	* *
1462	* REXX RETURN VALUE: *
1463	* A four-byte pipe handle. *
1464	* ------------------------------------------------------------------------- */
1465	ULONG APIENTRY Sys2CreateNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1466	{
1467	HPIPE hp;
1468	PSZ pszNPName;
1469	LONG iLimit;
1470	ULONG ulBufOut,
1471	ulBufIn,
1472	ulTimeout = 3000,
1473	flOpen = 0,
1474	flPipe = 1;
1475	CHAR achHandle[ 9 ];
1476	APIRET rc;
1477
1478	// Reset the error indicator
1479	WriteErrorCode( 0, NULL );
1480
1481	// Make sure we have at least three valid arguments (pipe name and sizes)
1482	if ( argc < 3 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\|
1483	( !RXVALIDSTRING(argv[1]) ) \|\| ( !RXVALIDSTRING(argv[2]) ))
1484	return ( 40 );
1485
1486	// (Validate the first argument last to simplify error processing)
1487
1488	// Second argument: pipe outbound buffer size
1489	if (( sscanf( argv[1].strptr, "%u", &ulBufOut )) != 1 ) return ( 40 );
1490
1491	// Third argument: pipe outbound buffer size
1492	if (( sscanf( argv[2].strptr, "%u", &ulBufIn )) != 1 ) return ( 40 );
1493
1494	// Fourth argument: pipe timeout value
1495	if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
1496	if (( sscanf( argv[3].strptr, "%u", &ulTimeout )) != 1 ) return ( 40 );
1497	}
1498
1499	// Fifth argument: instances limit
1500	if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
1501	if (( sscanf( argv[4].strptr, "%d", &iLimit )) != 1 ) return ( 40 );
1502	if (( iLimit > 1 ) && ( iLimit < 255 ))
1503	flPipe = iLimit;
1504	else if ( !iLimit \|\| ( iLimit == -1 ))
1505	flPipe = NP_UNLIMITED_INSTANCES;
1506	else
1507	return ( 40 );
1508	}
1509
1510	// Sixth argument: blocking mode
1511	if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
1512	strupr( argv[5].strptr );
1513	if ( argv[5].strptr[0] == 'N' )
1514	flPipe \|= NP_NOWAIT;
1515	else if ( argv[5].strptr[0] != 'W' )
1516	return ( 40 );
1517	}
1518
1519	// Seventh argument: pipe mode (direction)
1520	if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
1521	strupr( argv[6].strptr );
1522	if (strcspn(argv[6].strptr, "IOD") > 0 ) return ( 40 );
1523	switch ( argv[6].strptr[0] ) {
1524	case 'O': flOpen \|= NP_ACCESS_OUTBOUND; break;
1525	case 'D': flOpen \|= NP_ACCESS_DUPLEX; break;
1526	default : break; // default is 0
1527	}
1528	}
1529
1530	// Eighth argument: inheritance mode
1531	if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
1532	strupr( argv[7].strptr );
1533	if ( argv[7].strptr[0] == '1' )
1534	flOpen \|= NP_NOINHERIT;
1535	else if ( argv[7].strptr[0] != '0' )
1536	return ( 40 );
1537	}
1538
1539	// Ninth argument: write mode
1540	if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
1541	strupr( argv[8].strptr );
1542	if ( argv[8].strptr[0] == '1' )
1543	flOpen \|= NP_NOWRITEBEHIND;
1544	else if ( argv[8].strptr[0] != '0' )
1545	return ( 40 );
1546	}
1547
1548	// Now the first argument: pipe name
1549	pszNPName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
1550	if ( pszNPName == NULL ) {
1551	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
1552	MAKERXSTRING( *prsResult, "0", 1 );
1553	return ( 0 );
1554	}
1555	strncpy( pszNPName, argv[0].strptr, RXSTRLEN(argv[0]) );
1556
1557	// All good, now create the pipe
1558	rc = DosCreateNPipe( pszNPName, &hp, flOpen, flPipe, ulBufOut, ulBufIn, ulTimeout );
1559	if (rc) {
1560	WriteErrorCode( rc, "DosCreateNPipe");
1561	MAKERXSTRING( *prsResult, "", 0 );
1562	return 0;
1563	}
1564
1565	// Return the handle as the REXX result string
1566	sprintf( achHandle, "%8X", hp );
1567	MAKERXSTRING( *prsResult, achHandle, strlen( achHandle ));
1568
1569	free( pszNPName );
1570	return ( 0 );
1571	}
1572
1573
1574	/* ------------------------------------------------------------------------- *
1575	* Sys2ConnectNamedPipe *
1576	* *
1577	* Start 'listening' by allowing clients to connect to a previously-created *
1578	* named pipe. *
1579	* *
1580	* REXX ARGUMENTS: *
1581	* 1. The pipe handle, as returned by Sys2CreateNamedPipe. (REQUIRED) *
1582	* *
1583	* REXX RETURN VALUE: *
1584	* 1 on success, or 0 if an error occurred. *
1585	* ------------------------------------------------------------------------- */
1586	ULONG APIENTRY Sys2ConnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1587	{
1588	HPIPE hp;
1589	ULONG ulState = 0;
1590	APIRET rc;
1591
1592	// Reset the error indicator
1593	WriteErrorCode( 0, NULL );
1594
1595	// Parse the handle
1596	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1597	if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
1598
1599	// Determine the pipe mode
1600	DosQueryNPHState( hp, &ulState );
1601
1602	// Connect the pipe
1603	rc = DosConnectNPipe( hp );
1604
1605	// A non-blocking pipe returns ERROR_PIPE_NOT_CONNECTED on success
1606	if ((( ulState & NP_NOWAIT ) && ( rc != ERROR_PIPE_NOT_CONNECTED )) \|\|
1607	( rc != NO_ERROR ))
1608	{
1609	WriteErrorCode( rc, "DosConnectNPipe");
1610	MAKERXSTRING( *prsResult, "0", 1 );
1611	return ( 0 );
1612	}
1613
1614	// Return 1 on success
1615	MAKERXSTRING( *prsResult, "1", 1 );
1616	return ( 0 );
1617	}
1618
1619
1620	/* ------------------------------------------------------------------------- *
1621	* Sys2DisconnectNamedPipe *
1622	* *
1623	* Unlocks a named pipe after a client has closed its connection. *
1624	* *
1625	* REXX ARGUMENTS: *
1626	* 1. The pipe handle, as returned by Sys2CreateNamedPipe. (REQUIRED) *
1627	* *
1628	* REXX RETURN VALUE: *
1629	* 1 on success, or 0 if an error occurred. *
1630	* ------------------------------------------------------------------------- */
1631	ULONG APIENTRY Sys2DisconnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1632	{
1633	HPIPE hp;
1634	APIRET rc;
1635
1636	// Reset the error indicator
1637	WriteErrorCode( 0, NULL );
1638
1639	// Parse the handle
1640	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1641	if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
1642
1643	// Connect the pipe
1644	rc = DosDisConnectNPipe( hp );
1645	if ( rc != NO_ERROR ) {
1646	WriteErrorCode( rc, "DosDisConnectNPipe");
1647	MAKERXSTRING( *prsResult, "0", 1 );
1648	return ( 0 );
1649	}
1650
1651	// Return 1 on success
1652	MAKERXSTRING( *prsResult, "1", 1 );
1653	return ( 0 );
1654	}
1655
1656
1657	/* ------------------------------------------------------------------------- *
1658	* Sys2CheckNamedPipe *
1659	* *
1660	* Check the status of a named pipe. *
1661	* *
1662	* REXX ARGUMENTS: *
1663	* 1. The pipe handle (from Sys2CreateNamedPipe or DosOpen). (REQUIRED) *
1664	* *
1665	* REXX RETURN VALUE: *
1666	* String of the format "bytes status", where bytes is the number of bytes *
1667	* currently waiting in the pipe, and status is one of: DISCONNECTED, *
1668	* LISTENING, CONNECTED, or CLOSING. *
1669	* ------------------------------------------------------------------------- */
1670	ULONG APIENTRY Sys2CheckNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1671	{
1672	HPIPE hp;
1673	ULONG cbActual, ulState;
1674	AVAILDATA avd;
1675	CHAR szStatus[ US_PIPESTATUS_MAXZ ];
1676	APIRET rc;
1677
1678	// Reset the error indicator
1679	WriteErrorCode( 0, NULL );
1680
1681	// Parse the handle
1682	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1683	if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
1684
1685	rc = DosPeekNPipe( hp, NULL, 0, &cbActual, &avd, &ulState );
1686	if ( rc != NO_ERROR ) {
1687	WriteErrorCode( rc, "DosPeekNPipe");
1688	MAKERXSTRING( *prsResult, "", 0 );
1689	return ( 0 );
1690	}
1691	sprintf( szStatus, "%u ", avd.cbpipe );
1692	switch ( ulState ) {
1693	case NP_STATE_DISCONNECTED: strncat( szStatus, "DISCONNECTED", US_PIPESTATUS_MAXZ-1 ); break;
1694	case NP_STATE_LISTENING: strncat( szStatus, "LISTENING", US_PIPESTATUS_MAXZ-1 ); break;
1695	case NP_STATE_CONNECTED: strncat( szStatus, "CONNECTED", US_PIPESTATUS_MAXZ-1 ); break;
1696	case NP_STATE_CLOSING: strncat( szStatus, "CLOSING", US_PIPESTATUS_MAXZ-1 ); break;
1697	default: strncat( szStatus, "UNKNOWN", US_PIPESTATUS_MAXZ-1 ); break;
1698	}
1699
1700	if ( ! SaveResultString( prsResult, szStatus, strlen( szStatus ))) {
1701	MAKERXSTRING( *prsResult, "", 0 );
1702	}
1703	return ( 0 );
1704	}
1705
1706
1707	/* ------------------------------------------------------------------------- *
1708	* Sys2Open *
1709	* *
1710	* Wrapper to DosOpenL: open a file or stream (with >2GB support). *
1711	* Direct-DASD mode is not supported by this function, nor is setting the *
1712	* initial extended attributes. *
1713	* *
1714	* REXX ARGUMENTS: *
1715	* 1. Name of file or stream to open. (REQUIRED) *
1716	* 2. Open action flags, must be either "O" (open if exists), "R" (replace *
1717	* if exists), or nothing (fail if exists), optionally followed by "C" *
1718	* (create if file does not exist). If "C" is not specified, the *
1719	* operation will fail if the file does not exist. Note that a value *
1720	* of "" alone will therefore fail automatically. (DEFAULT: "O") *
1721	* In summary, the possible combinations are: *
1722	* O = Open only (if file exists, open it; if not, fail) *
1723	* OC= Open/create (if file exists, open it; if not, create it) *
1724	* R = Replace only (if file exists, replace it; if not, fail) *
1725	* RC= Replace/create (if file exists, replace it; if not, create it) *
1726	* C = Create only (if file exists, fail; if not, create it) *
1727	* (empty) = No-op (if file exists, fail; if not, fail) *
1728	* 3. Access mode flags, one or both of: (DEFAULT: "RW") *
1729	* R = Open file with read access. *
1730	* W = Open file with write access. *
1731	* 4. Sharing mode flags, any combination of: (DEFAULT: "W") *
1732	* R = Deny read access to other processes *
1733	* W = Deny write access to other processes *
1734	* 5. Deny legacy DosOpen access, one of: *
1735	* 0 = Allow DosOpen to access the file (DEFAULT) *
1736	* 1 = Deny access using the DosOpen API *
1737	* 6. Privacy/inheritance flag, one of: *
1738	* 0 = The file handle is inherited by child processes. (DEFAULT) *
1739	* 1 = The file handle is private to the current process. *
1740	* 7. Initial file attributes when creating a file: (DEFAULT: "") *
1741	* A = Archive attribute set *
1742	* D = Directory attribute set *
1743	* S = System attribute set *
1744	* H = Hidden attribute set *
1745	* R = Read-only attribute set *
1746	* 8. Initial file size when creating or replacing a file; ignored if *
1747	* access mode is read-only. (DEFAULT: 0) *
1748	* 9. I/O mode flags, any or all of: (DEFAULT: "") *
1749	* T = Write-through mode (default is normal write) *
1750	* N = No-cache mode (default is to use filesystem cache) *
1751	* S = Sequential access *
1752	* R = Random access *
1753	* * S and R can combine as follows: *
1754	* Neither: No locality known (default) *
1755	* S only: Mainly sequential access *
1756	* R only: Mainly random access *
1757	* Both: Random/sequential (i.e. random with some locality) *
1758	* *
1759	* REXX RETURN VALUE: *
1760	* File handle, or "" in case of error. *
1761	* ------------------------------------------------------------------------- */
1762	ULONG APIENTRY Sys2Open( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1763	{
1764	PSZ pszFile;
1765	HFILE hf;
1766	ULONG fsAction = 0,
1767	fsMode = 0,
1768	ulResult = 0,
1769	ulAttr = FILE_NORMAL;
1770	LONGLONG llSize = {0};
1771	CHAR achHandle[ 9 ];
1772	APIRET rc;
1773
1774
1775	// Reset the error indicator
1776	WriteErrorCode( 0, NULL );
1777
1778	// Make sure we have at least one valid argument (the file name)
1779	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
1780	return ( 40 );
1781
1782	// (Validate the first argument last to simplify error processing)
1783
1784	// Second argument: open action
1785	if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
1786	strupr( argv[1].strptr );
1787	if ( strcspn(argv[1].strptr, "OCR") > 0 ) return ( 40 );
1788	if ( strchr(argv[1].strptr, 'O'))
1789	fsAction \|= OPEN_ACTION_OPEN_IF_EXISTS;
1790	else if ( strchr(argv[1].strptr, 'R'))
1791	fsAction \|= OPEN_ACTION_REPLACE_IF_EXISTS;
1792	if ( strchr(argv[1].strptr, 'C'))
1793	fsAction \|= OPEN_ACTION_CREATE_IF_NEW;
1794	}
1795	else
1796	fsAction = OPEN_ACTION_OPEN_IF_EXISTS;
1797
1798	// Third argument: access mode
1799	if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
1800	strupr( argv[2].strptr );
1801	if ( strcspn(argv[2].strptr, "RW") > 0 ) return ( 40 );
1802	if ( strchr(argv[2].strptr, 'R')) {
1803	if (strchr(argv[2].strptr, 'W'))
1804	fsMode = OPEN_ACCESS_READWRITE;
1805	else
1806	fsMode = OPEN_ACCESS_READONLY;
1807	}
1808	else if (strchr(argv[2].strptr, 'W'))
1809	fsMode = OPEN_ACCESS_WRITEONLY;
1810	else
1811	return ( 40 );
1812	}
1813	else
1814	fsMode = OPEN_ACCESS_READWRITE;
1815
1816	// Fourth argument: sharing mode
1817	if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
1818	strupr( argv[3].strptr );
1819	if ( strcspn(argv[3].strptr, "RW") > 0 ) return ( 40 );
1820	if ( strchr(argv[3].strptr, 'R')) {
1821	if (strchr(argv[3].strptr, 'W'))
1822	fsMode \|= OPEN_SHARE_DENYREADWRITE;
1823	else
1824	fsMode \|= OPEN_SHARE_DENYREAD;
1825	}
1826	else if (strchr(argv[3].strptr, 'W'))
1827	fsMode \|= OPEN_SHARE_DENYWRITE;
1828	else
1829	fsMode \|= OPEN_SHARE_DENYNONE;
1830	}
1831	else
1832	fsMode \|= OPEN_SHARE_DENYWRITE;
1833
1834	// Fifth argument: deny legacy mode
1835	if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
1836	strupr( argv[4].strptr );
1837	if ( argv[4].strptr[0] == '1' )
1838	fsMode \|= OPEN_SHARE_DENYLEGACY;
1839	else if ( argv[4].strptr[0] != '0' )
1840	return ( 40 );
1841	}
1842
1843	// Sixth argument: inheritance mode
1844	if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
1845	strupr( argv[5].strptr );
1846	if ( argv[5].strptr[0] == '1' )
1847	fsMode \|= OPEN_FLAGS_NOINHERIT;
1848	else if ( argv[5].strptr[0] != '0' )
1849	return ( 40 );
1850	}
1851
1852	// Seventh argument: attributes
1853	if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
1854	strupr( argv[6].strptr );
1855	if (strcspn(argv[6].strptr, "ADSHR") > 0 ) return ( 40 );
1856	if ( strchr(argv[6].strptr, 'A')) ulAttr \|= FILE_ARCHIVED;
1857	if ( strchr(argv[6].strptr, 'D')) ulAttr \|= FILE_DIRECTORY;
1858	if ( strchr(argv[6].strptr, 'S')) ulAttr \|= FILE_SYSTEM;
1859	if ( strchr(argv[6].strptr, 'H')) ulAttr \|= FILE_HIDDEN;
1860	if ( strchr(argv[6].strptr, 'R')) ulAttr \|= FILE_READONLY;
1861	}
1862
1863	// Eighth argument: initial size
1864	if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
1865	if (( sscanf( argv[7].strptr, "%lld", &llSize )) != 1 ) return ( 40 );
1866	}
1867
1868	// Ninth argument: I/O mode flags
1869	if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
1870	strupr( argv[8].strptr );
1871	if (strcspn(argv[8].strptr, "TNSR") > 0 ) return ( 40 );
1872	if ( strchr(argv[8].strptr, 'T')) fsMode \|= OPEN_FLAGS_WRITE_THROUGH;
1873	if ( strchr(argv[8].strptr, 'N')) fsMode \|= OPEN_FLAGS_NO_CACHE;
1874	if ( strchr(argv[8].strptr, 'S')) fsMode \|= OPEN_FLAGS_SEQUENTIAL;
1875	if ( strchr(argv[8].strptr, 'R')) fsMode \|= OPEN_FLAGS_RANDOM;
1876	}
1877
1878	// Now the first argument: file name
1879	pszFile = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
1880	if ( pszFile == NULL ) {
1881	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
1882	MAKERXSTRING( *prsResult, "0", 1 );
1883	return ( 0 );
1884	}
1885	strncpy( pszFile, argv[0].strptr, RXSTRLEN(argv[0]) );
1886
1887	// Try and open the file
1888	rc = DosOpenL( pszFile, &hf, &ulResult, llSize, ulAttr, fsAction, fsMode, NULL );
1889	if (rc) {
1890	WriteErrorCode( rc, "DosOpenL");
1891	MAKERXSTRING( *prsResult, "", 0 );
1892	free( pszFile );
1893	return ( 0 );
1894	}
1895
1896	// Return the handle as the REXX result string
1897	sprintf( achHandle, "%8X", hf );
1898	MAKERXSTRING( *prsResult, achHandle, strlen( achHandle ));
1899
1900	free( pszFile );
1901	return ( 0 );
1902	}
1903
1904
1905	/* ------------------------------------------------------------------------- *
1906	* Sys2Close *
1907	* *
1908	* Wrapper to DosClose: close a file/stream. *
1909	* *
1910	* REXX ARGUMENTS: *
1911	* 1. File handle (returned by Sys2Open) (REQUIRED) *
1912	* *
1913	* REXX RETURN VALUE: *
1914	* 1 on success, or 0 if an error occurred. *
1915	* ------------------------------------------------------------------------- */
1916	ULONG APIENTRY Sys2Close( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1917	{
1918	HFILE hf;
1919	APIRET rc;
1920
1921	// Reset the error indicator
1922	WriteErrorCode( 0, NULL );
1923
1924	// Make sure we have exactly one valid argument (the file handle)
1925	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
1926	return ( 40 );
1927	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
1928
1929	// Close the file
1930	rc = DosClose( hf );
1931	if ( rc != NO_ERROR ) {
1932	WriteErrorCode( rc, "DosClose");
1933	MAKERXSTRING( *prsResult, "0", 1 );
1934	}
1935	else {
1936	MAKERXSTRING( *prsResult, "1", 1 );
1937	}
1938
1939	return ( 0 );
1940	}
1941
1942
1943	/* ------------------------------------------------------------------------- *
1944	* Sys2Seek *
1945	* *
1946	* Wrapper to DosSetFilePtrL: move the read/write pointer to the specified *
1947	* location in a stream. *
1948	* *
1949	* REXX ARGUMENTS: *
1950	* 1. File handle (returned by Sys2Open) (REQUIRED) *
1951	* 2. The signed distance in bytes to move (REQUIRED) *
1952	* 3. Move method, one of: *
1953	* B = Beginning of file *
1954	* C = Current position (DEFAULT) *
1955	* E = End of file *
1956	* *
1957	* REXX RETURN VALUE: *
1958	* The new file position, in bytes. *
1959	* ------------------------------------------------------------------------- */
1960	ULONG APIENTRY Sys2Seek( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1961	{
1962	HFILE hf;
1963	LONGLONG llPos,
1964	llActual;
1965	ULONG ulMethod = FILE_CURRENT;
1966	CHAR achActual[ US_LONGLONG_MAXZ ];
1967	APIRET rc;
1968
1969	// Reset the error indicator
1970	WriteErrorCode( 0, NULL );
1971
1972	// Make sure we have at least two valid arguments
1973	if ( argc < 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
1974	return ( 40 );
1975
1976	// First argument: file handle
1977	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
1978
1979	// Second argument: requested offset
1980	if (( sscanf( argv[1].strptr, "%lld", &llPos )) != 1 ) return ( 40 );
1981
1982	// Third argument: starting position
1983	if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
1984	strupr( argv[2].strptr );
1985	if ( strcspn(argv[2].strptr, "BCE") > 0 ) return ( 40 );
1986	switch ( argv[2].strptr[0] ) {
1987	case 'B': ulMethod = FILE_BEGIN; break;
1988	case 'E': ulMethod = FILE_END; break;
1989	default : ulMethod = FILE_CURRENT; break;
1990	}
1991	}
1992
1993	rc = DosSetFilePtrL( hf, llPos, ulMethod, &llActual );
1994	if ( rc != NO_ERROR ) {
1995	WriteErrorCode( rc, "DosSetFilePtrL");
1996	MAKERXSTRING( *prsResult, "", 0 );
1997	return ( 0 );
1998	}
1999
2000	// Return the new position as the REXX result string
2001	sprintf( achActual, "%lld", llActual );
2002	MAKERXSTRING( *prsResult, achActual, strlen( achActual ));
2003
2004	return ( 0 );
2005	}
2006
2007
2008	/* ------------------------------------------------------------------------- *
2009	* Sys2Read *
2010	* *
2011	* Wrapper to DosRead: read bytes from a previously-opened stream. *
2012	* *
2013	* REXX ARGUMENTS: *
2014	* 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
2015	* 2. Number of bytes to read (REQUIRED) *
2016	* *
2017	* REXX RETURN VALUE: *
2018	* String containing the bytes read, or "" in case of error. *
2019	* ------------------------------------------------------------------------- */
2020	ULONG APIENTRY Sys2Read( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
2021	{
2022	HFILE hf;
2023	ULONG cb,
2024	cbActual;
2025	PSZ pszData;
2026	APIRET rc;
2027
2028	// Reset the error indicator
2029	WriteErrorCode( 0, NULL );
2030
2031	// Make sure we have two valid arguments
2032	if ( argc != 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
2033	return ( 40 );
2034
2035	// First argument: handle
2036	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2037
2038	// Second argument: number of bytes to read
2039	if (( sscanf( argv[1].strptr, "%u", &cb )) != 1 ) return ( 40 );
2040	if ( cb < 1 ) return ( 40 );
2041	pszData = (PSZ) malloc( cb );
2042
2043	rc = DosRead( hf, pszData, cb, &cbActual );
2044	if ( rc \|\| !cbActual ) {
2045	WriteErrorCode( rc, "DosRead");
2046	MAKERXSTRING( *prsResult, "", 0 );
2047	goto cleanup;
2048	}
2049	if ( ! SaveResultString( prsResult, pszData, cbActual )) {
2050	MAKERXSTRING( *prsResult, "", 0 );
2051	}
2052
2053	cleanup:
2054	free( pszData );
2055	return ( 0 );
2056	}
2057
2058
2059	/* ------------------------------------------------------------------------- *
2060	* Sys2Write *
2061	* *
2062	* Wrapper to DosWrite: write bytes to a previously-opened stream. *
2063	* *
2064	* REXX ARGUMENTS: *
2065	* 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
2066	* 2. Data to be written (REQUIRED) *
2067	* *
2068	* REXX RETURN VALUE: *
2069	* Number of bytes written. *
2070	* ------------------------------------------------------------------------- */
2071	ULONG APIENTRY Sys2Write( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
2072	{
2073	HFILE hf;
2074	ULONG cbActual;
2075	CHAR szActual[ US_INTEGER_MAXZ ];
2076	APIRET rc;
2077
2078	// Reset the error indicator
2079	WriteErrorCode( 0, NULL );
2080
2081	// Make sure we have two valid arguments
2082	if ( argc != 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
2083	return ( 40 );
2084
2085	// First argument: handle
2086	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2087
2088	// (Second argument can be left in standard RXSTRING form)
2089
2090	rc = DosWrite( hf, argv[1].strptr, argv[1].strlength, &cbActual );
2091	if ( rc != NO_ERROR ) {
2092	WriteErrorCode( rc, "DosWrite");
2093	MAKERXSTRING( *prsResult, "0", 1 );
2094	return ( 0 );
2095	}
2096
2097	sprintf( szActual, "%d", cbActual );
2098	MAKERXSTRING( *prsResult, szActual, strlen( szActual ));
2099	return ( 0 );
2100	}
2101
2102
2103	/* ------------------------------------------------------------------------- *
2104	* Sys2SyncBuffer *
2105	* *
2106	* Wrapper to DosResetBuffer: for external files, write the buffer to disk; *
2107	* for pipes, block until the far end of the pipe has read the contents. *
2108	* *
2109	* REXX ARGUMENTS: *
2110	* 1. File handle (returned by Sys2Open) (REQUIRED) *
2111	* *
2112	* REXX RETURN VALUE: *
2113	* 1 on success, or 0 if an error occurred. *
2114	* ------------------------------------------------------------------------- */
2115	ULONG APIENTRY Sys2SyncBuffer( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
2116	{
2117	HFILE hf;
2118	APIRET rc;
2119
2120	// Reset the error indicator
2121	WriteErrorCode( 0, NULL );
2122
2123	// Make sure we have exactly one valid argument (the file handle)
2124	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
2125	return ( 40 );
2126	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2127
2128	// Sync the buffer
2129	rc = DosResetBuffer( hf );
2130	if ( rc != NO_ERROR ) {
2131	WriteErrorCode( rc, "DosResetBuffer");
2132	MAKERXSTRING( *prsResult, "0", 1 );
2133	}
2134	else {
2135	MAKERXSTRING( *prsResult, "1", 1 );
2136	}
2137
2138	return ( 0 );
2139	}
2140
2141
2142
2143	// -------------------------------------------------------------------------
2144	// INTERNAL FUNCTIONS
2145	// -------------------------------------------------------------------------
2146
2147
2148	/* ------------------------------------------------------------------------- *
2149	* GetProcess *
2150	* *
2151	* Gets information about the specified process (if found). If pszProgram *
2152	* is NULL, the search is done on the process ID in pulPID; otherwise, the *
2153	* search is done on the executable name in pszProgram (which may or may not *
2154	* include the extension). *
2155	* *
2156	* ARGUMENTS: *
2157	* PSZ pszProgram : The requested executable (process name). (I) *
2158	* PSZ pszFullName: The returned fully-qualified process name. (O) *
2159	* PULONG pulPID : The process ID. (IO) *
2160	* PULONG pulPPID : The returned process parent ID. (O) *
2161	* PULONG pulType : The returned process type. (O) *
2162	* PUSHORT pusPriority: The returned process priority. (O) *
2163	* PULONG pulCPU : The returned process CPU time. (O) *
2164	* *
2165	* RETURNS: ULONG *
2166	* 0 on success, or a non-zero API return code in the case of an error. *
2167	* ------------------------------------------------------------------------- */
2168	ULONG GetProcess( PSZ pszProgram,
2169	PSZ pszFullName,
2170	PULONG pulPID,
2171	PULONG pulPPID,
2172	PULONG pulType,
2173	PUSHORT pusPriority,
2174	PULONG pulCPU )
2175	{
2176	#ifdef USE_DQPS
2177	QSPTRREC *pBuf; // Data returned by DosQProcStatus()
2178	#else
2179	QSPTRREC *pBuf; // Data returned by DosQuerySysState() // 2015-04-23 SHL
2180	#endif
2181	QSPREC *pPrec; // Pointer to process information block
2182	QSTREC *pTrec; // Pointer to thread information block
2183	CHAR szName[ CCHMAXPATH ] = {0}, // Fully-qualified name of process
2184	szNoExt[ CCHMAXPATH ] = {0}; // Program name without extension
2185	PPIB ppib; // pointer to current process info block
2186	PSZ pszCurrent, // Program name of a queried process
2187	c; // Pointer to substring
2188	ULONG ulCPU; // Process CPU time
2189	USHORT usPriority, // Process priority class
2190	i; // index
2191	BOOL fMatch = FALSE; // The current process is a match?
2192	APIRET rc; // Return code
2193
2194
2195	// Use current process when PID is 0 and program name is not specified
2196	if (( pszProgram == NULL ) && ( *pulPID == 0 )) {
2197	rc = DosGetInfoBlocks( NULL, &ppib );
2198	if ( rc != NO_ERROR ) {
2199	WriteErrorCode( rc, "DosGetInfoBlocks");
2200	return ( rc );
2201	}
2202	*pulPID = ppib->pib_ulpid;
2203	}
2204
2205	#ifdef USE_DQPS
2206	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE );
2207	#else
2208	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE ); // 2015-04-23 SHL
2209	#endif
2210
2211	if ( pBuf == NULL ) {
2212	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
2213	return ( ERROR_NOT_ENOUGH_MEMORY );
2214	}
2215
2216	#ifdef USE_DQPS
2217	// Get running process information using DosQProcStatus()
2218	rc = DosQProcStatus( pBuf, UL_SSBUFSIZE );
2219	if ( rc != NO_ERROR ) {
2220	WriteErrorCode( rc, "DosQProcStatus");
2221	return ( rc );
2222	}
2223	pPrec = pBuf->pProcRec;
2224	#else
2225	// Get running process information using DosQuerySysState()
2226	rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE );
2227	if ( rc != NO_ERROR ) {
2228	WriteErrorCode( rc, "DosQuerySysState");
2229	return ( rc );
2230	}
2231	pPrec = (QSPREC )(((QSPTRREC)pBuf) -> pProcRec); // 2015-04-23 SHL
2232	#endif
2233
2234	*pulPPID = 0;
2235	*pulType = 0;
2236	*pusPriority = 0;
2237	*pulCPU = 0;
2238	if ( pszProgram != NULL ) *pulPID = 0;
2239	else if ( *pulPID == 0 ) return 0;
2240
2241	// Now look for the specified process
2242	while (( pPrec->RecType == 1 ) && ( !fMatch )) {
2243
2244	if ( pszProgram == NULL ) {
2245	if ( pPrec->pid == *pulPID ) {
2246	fMatch = TRUE;
2247	// Get the program name
2248	if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
2249	sprintf( pszFullName, "--");
2250	else
2251	strcpy( pszFullName, szName );
2252
2253	// Get the process priority
2254	if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
2255	usPriority = 0;
2256
2257	// Get the CPU time of the process by querying each of its threads
2258	ulCPU = 0;
2259	pTrec = pPrec->pThrdRec;
2260	for ( i = 0; i < pPrec->cTCB; i++ ) {
2261	ulCPU += ( pTrec->systime + pTrec->usertime );
2262	pTrec++;
2263	}
2264
2265	*pulPPID = pPrec->ppid;
2266	*pulType = pPrec->type;
2267	*pusPriority = usPriority;
2268	*pulCPU = ulCPU;
2269	}
2270	}
2271	else {
2272	// Get the program name (without the path)
2273	if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
2274	sprintf( pszCurrent, "--");
2275	else
2276	pszCurrent = strrchr( szName, '\\') + 1;
2277
2278	// Create a copy without the extension
2279	strcpy( szNoExt, pszCurrent );
2280	if (( c = strrchr( szNoExt, '.')) != NULL ) memset( c, 0, strlen(c) );
2281	if (( pszCurrent != NULL ) &&
2282	(( stricmp(pszCurrent, pszProgram) == 0 ) \|\| ( stricmp(szNoExt, pszProgram) == 0 )))
2283	{
2284	fMatch = TRUE;
2285
2286	// Get the process priority
2287	if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
2288	usPriority = 0;
2289
2290	// Get the CPU time of the process by querying each of its threads
2291	ulCPU = 0;
2292	pTrec = pPrec->pThrdRec;
2293	for ( i = 0; i < pPrec->cTCB; i++ ) {
2294	ulCPU += ( pTrec->systime + pTrec->usertime );
2295	pTrec++;
2296	}
2297
2298	*pulPID = pPrec->pid;
2299	*pulPPID = pPrec->ppid;
2300	*pulType = pPrec->type;
2301	*pusPriority = usPriority;
2302	*pulCPU = ulCPU;
2303	strcpy( pszFullName, szName );
2304	}
2305	}
2306	pPrec = (QSPREC ) ( (PBYTE) (pPrec->pThrdRec) + ( pPrec->cTCB sizeof(QSTREC) ) );
2307	}
2308	if ( !fMatch ) *pulPID = 0;
2309
2310	free( pBuf );
2311	return ( 0 );
2312	}
2313
2314
2315	/* ------------------------------------------------------------------------- *
2316	* SaveResultString *
2317	* *
2318	* Writes new string contents to the specified RXSTRING, allocating any *
2319	* additional memory that may be required. If the string to be written has *
2320	* zero length, nothing is done. *
2321	* *
2322	* This function should be used in place of MAKERXSTRING if there is a *
2323	* possibility that the string contents could be longer than 256 characters. *
2324	* *
2325	* ARGUMENTS: *
2326	* PRXSTRING prsResult: Pointer to an existing RXSTRING for writing. *
2327	* PCH pchBytes : The string contents to write to prsResult. *
2328	* ULONG ulBytes : The number of bytes in pchBytes to write. *
2329	* *
2330	* RETURNS: BOOL *
2331	* TRUE if prsResult was successfully updated. FALSE otherwise. *
2332	* ------------------------------------------------------------------------- */
2333	BOOL SaveResultString( PRXSTRING prsResult, PCH pchBytes, ULONG ulBytes )
2334	{
2335	ULONG ulRC;
2336	PCH pchNew;
2337
2338	if ( ulBytes == 0 ) return ( FALSE );
2339	if ( ulBytes > 256 ) {
2340	// REXX provides 256 bytes by default; allocate more if necessary
2341	ulRC = DosAllocMem( (PVOID) &pchNew, ulBytes, PAG_WRITE \| PAG_COMMIT );
2342	if ( ulRC != 0 ) {
2343	WriteErrorCode( ulRC, "DosAllocMem");
2344	return ( FALSE );
2345	}
2346	// 2015-06-03 SHL dropped DosFreeMem(prsResult->strptr);
2347	// 2015-06-03 SHL Pointer not allocated by DosAllocMem
2348	prsResult->strptr = pchNew;
2349	}
2350	memcpy( prsResult->strptr, pchBytes, ulBytes );
2351	prsResult->strlength = ulBytes;
2352
2353	return ( TRUE );
2354	}
2355
2356
2357	/* ------------------------------------------------------------------------- *
2358	* WriteStemElement *
2359	* *
2360	* Creates a stem element (compound variable) in the calling REXX program *
2361	* using the REXX shared variable pool interface. *
2362	* *
2363	* ARGUMENTS: *
2364	* PSZ pszStem : The name of the stem (before the '.') *
2365	* ULONG ulIndex : The number of the stem element (after the '.') *
2366	* PSZ pszValue : The value to write to the compound variable. *
2367	* *
2368	* RETURNS: BOOL *
2369	* TRUE on success, FALSE on failure. *
2370	* ------------------------------------------------------------------------- */
2371	BOOL WriteStemElement( PSZ pszStem, ULONG ulIndex, PSZ pszValue )
2372	{
2373	SHVBLOCK shvVar; // REXX shared variable pool block
2374	ULONG ulRc,
2375	ulBytes;
2376	CHAR szCompoundName[ US_COMPOUND_MAXZ ];
2377
2378	sprintf( szCompoundName, "%s.%d", pszStem, ulIndex );
2379	if ( pszValue == NULL ) {
2380	pszValue = "";
2381	ulBytes = 0;
2382	} else {
2383	// 2015-06-03 SHL Was using DosAllocMem and leaking memory
2384	// REXX API does not free this kind of buffer
2385	ulBytes = strlen( pszValue );
2386	}
2387	MAKERXSTRING( shvVar.shvname, szCompoundName, strlen(szCompoundName) );
2388	shvVar.shvvalue.strptr = pszValue;
2389	shvVar.shvvalue.strlength = ulBytes;
2390	shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
2391	shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
2392	shvVar.shvcode = RXSHV_SYSET;
2393	shvVar.shvnext = NULL;
2394	ulRc = RexxVariablePool( &shvVar );
2395	if ( ulRc > 1 ) {
2396	WriteErrorCode( shvVar.shvret, "RexxVariablePool (SHVBLOCK.shvret)");
2397	return FALSE;
2398	}
2399	return TRUE;
2400
2401	}
2402
2403
2404	/* ------------------------------------------------------------------------- *
2405	* WriteErrorCode *
2406	* *
2407	* Writes an error code to a special variable in the calling REXX program *
2408	* using the REXX shared variable pool interface. This is used to return *
2409	* API error codes to the REXX program, since the REXX functions themselves *
2410	* normally return string values. *
2411	* *
2412	* ARGUMENTS: *
2413	* ULONG ulError : The error code returned by the failing API call. *
2414	* PSZ pszContext: A string describing the API call that failed. *
2415	* *
2416	* RETURNS: N/A *
2417	* ------------------------------------------------------------------------- */
2418	void WriteErrorCode( ULONG ulError, PSZ pszContext )
2419	{
2420	SHVBLOCK shvVar; // REXX shared variable pool block
2421	ULONG ulRc;
2422	CHAR szErrorText[ US_ERRSTR_MAXZ ];
2423
2424	if ( pszContext == NULL )
2425	sprintf( szErrorText, "%u", ulError );
2426	else
2427	sprintf( szErrorText, "%u: %s", ulError, pszContext );
2428	MAKERXSTRING( shvVar.shvname, SZ_ERROR_NAME, strlen(SZ_ERROR_NAME) );
2429	MAKERXSTRING( shvVar.shvvalue, szErrorText, strlen(szErrorText) );
2430	shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
2431	shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
2432	shvVar.shvcode = RXSHV_SYSET;
2433	shvVar.shvnext = NULL;
2434	ulRc = RexxVariablePool( &shvVar );
2435	if ( ulRc > 1 )
2436	printf("Unable to set %s: rc = %d, ulRc = %x\n", shvVar.shvname.strptr, shvVar.shvret, ulRc ); /* 2015-04-23 SHL */
2437	}
2438
2439

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

Download in other formats: