source: rxutilex/trunk/rxutilex.c@ 26

Last change on this file since 26 was 26, checked in by Alex Taylor, 10 years ago

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