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
RevLine 
[4]1/******************************************************************************
2 * REXX Utility Functions - Extended (RXUTILEX.DLL) *
[16]3 * (C) 2011, 2014 Alex Taylor. *
[4]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
[16]45#define INCL_DOSERRORS
[4]46#define INCL_DOSMISC
[16]47#define INCL_DOSMODULEMGR
48#define INCL_DOSNMPIPES
[4]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 )
64USHORT APIENTRY16 DosGetPrty( USHORT usScope, PUSHORT pusPriority, USHORT pid );
65
66#ifdef USE_DQPS
67#pragma import( DosQProcStatus, "DosQProcStatus", "DOSCALL1", 154 )
68USHORT 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
[16]75#define SZ_VERSION "0.0.5" // Current version of this library
[4]76
77// Maximum string lengths...
78#define US_COMPOUND_MAXZ 250 // ...of a compound variable
[16]79#define US_INTEGER_MAXZ 12 // ...of a 32-bit integer string
80#define US_LONGLONG_MAXZ 21 // ...of a 64-bit integer string
[4]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
[16]85#define US_PIPESTATUS_MAXZ 128 // ...of a pipe status string
[4]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
96static 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",
[16]109 "Sys2CreateNamedPipe",
110 "Sys2ConnectNamedPipe",
111 "Sys2DisconnectNamedPipe",
112 "Sys2CheckNamedPipe",
113 "Sys2Open",
114 "Sys2Close",
115 "Sys2Seek",
116 "Sys2Read",
117 "Sys2Write",
[4]118 "Sys2Version"
119};
120
121
122// FUNCTION DECLARATIONS
123
124// Exported REXX functions
125RexxFunctionHandler Sys2LoadFuncs;
126RexxFunctionHandler Sys2DropFuncs;
127RexxFunctionHandler Sys2Version;
128
129RexxFunctionHandler Sys2FormatTime;
130RexxFunctionHandler Sys2GetEpochTime;
131
132RexxFunctionHandler Sys2GetClipboardText;
133RexxFunctionHandler Sys2PutClipboardText;
134
135RexxFunctionHandler Sys2QueryProcess;
136RexxFunctionHandler Sys2QueryProcessList;
137RexxFunctionHandler Sys2KillProcess;
138RexxFunctionHandler Sys2QueryForegroundProcess;
139
140RexxFunctionHandler Sys2QueryPhysicalMemory;
141
142RexxFunctionHandler Sys2LocateDLL;
143RexxFunctionHandler Sys2ReplaceModule;
144
[16]145// RexxFunctionHandler Sys2ReplaceObjectClass;
[4]146
[16]147RexxFunctionHandler Sys2CreateNamedPipe;
148RexxFunctionHandler Sys2ConnectNamedPipe;
149RexxFunctionHandler Sys2DisconnectNamedPipe;
150RexxFunctionHandler Sys2CheckNamedPipe;
[4]151
[16]152RexxFunctionHandler Sys2Open;
153RexxFunctionHandler Sys2Close;
154RexxFunctionHandler Sys2Seek;
155RexxFunctionHandler Sys2Read;
156RexxFunctionHandler Sys2Write;
157
158
[4]159// Private internal functions
160ULONG GetProcess( PSZ pszProgram, PSZ pszFullName, PULONG pulPID, PULONG pulPPID, PULONG pulType, PUSHORT pusPriority, PULONG pulCPU );
161BOOL SaveResultString( PRXSTRING prsResult, PCH pchBytes, ULONG ulBytes );
162BOOL WriteStemElement( PSZ pszStem, ULONG ulIndex, PSZ pszValue );
163void 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 * ------------------------------------------------------------------------- */
179ULONG 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 * ------------------------------------------------------------------------- */
205ULONG 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 * ------------------------------------------------------------------------- */
231ULONG 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 * ------------------------------------------------------------------------- */
261ULONG 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 );
[16]324 strncpy( pszShareMem, argv[0].strptr, ulBytes - 1 );
[4]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 * ------------------------------------------------------------------------- */
358ULONG 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 * ------------------------------------------------------------------------- */
452ULONG 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 * ------------------------------------------------------------------------- */
536ULONG 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 * ------------------------------------------------------------------------- */
633ULONG 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 * ------------------------------------------------------------------------- */
756ULONG 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 * ------------------------------------------------------------------------- */
800ULONG 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 * ------------------------------------------------------------------------- */
843ULONG 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 * ------------------------------------------------------------------------- */
926ULONG 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 * ------------------------------------------------------------------------- */
1067ULONG 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 );
[16]1160 free( pszSetTZ );
[4]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 );
[16]1177 free( pszSetTZ );
[4]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 * ------------------------------------------------------------------------- */
1203ULONG 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
[16]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 * ------------------------------------------------------------------------- */
1280ULONG 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;
[4]1292
[16]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 * ------------------------------------------------------------------------- */
1401ULONG 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 * ------------------------------------------------------------------------- */
1438ULONG 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 * ------------------------------------------------------------------------- */
1477ULONG 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 * ------------------------------------------------------------------------- */
1569ULONG 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 * ------------------------------------------------------------------------- */
1723ULONG 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 * ------------------------------------------------------------------------- */
1767ULONG 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 * ------------------------------------------------------------------------- */
1827ULONG 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
1860cleanup:
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 * ------------------------------------------------------------------------- */
1878ULONG 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
[4]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 * ------------------------------------------------------------------------- */
1934ULONG 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 * ------------------------------------------------------------------------- */
2088BOOL 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 * ------------------------------------------------------------------------- */
2125BOOL 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 * ------------------------------------------------------------------------- */
2177void 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.