Context Navigation

source: rxutilex/trunk/rxutilex.c@ 29

Last change on this file since 29 was 29, checked in by Alex Taylor, 10 years ago
Added optional second parameter to Sys2LocateDLL, and updated/clarified function documentation.
File size: 108.1 KB

Line
1	/******************************************************************************
2	* REXX Utility Functions - Extended (RXUTILEX.DLL) *
3	* (C) 2011, 2014 Alex Taylor. *
4	* *
5	* LICENSE: *
6	* *
7	* Redistribution and use in source and binary forms, with or without *
8	* modification, are permitted provided that the following conditions are *
9	* met: *
10	* *
11	* 1. Redistributions of source code must retain the above copyright *
12	* notice, this list of conditions and the following disclaimer. *
13	* *
14	* 2. Redistributions in binary form must reproduce the above copyright *
15	* notice, this list of conditions and the following disclaimer in the *
16	* documentation and/or other materials provided with the distribution. *
17	* *
18	* 3. The name of the author may not be used to endorse or promote products *
19	* derived from this software without specific prior written permission. *
20	* *
21	* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ''AS IS'' AND ANY EXPRESS OR *
22	* IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED *
23	* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE *
24	* DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, *
25	* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES *
26	* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR *
27	* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) *
28	* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, *
29	* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN *
30	* ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE *
31	* POSSIBILITY OF SUCH DAMAGE. *
32	* *
33	******************************************************************************/
34
35	// Uncomment to use DosQProcStatus() instead of DosQuerySysState().
36	// -- This was mostly put in place for early testing to see if either function
37	// was more/less reliable than the other. In practice, DosQuerySysState()
38	// should probably be used.
39	// #define USE_DQPS
40
41	// Uncomment to use legacy C style locale data instead of the OS/2 ULS library
42	#define LEGACY_C_LOCALE
43
44	#define INCL_WINATOM
45	#define INCL_WINCLIPBOARD
46	#define INCL_WINERRORS
47	#define INCL_DOSERRORS
48	#define INCL_DOSMISC
49	#define INCL_DOSMODULEMGR
50	#define INCL_DOSNMPIPES
51	#define INCL_DOSPROCESS
52	#define INCL_DOSPROFILE
53	#ifndef OS2_INCLUDED
54	#include <os2.h>
55	#endif
56
57	#include <stdio.h>
58	#include <stdlib.h>
59	#include <string.h>
60	#include <time.h>
61
62	#ifdef LEGACY_C_LOCALE
63	#include <locale.h>
64	#include <nl_types.h>
65	#include <langinfo.h>
66	#else
67	#include <unidef.h>
68	#endif
69
70	#define INCL_RXSHV
71	#define INCL_RXFUNC
72	#include <rexxsaa.h>
73
74	#pragma import( DosGetPrty, "DosGetPrty", "DOSCALL1", 9 )
75	USHORT APIENTRY16 DosGetPrty( USHORT usScope, PUSHORT pusPriority, USHORT pid );
76
77	#ifdef USE_DQPS
78	#pragma import( DosQProcStatus, "DosQProcStatus", "DOSCALL1", 154 )
79	USHORT APIENTRY16 DosQProcStatus( PVOID pBuf, USHORT cbBuf );
80	#endif
81
82	// CONSTANTS
83
84	#define SZ_LIBRARY_NAME "RXUTILEX" // Name of this library
85	#define SZ_ERROR_NAME "SYS2ERR" // REXX variable used to store error codes
86	#define SZ_VERSION "0.1.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	* 2. Flag to limit search context, must be one of: *
1386	* ALL : Search for both loaded and loadable DLLs (DEFAULT) *
1387	* LOADEDONLY: Search only for currently-loaded DLLs *
1388	* Only the first letter (A/L) is significant. *
1389	* *
1390	* REXX RETURN VALUE: *
1391	* The fully-qualified path of the DLL, if found (or '' if not found). *
1392	* ------------------------------------------------------------------------- */
1393	ULONG APIENTRY Sys2LocateDLL( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1394	{
1395	HMODULE hmod;
1396	CHAR achModuleName[ CCHMAXPATH ];
1397	BOOL bLoadedOnly = FALSE,
1398	bUnload = FALSE;
1399	APIRET rc;
1400
1401	// Reset the error indicator
1402	WriteErrorCode( 0, NULL );
1403
1404	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
1405
1406	// Second argument: flag
1407	if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
1408	strupr( argv[1].strptr );
1409	if ( strcspn(argv[1].strptr, "AL") > 0 ) return ( 40 );
1410	switch ( argv[1].strptr[0] ) {
1411	case 'A': bLoadedOnly = FALSE; break;
1412	case 'L': bLoadedOnly = TRUE; break;
1413	default : return ( 40 );
1414	}
1415	}
1416
1417	// See if the DLL is already loaded
1418	rc = DosQueryModuleHandle( argv[0].strptr, &hmod );
1419	if ( rc ) {
1420	// Guess not...
1421	if ( bLoadedOnly ) {
1422	// Just return
1423	MAKERXSTRING( *prsResult, "", 0 );
1424	return 0;
1425	}
1426	// Try to load it now
1427	rc = DosLoadModule( NULL, 0, argv[0].strptr, &hmod );
1428	if ( rc ) {
1429	WriteErrorCode( rc, "DosLoadModule");
1430	MAKERXSTRING( *prsResult, "", 0 );
1431	return 0;
1432	}
1433	bUnload = TRUE;
1434	}
1435
1436	// Get the full path name of the DLL
1437	rc = DosQueryModuleName( hmod, CCHMAXPATH, achModuleName );
1438	if ( rc ) {
1439	WriteErrorCode( rc, "DosQueryModuleName");
1440	MAKERXSTRING( *prsResult, "", 0 );
1441	if ( bUnload ) DosFreeModule( hmod );
1442	return 0;
1443	}
1444
1445	// Free the module if we loaded it ourselves
1446	if ( bUnload ) DosFreeModule( hmod );
1447
1448	// Return the full path name
1449	if ( ! SaveResultString( prsResult, achModuleName, strlen( achModuleName ))) {
1450	MAKERXSTRING( *prsResult, "", 0 );
1451	}
1452
1453	return 0;
1454	}
1455
1456
1457	/* ------------------------------------------------------------------------- *
1458	* Sys2CreateNamedPipe *
1459	* *
1460	* Create a named pipe with the specified name and parameters. Only byte *
1461	* mode is supported; message mode is not. *
1462	* *
1463	* REXX ARGUMENTS: *
1464	* 1. The name of the pipe, in the form "\PIPE\something". (REQUIRED) *
1465	* 2. The size of the outbound buffer, in bytes. (REQUIRED) *
1466	* 3. The size of the inbound buffer, in bytes. (REQUIRED) *
1467	* 4. The pipe's timeout value, in milliseconds. (DEFAULT: 3000) *
1468	* 5. The number of simultaneous instances of this pipe which are allowed. *
1469	* Must be between 1 and 254, or 0 indicating no limit. (DEFAULT: 1) *
1470	* 6. Pipe blocking mode, one of: *
1471	* W = WAIT mode, read and write block waiting for data. (DEFAULT) *
1472	* N = NOWAIT mode, read and write return immediately. *
1473	* 7. Pipe mode, one of: *
1474	* I = Inbound pipe (DEFAULT) *
1475	* O = Outbound pipe *
1476	* D = Duplex (inbound/outbound) pipe *
1477	* 8. Privacy/inheritance flag, one of: *
1478	* 0 = The pipe handle is inherited by child processes. (DEFAULT) *
1479	* 1 = The pipe handle is private to the current process. *
1480	* 9. Write-through flag, one of: *
1481	* 0 = Allow delayed writes (write-behind) to remote pipes. (DEFAULT) *
1482	* 1 = Force immediate writes (write-through) to remote pipes. *
1483	* *
1484	* REXX RETURN VALUE: *
1485	* A four-byte pipe handle. *
1486	* ------------------------------------------------------------------------- */
1487	ULONG APIENTRY Sys2CreateNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1488	{
1489	HPIPE hp;
1490	PSZ pszNPName;
1491	LONG iLimit;
1492	ULONG ulBufOut,
1493	ulBufIn,
1494	ulTimeout = 3000,
1495	flOpen = 0,
1496	flPipe = 1;
1497	CHAR achHandle[ 9 ];
1498	APIRET rc;
1499
1500	// Reset the error indicator
1501	WriteErrorCode( 0, NULL );
1502
1503	// Make sure we have at least three valid arguments (pipe name and sizes)
1504	if ( argc < 3 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\|
1505	( !RXVALIDSTRING(argv[1]) ) \|\| ( !RXVALIDSTRING(argv[2]) ))
1506	return ( 40 );
1507
1508	// (Validate the first argument last to simplify error processing)
1509
1510	// Second argument: pipe outbound buffer size
1511	if (( sscanf( argv[1].strptr, "%u", &ulBufOut )) != 1 ) return ( 40 );
1512
1513	// Third argument: pipe outbound buffer size
1514	if (( sscanf( argv[2].strptr, "%u", &ulBufIn )) != 1 ) return ( 40 );
1515
1516	// Fourth argument: pipe timeout value
1517	if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
1518	if (( sscanf( argv[3].strptr, "%u", &ulTimeout )) != 1 ) return ( 40 );
1519	}
1520
1521	// Fifth argument: instances limit
1522	if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
1523	if (( sscanf( argv[4].strptr, "%d", &iLimit )) != 1 ) return ( 40 );
1524	if (( iLimit > 1 ) && ( iLimit < 255 ))
1525	flPipe = iLimit;
1526	else if ( !iLimit \|\| ( iLimit == -1 ))
1527	flPipe = NP_UNLIMITED_INSTANCES;
1528	else
1529	return ( 40 );
1530	}
1531
1532	// Sixth argument: blocking mode
1533	if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
1534	strupr( argv[5].strptr );
1535	if ( argv[5].strptr[0] == 'N' )
1536	flPipe \|= NP_NOWAIT;
1537	else if ( argv[5].strptr[0] != 'W' )
1538	return ( 40 );
1539	}
1540
1541	// Seventh argument: pipe mode (direction)
1542	if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
1543	strupr( argv[6].strptr );
1544	if (strcspn(argv[6].strptr, "IOD") > 0 ) return ( 40 );
1545	switch ( argv[6].strptr[0] ) {
1546	case 'O': flOpen \|= NP_ACCESS_OUTBOUND; break;
1547	case 'D': flOpen \|= NP_ACCESS_DUPLEX; break;
1548	default : break; // default is 0
1549	}
1550	}
1551
1552	// Eighth argument: inheritance mode
1553	if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
1554	strupr( argv[7].strptr );
1555	if ( argv[7].strptr[0] == '1' )
1556	flOpen \|= NP_NOINHERIT;
1557	else if ( argv[7].strptr[0] != '0' )
1558	return ( 40 );
1559	}
1560
1561	// Ninth argument: write mode
1562	if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
1563	strupr( argv[8].strptr );
1564	if ( argv[8].strptr[0] == '1' )
1565	flOpen \|= NP_NOWRITEBEHIND;
1566	else if ( argv[8].strptr[0] != '0' )
1567	return ( 40 );
1568	}
1569
1570	// Now the first argument: pipe name
1571	pszNPName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
1572	if ( pszNPName == NULL ) {
1573	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
1574	MAKERXSTRING( *prsResult, "0", 1 );
1575	return ( 0 );
1576	}
1577	strncpy( pszNPName, argv[0].strptr, RXSTRLEN(argv[0]) );
1578
1579	// All good, now create the pipe
1580	rc = DosCreateNPipe( pszNPName, &hp, flOpen, flPipe, ulBufOut, ulBufIn, ulTimeout );
1581	if (rc) {
1582	WriteErrorCode( rc, "DosCreateNPipe");
1583	MAKERXSTRING( *prsResult, "", 0 );
1584	return 0;
1585	}
1586
1587	// Return the handle as the REXX result string
1588	sprintf( achHandle, "%8X", hp );
1589	MAKERXSTRING( *prsResult, achHandle, strlen( achHandle ));
1590
1591	free( pszNPName );
1592	return ( 0 );
1593	}
1594
1595
1596	/* ------------------------------------------------------------------------- *
1597	* Sys2ConnectNamedPipe *
1598	* *
1599	* Start 'listening' by allowing clients to connect to a previously-created *
1600	* named pipe. *
1601	* *
1602	* REXX ARGUMENTS: *
1603	* 1. The pipe handle, as returned by Sys2CreateNamedPipe. (REQUIRED) *
1604	* *
1605	* REXX RETURN VALUE: *
1606	* 1 on success, or 0 if an error occurred. *
1607	* ------------------------------------------------------------------------- */
1608	ULONG APIENTRY Sys2ConnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1609	{
1610	HPIPE hp;
1611	ULONG ulState = 0;
1612	APIRET rc;
1613
1614	// Reset the error indicator
1615	WriteErrorCode( 0, NULL );
1616
1617	// Parse the handle
1618	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1619	if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
1620
1621	// Determine the pipe mode
1622	DosQueryNPHState( hp, &ulState );
1623
1624	// Connect the pipe
1625	rc = DosConnectNPipe( hp );
1626
1627	// A non-blocking pipe returns ERROR_PIPE_NOT_CONNECTED on success
1628	if ((( ulState & NP_NOWAIT ) && ( rc != ERROR_PIPE_NOT_CONNECTED )) \|\|
1629	( rc != NO_ERROR ))
1630	{
1631	WriteErrorCode( rc, "DosConnectNPipe");
1632	MAKERXSTRING( *prsResult, "0", 1 );
1633	return ( 0 );
1634	}
1635
1636	// Return 1 on success
1637	MAKERXSTRING( *prsResult, "1", 1 );
1638	return ( 0 );
1639	}
1640
1641
1642	/* ------------------------------------------------------------------------- *
1643	* Sys2DisconnectNamedPipe *
1644	* *
1645	* Unlocks a named pipe after a client has closed its connection. *
1646	* *
1647	* REXX ARGUMENTS: *
1648	* 1. The pipe handle, as returned by Sys2CreateNamedPipe. (REQUIRED) *
1649	* *
1650	* REXX RETURN VALUE: *
1651	* 1 on success, or 0 if an error occurred. *
1652	* ------------------------------------------------------------------------- */
1653	ULONG APIENTRY Sys2DisconnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1654	{
1655	HPIPE hp;
1656	APIRET rc;
1657
1658	// Reset the error indicator
1659	WriteErrorCode( 0, NULL );
1660
1661	// Parse the handle
1662	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1663	if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
1664
1665	// Connect the pipe
1666	rc = DosDisConnectNPipe( hp );
1667	if ( rc != NO_ERROR ) {
1668	WriteErrorCode( rc, "DosDisConnectNPipe");
1669	MAKERXSTRING( *prsResult, "0", 1 );
1670	return ( 0 );
1671	}
1672
1673	// Return 1 on success
1674	MAKERXSTRING( *prsResult, "1", 1 );
1675	return ( 0 );
1676	}
1677
1678
1679	/* ------------------------------------------------------------------------- *
1680	* Sys2CheckNamedPipe *
1681	* *
1682	* Check the status of a named pipe. *
1683	* *
1684	* REXX ARGUMENTS: *
1685	* 1. The pipe handle (from Sys2CreateNamedPipe or DosOpen). (REQUIRED) *
1686	* *
1687	* REXX RETURN VALUE: *
1688	* String of the format "bytes status", where bytes is the number of bytes *
1689	* currently waiting in the pipe, and status is one of: DISCONNECTED, *
1690	* LISTENING, CONNECTED, or CLOSING. *
1691	* ------------------------------------------------------------------------- */
1692	ULONG APIENTRY Sys2CheckNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1693	{
1694	HPIPE hp;
1695	ULONG cbActual, ulState;
1696	AVAILDATA avd;
1697	CHAR szStatus[ US_PIPESTATUS_MAXZ ];
1698	APIRET rc;
1699
1700	// Reset the error indicator
1701	WriteErrorCode( 0, NULL );
1702
1703	// Parse the handle
1704	if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1705	if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
1706
1707	rc = DosPeekNPipe( hp, NULL, 0, &cbActual, &avd, &ulState );
1708	if ( rc != NO_ERROR ) {
1709	WriteErrorCode( rc, "DosPeekNPipe");
1710	MAKERXSTRING( *prsResult, "", 0 );
1711	return ( 0 );
1712	}
1713	sprintf( szStatus, "%u ", avd.cbpipe );
1714	switch ( ulState ) {
1715	case NP_STATE_DISCONNECTED: strncat( szStatus, "DISCONNECTED", US_PIPESTATUS_MAXZ-1 ); break;
1716	case NP_STATE_LISTENING: strncat( szStatus, "LISTENING", US_PIPESTATUS_MAXZ-1 ); break;
1717	case NP_STATE_CONNECTED: strncat( szStatus, "CONNECTED", US_PIPESTATUS_MAXZ-1 ); break;
1718	case NP_STATE_CLOSING: strncat( szStatus, "CLOSING", US_PIPESTATUS_MAXZ-1 ); break;
1719	default: strncat( szStatus, "UNKNOWN", US_PIPESTATUS_MAXZ-1 ); break;
1720	}
1721
1722	if ( ! SaveResultString( prsResult, szStatus, strlen( szStatus ))) {
1723	MAKERXSTRING( *prsResult, "", 0 );
1724	}
1725	return ( 0 );
1726	}
1727
1728
1729	/* ------------------------------------------------------------------------- *
1730	* Sys2Open *
1731	* *
1732	* Wrapper to DosOpenL: open a file or stream (with >2GB support). *
1733	* Direct-DASD mode is not supported by this function, nor is setting the *
1734	* initial extended attributes. *
1735	* *
1736	* REXX ARGUMENTS: *
1737	* 1. Name of file or stream to open. (REQUIRED) *
1738	* 2. Open action flags, must be either "O" (open if exists), "R" (replace *
1739	* if exists), or nothing (fail if exists), optionally followed by "C" *
1740	* (create if file does not exist). If "C" is not specified, the *
1741	* operation will fail if the file does not exist. Note that a value *
1742	* of "" alone will therefore fail automatically. (DEFAULT: "O") *
1743	* In summary, the possible combinations are: *
1744	* O = Open only (if file exists, open it; if not, fail) *
1745	* OC= Open/create (if file exists, open it; if not, create it) *
1746	* R = Replace only (if file exists, replace it; if not, fail) *
1747	* RC= Replace/create (if file exists, replace it; if not, create it) *
1748	* C = Create only (if file exists, fail; if not, create it) *
1749	* (empty) = No-op (if file exists, fail; if not, fail) *
1750	* 3. Access mode flags, one or both of: (DEFAULT: "RW") *
1751	* R = Open file with read access. *
1752	* W = Open file with write access. *
1753	* 4. Sharing mode flags, any combination of: (DEFAULT: "W") *
1754	* R = Deny read access to other processes *
1755	* W = Deny write access to other processes *
1756	* 5. Deny legacy DosOpen access, one of: *
1757	* 0 = Allow DosOpen to access the file (DEFAULT) *
1758	* 1 = Deny access using the DosOpen API *
1759	* 6. Privacy/inheritance flag, one of: *
1760	* 0 = The file handle is inherited by child processes. (DEFAULT) *
1761	* 1 = The file handle is private to the current process. *
1762	* 7. Initial file attributes when creating a file: (DEFAULT: "") *
1763	* A = Archive attribute set *
1764	* D = Directory attribute set *
1765	* S = System attribute set *
1766	* H = Hidden attribute set *
1767	* R = Read-only attribute set *
1768	* 8. Initial file size when creating or replacing a file; ignored if *
1769	* access mode is read-only. (DEFAULT: 0) *
1770	* 9. I/O mode flags, any or all of: (DEFAULT: "") *
1771	* T = Write-through mode (default is normal write) *
1772	* N = No-cache mode (default is to use filesystem cache) *
1773	* S = Sequential access *
1774	* R = Random access *
1775	* * S and R can combine as follows: *
1776	* Neither: No locality known (default) *
1777	* S only: Mainly sequential access *
1778	* R only: Mainly random access *
1779	* Both: Random/sequential (i.e. random with some locality) *
1780	* *
1781	* REXX RETURN VALUE: *
1782	* File handle, or "" in case of error. *
1783	* ------------------------------------------------------------------------- */
1784	ULONG APIENTRY Sys2Open( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1785	{
1786	PSZ pszFile;
1787	HFILE hf;
1788	ULONG fsAction = 0,
1789	fsMode = 0,
1790	ulResult = 0,
1791	ulAttr = FILE_NORMAL;
1792	LONGLONG llSize = {0};
1793	CHAR achHandle[ 9 ];
1794	APIRET rc;
1795
1796
1797	// Reset the error indicator
1798	WriteErrorCode( 0, NULL );
1799
1800	// Make sure we have at least one valid argument (the file name)
1801	if ( argc < 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
1802	return ( 40 );
1803
1804	// (Validate the first argument last to simplify error processing)
1805
1806	// Second argument: open action
1807	if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
1808	strupr( argv[1].strptr );
1809	if ( strcspn(argv[1].strptr, "OCR") > 0 ) return ( 40 );
1810	if ( strchr(argv[1].strptr, 'O'))
1811	fsAction \|= OPEN_ACTION_OPEN_IF_EXISTS;
1812	else if ( strchr(argv[1].strptr, 'R'))
1813	fsAction \|= OPEN_ACTION_REPLACE_IF_EXISTS;
1814	if ( strchr(argv[1].strptr, 'C'))
1815	fsAction \|= OPEN_ACTION_CREATE_IF_NEW;
1816	}
1817	else
1818	fsAction = OPEN_ACTION_OPEN_IF_EXISTS;
1819
1820	// Third argument: access mode
1821	if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
1822	strupr( argv[2].strptr );
1823	if ( strcspn(argv[2].strptr, "RW") > 0 ) return ( 40 );
1824	if ( strchr(argv[2].strptr, 'R')) {
1825	if (strchr(argv[2].strptr, 'W'))
1826	fsMode = OPEN_ACCESS_READWRITE;
1827	else
1828	fsMode = OPEN_ACCESS_READONLY;
1829	}
1830	else if (strchr(argv[2].strptr, 'W'))
1831	fsMode = OPEN_ACCESS_WRITEONLY;
1832	else
1833	return ( 40 );
1834	}
1835	else
1836	fsMode = OPEN_ACCESS_READWRITE;
1837
1838	// Fourth argument: sharing mode
1839	if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
1840	strupr( argv[3].strptr );
1841	if ( strcspn(argv[3].strptr, "RW") > 0 ) return ( 40 );
1842	if ( strchr(argv[3].strptr, 'R')) {
1843	if (strchr(argv[3].strptr, 'W'))
1844	fsMode \|= OPEN_SHARE_DENYREADWRITE;
1845	else
1846	fsMode \|= OPEN_SHARE_DENYREAD;
1847	}
1848	else if (strchr(argv[3].strptr, 'W'))
1849	fsMode \|= OPEN_SHARE_DENYWRITE;
1850	else
1851	fsMode \|= OPEN_SHARE_DENYNONE;
1852	}
1853	else
1854	fsMode \|= OPEN_SHARE_DENYWRITE;
1855
1856	// Fifth argument: deny legacy mode
1857	if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
1858	strupr( argv[4].strptr );
1859	if ( argv[4].strptr[0] == '1' )
1860	fsMode \|= OPEN_SHARE_DENYLEGACY;
1861	else if ( argv[4].strptr[0] != '0' )
1862	return ( 40 );
1863	}
1864
1865	// Sixth argument: inheritance mode
1866	if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
1867	strupr( argv[5].strptr );
1868	if ( argv[5].strptr[0] == '1' )
1869	fsMode \|= OPEN_FLAGS_NOINHERIT;
1870	else if ( argv[5].strptr[0] != '0' )
1871	return ( 40 );
1872	}
1873
1874	// Seventh argument: attributes
1875	if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
1876	strupr( argv[6].strptr );
1877	if (strcspn(argv[6].strptr, "ADSHR") > 0 ) return ( 40 );
1878	if ( strchr(argv[6].strptr, 'A')) ulAttr \|= FILE_ARCHIVED;
1879	if ( strchr(argv[6].strptr, 'D')) ulAttr \|= FILE_DIRECTORY;
1880	if ( strchr(argv[6].strptr, 'S')) ulAttr \|= FILE_SYSTEM;
1881	if ( strchr(argv[6].strptr, 'H')) ulAttr \|= FILE_HIDDEN;
1882	if ( strchr(argv[6].strptr, 'R')) ulAttr \|= FILE_READONLY;
1883	}
1884
1885	// Eighth argument: initial size
1886	if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
1887	if (( sscanf( argv[7].strptr, "%lld", &llSize )) != 1 ) return ( 40 );
1888	}
1889
1890	// Ninth argument: I/O mode flags
1891	if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
1892	strupr( argv[8].strptr );
1893	if (strcspn(argv[8].strptr, "TNSR") > 0 ) return ( 40 );
1894	if ( strchr(argv[8].strptr, 'T')) fsMode \|= OPEN_FLAGS_WRITE_THROUGH;
1895	if ( strchr(argv[8].strptr, 'N')) fsMode \|= OPEN_FLAGS_NO_CACHE;
1896	if ( strchr(argv[8].strptr, 'S')) fsMode \|= OPEN_FLAGS_SEQUENTIAL;
1897	if ( strchr(argv[8].strptr, 'R')) fsMode \|= OPEN_FLAGS_RANDOM;
1898	}
1899
1900	// Now the first argument: file name
1901	pszFile = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
1902	if ( pszFile == NULL ) {
1903	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
1904	MAKERXSTRING( *prsResult, "0", 1 );
1905	return ( 0 );
1906	}
1907	strncpy( pszFile, argv[0].strptr, RXSTRLEN(argv[0]) );
1908
1909	// Try and open the file
1910	rc = DosOpenL( pszFile, &hf, &ulResult, llSize, ulAttr, fsAction, fsMode, NULL );
1911	if (rc) {
1912	WriteErrorCode( rc, "DosOpenL");
1913	MAKERXSTRING( *prsResult, "", 0 );
1914	free( pszFile );
1915	return ( 0 );
1916	}
1917
1918	// Return the handle as the REXX result string
1919	sprintf( achHandle, "%8X", hf );
1920	MAKERXSTRING( *prsResult, achHandle, strlen( achHandle ));
1921
1922	free( pszFile );
1923	return ( 0 );
1924	}
1925
1926
1927	/* ------------------------------------------------------------------------- *
1928	* Sys2Close *
1929	* *
1930	* Wrapper to DosClose: close a file/stream. *
1931	* *
1932	* REXX ARGUMENTS: *
1933	* 1. File handle (returned by Sys2Open) (REQUIRED) *
1934	* *
1935	* REXX RETURN VALUE: *
1936	* 1 on success, or 0 if an error occurred. *
1937	* ------------------------------------------------------------------------- */
1938	ULONG APIENTRY Sys2Close( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1939	{
1940	HFILE hf;
1941	APIRET rc;
1942
1943	// Reset the error indicator
1944	WriteErrorCode( 0, NULL );
1945
1946	// Make sure we have exactly one valid argument (the file handle)
1947	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
1948	return ( 40 );
1949	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
1950
1951	// Close the file
1952	rc = DosClose( hf );
1953	if ( rc != NO_ERROR ) {
1954	WriteErrorCode( rc, "DosClose");
1955	MAKERXSTRING( *prsResult, "0", 1 );
1956	}
1957	else {
1958	MAKERXSTRING( *prsResult, "1", 1 );
1959	}
1960
1961	return ( 0 );
1962	}
1963
1964
1965	/* ------------------------------------------------------------------------- *
1966	* Sys2Seek *
1967	* *
1968	* Wrapper to DosSetFilePtrL: move the read/write pointer to the specified *
1969	* location in a stream. *
1970	* *
1971	* REXX ARGUMENTS: *
1972	* 1. File handle (returned by Sys2Open) (REQUIRED) *
1973	* 2. The signed distance in bytes to move (REQUIRED) *
1974	* 3. Move method, one of: *
1975	* B = Beginning of file *
1976	* C = Current position (DEFAULT) *
1977	* E = End of file *
1978	* *
1979	* REXX RETURN VALUE: *
1980	* The new file position, in bytes. *
1981	* ------------------------------------------------------------------------- */
1982	ULONG APIENTRY Sys2Seek( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1983	{
1984	HFILE hf;
1985	LONGLONG llPos,
1986	llActual;
1987	ULONG ulMethod = FILE_CURRENT;
1988	CHAR achActual[ US_LONGLONG_MAXZ ];
1989	APIRET rc;
1990
1991	// Reset the error indicator
1992	WriteErrorCode( 0, NULL );
1993
1994	// Make sure we have at least two valid arguments
1995	if ( argc < 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
1996	return ( 40 );
1997
1998	// First argument: file handle
1999	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2000
2001	// Second argument: requested offset
2002	if (( sscanf( argv[1].strptr, "%lld", &llPos )) != 1 ) return ( 40 );
2003
2004	// Third argument: starting position
2005	if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
2006	strupr( argv[2].strptr );
2007	if ( strcspn(argv[2].strptr, "BCE") > 0 ) return ( 40 );
2008	switch ( argv[2].strptr[0] ) {
2009	case 'B': ulMethod = FILE_BEGIN; break;
2010	case 'E': ulMethod = FILE_END; break;
2011	default : ulMethod = FILE_CURRENT; break;
2012	}
2013	}
2014
2015	rc = DosSetFilePtrL( hf, llPos, ulMethod, &llActual );
2016	if ( rc != NO_ERROR ) {
2017	WriteErrorCode( rc, "DosSetFilePtrL");
2018	MAKERXSTRING( *prsResult, "", 0 );
2019	return ( 0 );
2020	}
2021
2022	// Return the new position as the REXX result string
2023	sprintf( achActual, "%lld", llActual );
2024	MAKERXSTRING( *prsResult, achActual, strlen( achActual ));
2025
2026	return ( 0 );
2027	}
2028
2029
2030	/* ------------------------------------------------------------------------- *
2031	* Sys2Read *
2032	* *
2033	* Wrapper to DosRead: read bytes from a previously-opened stream. *
2034	* *
2035	* REXX ARGUMENTS: *
2036	* 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
2037	* 2. Number of bytes to read (REQUIRED) *
2038	* *
2039	* REXX RETURN VALUE: *
2040	* String containing the bytes read, or "" in case of error. *
2041	* ------------------------------------------------------------------------- */
2042	ULONG APIENTRY Sys2Read( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
2043	{
2044	HFILE hf;
2045	ULONG cb,
2046	cbActual;
2047	PSZ pszData;
2048	APIRET rc;
2049
2050	// Reset the error indicator
2051	WriteErrorCode( 0, NULL );
2052
2053	// Make sure we have two valid arguments
2054	if ( argc != 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
2055	return ( 40 );
2056
2057	// First argument: handle
2058	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2059
2060	// Second argument: number of bytes to read
2061	if (( sscanf( argv[1].strptr, "%u", &cb )) != 1 ) return ( 40 );
2062	if ( cb < 1 ) return ( 40 );
2063	pszData = (PSZ) malloc( cb );
2064
2065	rc = DosRead( hf, pszData, cb, &cbActual );
2066	if ( rc \|\| !cbActual ) {
2067	WriteErrorCode( rc, "DosRead");
2068	MAKERXSTRING( *prsResult, "", 0 );
2069	goto cleanup;
2070	}
2071	if ( ! SaveResultString( prsResult, pszData, cbActual )) {
2072	MAKERXSTRING( *prsResult, "", 0 );
2073	}
2074
2075	cleanup:
2076	free( pszData );
2077	return ( 0 );
2078	}
2079
2080
2081	/* ------------------------------------------------------------------------- *
2082	* Sys2Write *
2083	* *
2084	* Wrapper to DosWrite: write bytes to a previously-opened stream. *
2085	* *
2086	* REXX ARGUMENTS: *
2087	* 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
2088	* 2. Data to be written (REQUIRED) *
2089	* *
2090	* REXX RETURN VALUE: *
2091	* Number of bytes written. *
2092	* ------------------------------------------------------------------------- */
2093	ULONG APIENTRY Sys2Write( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
2094	{
2095	HFILE hf;
2096	ULONG cbActual;
2097	CHAR szActual[ US_INTEGER_MAXZ ];
2098	APIRET rc;
2099
2100	// Reset the error indicator
2101	WriteErrorCode( 0, NULL );
2102
2103	// Make sure we have two valid arguments
2104	if ( argc != 2 \|\| ( !RXVALIDSTRING(argv[0]) ) \|\| ( !RXVALIDSTRING(argv[1]) ))
2105	return ( 40 );
2106
2107	// First argument: handle
2108	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2109
2110	// (Second argument can be left in standard RXSTRING form)
2111
2112	rc = DosWrite( hf, argv[1].strptr, argv[1].strlength, &cbActual );
2113	if ( rc != NO_ERROR ) {
2114	WriteErrorCode( rc, "DosWrite");
2115	MAKERXSTRING( *prsResult, "0", 1 );
2116	return ( 0 );
2117	}
2118
2119	sprintf( szActual, "%d", cbActual );
2120	MAKERXSTRING( *prsResult, szActual, strlen( szActual ));
2121	return ( 0 );
2122	}
2123
2124
2125	/* ------------------------------------------------------------------------- *
2126	* Sys2SyncBuffer *
2127	* *
2128	* Wrapper to DosResetBuffer: for external files, write the buffer to disk; *
2129	* for pipes, block until the far end of the pipe has read the contents. *
2130	* *
2131	* REXX ARGUMENTS: *
2132	* 1. File handle (returned by Sys2Open) (REQUIRED) *
2133	* *
2134	* REXX RETURN VALUE: *
2135	* 1 on success, or 0 if an error occurred. *
2136	* ------------------------------------------------------------------------- */
2137	ULONG APIENTRY Sys2SyncBuffer( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
2138	{
2139	HFILE hf;
2140	APIRET rc;
2141
2142	// Reset the error indicator
2143	WriteErrorCode( 0, NULL );
2144
2145	// Make sure we have exactly one valid argument (the file handle)
2146	if ( argc != 1 \|\| ( !RXVALIDSTRING(argv[0]) ))
2147	return ( 40 );
2148	if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2149
2150	// Sync the buffer
2151	rc = DosResetBuffer( hf );
2152	if ( rc != NO_ERROR ) {
2153	WriteErrorCode( rc, "DosResetBuffer");
2154	MAKERXSTRING( *prsResult, "0", 1 );
2155	}
2156	else {
2157	MAKERXSTRING( *prsResult, "1", 1 );
2158	}
2159
2160	return ( 0 );
2161	}
2162
2163
2164
2165	// -------------------------------------------------------------------------
2166	// INTERNAL FUNCTIONS
2167	// -------------------------------------------------------------------------
2168
2169
2170	/* ------------------------------------------------------------------------- *
2171	* GetProcess *
2172	* *
2173	* Gets information about the specified process (if found). If pszProgram *
2174	* is NULL, the search is done on the process ID in pulPID; otherwise, the *
2175	* search is done on the executable name in pszProgram (which may or may not *
2176	* include the extension). *
2177	* *
2178	* ARGUMENTS: *
2179	* PSZ pszProgram : The requested executable (process name). (I) *
2180	* PSZ pszFullName: The returned fully-qualified process name. (O) *
2181	* PULONG pulPID : The process ID. (IO) *
2182	* PULONG pulPPID : The returned process parent ID. (O) *
2183	* PULONG pulType : The returned process type. (O) *
2184	* PUSHORT pusPriority: The returned process priority. (O) *
2185	* PULONG pulCPU : The returned process CPU time. (O) *
2186	* *
2187	* RETURNS: ULONG *
2188	* 0 on success, or a non-zero API return code in the case of an error. *
2189	* ------------------------------------------------------------------------- */
2190	ULONG GetProcess( PSZ pszProgram,
2191	PSZ pszFullName,
2192	PULONG pulPID,
2193	PULONG pulPPID,
2194	PULONG pulType,
2195	PUSHORT pusPriority,
2196	PULONG pulCPU )
2197	{
2198	#ifdef USE_DQPS
2199	QSPTRREC *pBuf; // Data returned by DosQProcStatus()
2200	#else
2201	QSPTRREC *pBuf; // Data returned by DosQuerySysState() // 2015-04-23 SHL
2202	#endif
2203	QSPREC *pPrec; // Pointer to process information block
2204	QSTREC *pTrec; // Pointer to thread information block
2205	CHAR szName[ CCHMAXPATH ] = {0}, // Fully-qualified name of process
2206	szNoExt[ CCHMAXPATH ] = {0}; // Program name without extension
2207	PPIB ppib; // pointer to current process info block
2208	PSZ pszCurrent, // Program name of a queried process
2209	c; // Pointer to substring
2210	ULONG ulCPU; // Process CPU time
2211	USHORT usPriority, // Process priority class
2212	i; // index
2213	BOOL fMatch = FALSE; // The current process is a match?
2214	APIRET rc; // Return code
2215
2216
2217	// Use current process when PID is 0 and program name is not specified
2218	if (( pszProgram == NULL ) && ( *pulPID == 0 )) {
2219	rc = DosGetInfoBlocks( NULL, &ppib );
2220	if ( rc != NO_ERROR ) {
2221	WriteErrorCode( rc, "DosGetInfoBlocks");
2222	return ( rc );
2223	}
2224	*pulPID = ppib->pib_ulpid;
2225	}
2226
2227	#ifdef USE_DQPS
2228	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE );
2229	#else
2230	pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE ); // 2015-04-23 SHL
2231	#endif
2232
2233	if ( pBuf == NULL ) {
2234	WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
2235	return ( ERROR_NOT_ENOUGH_MEMORY );
2236	}
2237
2238	#ifdef USE_DQPS
2239	// Get running process information using DosQProcStatus()
2240	rc = DosQProcStatus( pBuf, UL_SSBUFSIZE );
2241	if ( rc != NO_ERROR ) {
2242	WriteErrorCode( rc, "DosQProcStatus");
2243	return ( rc );
2244	}
2245	pPrec = pBuf->pProcRec;
2246	#else
2247	// Get running process information using DosQuerySysState()
2248	rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE );
2249	if ( rc != NO_ERROR ) {
2250	WriteErrorCode( rc, "DosQuerySysState");
2251	return ( rc );
2252	}
2253	pPrec = (QSPREC )(((QSPTRREC)pBuf) -> pProcRec); // 2015-04-23 SHL
2254	#endif
2255
2256	*pulPPID = 0;
2257	*pulType = 0;
2258	*pusPriority = 0;
2259	*pulCPU = 0;
2260	if ( pszProgram != NULL ) *pulPID = 0;
2261	else if ( *pulPID == 0 ) return 0;
2262
2263	// Now look for the specified process
2264	while (( pPrec->RecType == 1 ) && ( !fMatch )) {
2265
2266	if ( pszProgram == NULL ) {
2267	if ( pPrec->pid == *pulPID ) {
2268	fMatch = TRUE;
2269	// Get the program name
2270	if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
2271	sprintf( pszFullName, "--");
2272	else
2273	strcpy( pszFullName, szName );
2274
2275	// Get the process priority
2276	if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
2277	usPriority = 0;
2278
2279	// Get the CPU time of the process by querying each of its threads
2280	ulCPU = 0;
2281	pTrec = pPrec->pThrdRec;
2282	for ( i = 0; i < pPrec->cTCB; i++ ) {
2283	ulCPU += ( pTrec->systime + pTrec->usertime );
2284	pTrec++;
2285	}
2286
2287	*pulPPID = pPrec->ppid;
2288	*pulType = pPrec->type;
2289	*pusPriority = usPriority;
2290	*pulCPU = ulCPU;
2291	}
2292	}
2293	else {
2294	// Get the program name (without the path)
2295	if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
2296	sprintf( pszCurrent, "--");
2297	else
2298	pszCurrent = strrchr( szName, '\\') + 1;
2299
2300	// Create a copy without the extension
2301	strcpy( szNoExt, pszCurrent );
2302	if (( c = strrchr( szNoExt, '.')) != NULL ) memset( c, 0, strlen(c) );
2303	if (( pszCurrent != NULL ) &&
2304	(( stricmp(pszCurrent, pszProgram) == 0 ) \|\| ( stricmp(szNoExt, pszProgram) == 0 )))
2305	{
2306	fMatch = TRUE;
2307
2308	// Get the process priority
2309	if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
2310	usPriority = 0;
2311
2312	// Get the CPU time of the process by querying each of its threads
2313	ulCPU = 0;
2314	pTrec = pPrec->pThrdRec;
2315	for ( i = 0; i < pPrec->cTCB; i++ ) {
2316	ulCPU += ( pTrec->systime + pTrec->usertime );
2317	pTrec++;
2318	}
2319
2320	*pulPID = pPrec->pid;
2321	*pulPPID = pPrec->ppid;
2322	*pulType = pPrec->type;
2323	*pusPriority = usPriority;
2324	*pulCPU = ulCPU;
2325	strcpy( pszFullName, szName );
2326	}
2327	}
2328	pPrec = (QSPREC ) ( (PBYTE) (pPrec->pThrdRec) + ( pPrec->cTCB sizeof(QSTREC) ) );
2329	}
2330	if ( !fMatch ) *pulPID = 0;
2331
2332	free( pBuf );
2333	return ( 0 );
2334	}
2335
2336
2337	/* ------------------------------------------------------------------------- *
2338	* SaveResultString *
2339	* *
2340	* Writes new string contents to the specified RXSTRING, allocating any *
2341	* additional memory that may be required. If the string to be written has *
2342	* zero length, nothing is done. *
2343	* *
2344	* This function should be used in place of MAKERXSTRING if there is a *
2345	* possibility that the string contents could be longer than 256 characters. *
2346	* *
2347	* ARGUMENTS: *
2348	* PRXSTRING prsResult: Pointer to an existing RXSTRING for writing. *
2349	* PCH pchBytes : The string contents to write to prsResult. *
2350	* ULONG ulBytes : The number of bytes in pchBytes to write. *
2351	* *
2352	* RETURNS: BOOL *
2353	* TRUE if prsResult was successfully updated. FALSE otherwise. *
2354	* ------------------------------------------------------------------------- */
2355	BOOL SaveResultString( PRXSTRING prsResult, PCH pchBytes, ULONG ulBytes )
2356	{
2357	ULONG ulRC;
2358	PCH pchNew;
2359
2360	if ( ulBytes == 0 ) return ( FALSE );
2361	if ( ulBytes > 256 ) {
2362	// REXX provides 256 bytes by default; allocate more if necessary
2363	ulRC = DosAllocMem( (PVOID) &pchNew, ulBytes, PAG_WRITE \| PAG_COMMIT );
2364	if ( ulRC != 0 ) {
2365	WriteErrorCode( ulRC, "DosAllocMem");
2366	return ( FALSE );
2367	}
2368	// 2015-06-03 SHL dropped DosFreeMem(prsResult->strptr);
2369	// 2015-06-03 SHL Pointer not allocated by DosAllocMem
2370	prsResult->strptr = pchNew;
2371	}
2372	memcpy( prsResult->strptr, pchBytes, ulBytes );
2373	prsResult->strlength = ulBytes;
2374
2375	return ( TRUE );
2376	}
2377
2378
2379	/* ------------------------------------------------------------------------- *
2380	* WriteStemElement *
2381	* *
2382	* Creates a stem element (compound variable) in the calling REXX program *
2383	* using the REXX shared variable pool interface. *
2384	* *
2385	* ARGUMENTS: *
2386	* PSZ pszStem : The name of the stem (before the '.') *
2387	* ULONG ulIndex : The number of the stem element (after the '.') *
2388	* PSZ pszValue : The value to write to the compound variable. *
2389	* *
2390	* RETURNS: BOOL *
2391	* TRUE on success, FALSE on failure. *
2392	* ------------------------------------------------------------------------- */
2393	BOOL WriteStemElement( PSZ pszStem, ULONG ulIndex, PSZ pszValue )
2394	{
2395	SHVBLOCK shvVar; // REXX shared variable pool block
2396	ULONG ulRc,
2397	ulBytes;
2398	CHAR szCompoundName[ US_COMPOUND_MAXZ ];
2399
2400	sprintf( szCompoundName, "%s.%d", pszStem, ulIndex );
2401	if ( pszValue == NULL ) {
2402	pszValue = "";
2403	ulBytes = 0;
2404	} else {
2405	// 2015-06-03 SHL Was using DosAllocMem and leaking memory
2406	// REXX API does not free this kind of buffer
2407	ulBytes = strlen( pszValue );
2408	}
2409	MAKERXSTRING( shvVar.shvname, szCompoundName, strlen(szCompoundName) );
2410	shvVar.shvvalue.strptr = pszValue;
2411	shvVar.shvvalue.strlength = ulBytes;
2412	shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
2413	shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
2414	shvVar.shvcode = RXSHV_SYSET;
2415	shvVar.shvnext = NULL;
2416	ulRc = RexxVariablePool( &shvVar );
2417	if ( ulRc > 1 ) {
2418	WriteErrorCode( shvVar.shvret, "RexxVariablePool (SHVBLOCK.shvret)");
2419	return FALSE;
2420	}
2421	return TRUE;
2422
2423	}
2424
2425
2426	/* ------------------------------------------------------------------------- *
2427	* WriteErrorCode *
2428	* *
2429	* Writes an error code to a special variable in the calling REXX program *
2430	* using the REXX shared variable pool interface. This is used to return *
2431	* API error codes to the REXX program, since the REXX functions themselves *
2432	* normally return string values. *
2433	* *
2434	* ARGUMENTS: *
2435	* ULONG ulError : The error code returned by the failing API call. *
2436	* PSZ pszContext: A string describing the API call that failed. *
2437	* *
2438	* RETURNS: N/A *
2439	* ------------------------------------------------------------------------- */
2440	void WriteErrorCode( ULONG ulError, PSZ pszContext )
2441	{
2442	SHVBLOCK shvVar; // REXX shared variable pool block
2443	ULONG ulRc;
2444	CHAR szErrorText[ US_ERRSTR_MAXZ ];
2445
2446	if ( pszContext == NULL )
2447	sprintf( szErrorText, "%u", ulError );
2448	else
2449	sprintf( szErrorText, "%u: %s", ulError, pszContext );
2450	MAKERXSTRING( shvVar.shvname, SZ_ERROR_NAME, strlen(SZ_ERROR_NAME) );
2451	MAKERXSTRING( shvVar.shvvalue, szErrorText, strlen(szErrorText) );
2452	shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
2453	shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
2454	shvVar.shvcode = RXSHV_SYSET;
2455	shvVar.shvnext = NULL;
2456	ulRc = RexxVariablePool( &shvVar );
2457	if ( ulRc > 1 )
2458	printf("Unable to set %s: rc = %d, ulRc = %x\n", shvVar.shvname.strptr, shvVar.shvret, ulRc ); /* 2015-04-23 SHL */
2459	}
2460
2461

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

Download in other formats: