source: rxutilex/trunk/rxutilex.c@ 22

Last change on this file since 22 was 22, checked in by Alex Taylor, 11 years ago

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