Context Navigation

source: rxutilex/trunk/rxutilex.c@ 23

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

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

Download in other formats: