source: rxutilex/trunk/rxutilex.c@ 42

Last change on this file since 42 was 42, checked in by Alex Taylor, 7 years ago

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