source: rxutilex/trunk/rxutilex.c@ 31

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

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