Context Navigation

source: rxutilex/trunk/rxutilex.c@ 16

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

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

Download in other formats: