source: rxutilex/trunk/rxutilex.c@ 33

Last change on this file since 33 was 33, checked in by Alex Taylor, 9 years ago

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