source: rxutilex/trunk/rxutilex.c@ 21

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

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