source: rxutilex/trunk/rxutilex.c@ 29

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

Added optional second parameter to Sys2LocateDLL, and updated/clarified function documentation.
File size: 108.1 KB
RevLine 
[4]1/******************************************************************************
2 * REXX Utility Functions - Extended (RXUTILEX.DLL) *
[16]3 * (C) 2011, 2014 Alex Taylor. *
[4]4 * *
5 * LICENSE: *
6 * *
7 * Redistribution and use in source and binary forms, with or without *
8 * modification, are permitted provided that the following conditions are *
9 * met: *
10 * *
11 * 1. Redistributions of source code must retain the above copyright *
12 * notice, this list of conditions and the following disclaimer. *
13 * *
14 * 2. Redistributions in binary form must reproduce the above copyright *
15 * notice, this list of conditions and the following disclaimer in the *
16 * documentation and/or other materials provided with the distribution. *
17 * *
18 * 3. The name of the author may not be used to endorse or promote products *
19 * derived from this software without specific prior written permission. *
20 * *
21 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ''AS IS'' AND ANY EXPRESS OR *
22 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED *
23 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE *
24 * DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, *
25 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES *
26 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR *
27 * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) *
28 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, *
29 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN *
30 * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE *
31 * POSSIBILITY OF SUCH DAMAGE. *
32 * *
33 ******************************************************************************/
34
35// Uncomment to use DosQProcStatus() instead of DosQuerySysState().
36// -- This was mostly put in place for early testing to see if either function
37// was more/less reliable than the other. In practice, DosQuerySysState()
38// should probably be used.
39// #define USE_DQPS
40
[23]41// Uncomment to use legacy C style locale data instead of the OS/2 ULS library
42#define LEGACY_C_LOCALE
[4]43
44#define INCL_WINATOM
45#define INCL_WINCLIPBOARD
46#define INCL_WINERRORS
[16]47#define INCL_DOSERRORS
[4]48#define INCL_DOSMISC
[16]49#define INCL_DOSMODULEMGR
50#define INCL_DOSNMPIPES
[4]51#define INCL_DOSPROCESS
52#define INCL_DOSPROFILE
53#ifndef OS2_INCLUDED
54 #include <os2.h>
55#endif
[23]56
[4]57#include <stdio.h>
58#include <stdlib.h>
59#include <string.h>
60#include <time.h>
[23]61
62#ifdef LEGACY_C_LOCALE
63 #include <locale.h>
64 #include <nl_types.h>
65 #include <langinfo.h>
66#else
67 #include <unidef.h>
68#endif
69
[4]70#define INCL_RXSHV
71#define INCL_RXFUNC
72#include <rexxsaa.h>
73
74#pragma import( DosGetPrty, "DosGetPrty", "DOSCALL1", 9 )
75USHORT APIENTRY16 DosGetPrty( USHORT usScope, PUSHORT pusPriority, USHORT pid );
76
77#ifdef USE_DQPS
78#pragma import( DosQProcStatus, "DosQProcStatus", "DOSCALL1", 154 )
79USHORT APIENTRY16 DosQProcStatus( PVOID pBuf, USHORT cbBuf );
80#endif
81
82// CONSTANTS
83
84#define SZ_LIBRARY_NAME "RXUTILEX" // Name of this library
85#define SZ_ERROR_NAME "SYS2ERR" // REXX variable used to store error codes
[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: *
[29]1384 * 1. The name of the DLL to search for. (REQUIRED) *
1385 * 2. Flag to limit search context, must be one of: *
1386 * ALL : Search for both loaded and loadable DLLs (DEFAULT) *
1387 * LOADEDONLY: Search only for currently-loaded DLLs *
1388 * Only the first letter (A/L) is significant. *
[4]1389 * *
1390 * REXX RETURN VALUE: *
1391 * The fully-qualified path of the DLL, if found (or '' if not found). *
1392 * ------------------------------------------------------------------------- */
1393ULONG APIENTRY Sys2LocateDLL( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1394{
1395 HMODULE hmod;
1396 CHAR achModuleName[ CCHMAXPATH ];
[29]1397 BOOL bLoadedOnly = FALSE,
1398 bUnload = FALSE;
[4]1399 APIRET rc;
1400
1401 // Reset the error indicator
1402 WriteErrorCode( 0, NULL );
1403
[29]1404 if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
[4]1405
[29]1406 // Second argument: flag
1407 if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
1408 strupr( argv[1].strptr );
1409 if ( strcspn(argv[1].strptr, "AL") > 0 ) return ( 40 );
1410 switch ( argv[1].strptr[0] ) {
1411 case 'A': bLoadedOnly = FALSE; break;
1412 case 'L': bLoadedOnly = TRUE; break;
1413 default : return ( 40 );
1414 }
1415 }
1416
[4]1417 // See if the DLL is already loaded
1418 rc = DosQueryModuleHandle( argv[0].strptr, &hmod );
1419 if ( rc ) {
[29]1420 // Guess not...
1421 if ( bLoadedOnly ) {
1422 // Just return
1423 MAKERXSTRING( *prsResult, "", 0 );
1424 return 0;
1425 }
1426 // Try to load it now
[4]1427 rc = DosLoadModule( NULL, 0, argv[0].strptr, &hmod );
1428 if ( rc ) {
1429 WriteErrorCode( rc, "DosLoadModule");
1430 MAKERXSTRING( *prsResult, "", 0 );
1431 return 0;
1432 }
1433 bUnload = TRUE;
1434 }
1435
1436 // Get the full path name of the DLL
1437 rc = DosQueryModuleName( hmod, CCHMAXPATH, achModuleName );
1438 if ( rc ) {
1439 WriteErrorCode( rc, "DosQueryModuleName");
1440 MAKERXSTRING( *prsResult, "", 0 );
1441 if ( bUnload ) DosFreeModule( hmod );
1442 return 0;
1443 }
1444
1445 // Free the module if we loaded it ourselves
1446 if ( bUnload ) DosFreeModule( hmod );
1447
1448 // Return the full path name
1449 if ( ! SaveResultString( prsResult, achModuleName, strlen( achModuleName ))) {
1450 MAKERXSTRING( *prsResult, "", 0 );
1451 }
1452
1453 return 0;
1454}
1455
1456
[16]1457/* ------------------------------------------------------------------------- *
1458 * Sys2CreateNamedPipe *
1459 * *
1460 * Create a named pipe with the specified name and parameters. Only byte *
1461 * mode is supported; message mode is not. *
1462 * *
1463 * REXX ARGUMENTS: *
1464 * 1. The name of the pipe, in the form "\PIPE\something". (REQUIRED) *
1465 * 2. The size of the outbound buffer, in bytes. (REQUIRED) *
1466 * 3. The size of the inbound buffer, in bytes. (REQUIRED) *
1467 * 4. The pipe's timeout value, in milliseconds. (DEFAULT: 3000) *
1468 * 5. The number of simultaneous instances of this pipe which are allowed. *
1469 * Must be between 1 and 254, or 0 indicating no limit. (DEFAULT: 1) *
1470 * 6. Pipe blocking mode, one of: *
1471 * W = WAIT mode, read and write block waiting for data. (DEFAULT) *
1472 * N = NOWAIT mode, read and write return immediately. *
1473 * 7. Pipe mode, one of: *
1474 * I = Inbound pipe (DEFAULT) *
1475 * O = Outbound pipe *
1476 * D = Duplex (inbound/outbound) pipe *
1477 * 8. Privacy/inheritance flag, one of: *
1478 * 0 = The pipe handle is inherited by child processes. (DEFAULT) *
1479 * 1 = The pipe handle is private to the current process. *
1480 * 9. Write-through flag, one of: *
1481 * 0 = Allow delayed writes (write-behind) to remote pipes. (DEFAULT) *
1482 * 1 = Force immediate writes (write-through) to remote pipes. *
1483 * *
1484 * REXX RETURN VALUE: *
1485 * A four-byte pipe handle. *
1486 * ------------------------------------------------------------------------- */
1487ULONG APIENTRY Sys2CreateNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1488{
1489 HPIPE hp;
1490 PSZ pszNPName;
1491 LONG iLimit;
1492 ULONG ulBufOut,
1493 ulBufIn,
1494 ulTimeout = 3000,
1495 flOpen = 0,
1496 flPipe = 1;
1497 CHAR achHandle[ 9 ];
1498 APIRET rc;
[4]1499
[16]1500 // Reset the error indicator
1501 WriteErrorCode( 0, NULL );
1502
1503 // Make sure we have at least three valid arguments (pipe name and sizes)
1504 if ( argc < 3 || ( !RXVALIDSTRING(argv[0]) ) ||
1505 ( !RXVALIDSTRING(argv[1]) ) || ( !RXVALIDSTRING(argv[2]) ))
1506 return ( 40 );
1507
1508 // (Validate the first argument last to simplify error processing)
1509
1510 // Second argument: pipe outbound buffer size
1511 if (( sscanf( argv[1].strptr, "%u", &ulBufOut )) != 1 ) return ( 40 );
1512
1513 // Third argument: pipe outbound buffer size
1514 if (( sscanf( argv[2].strptr, "%u", &ulBufIn )) != 1 ) return ( 40 );
1515
1516 // Fourth argument: pipe timeout value
1517 if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
1518 if (( sscanf( argv[3].strptr, "%u", &ulTimeout )) != 1 ) return ( 40 );
1519 }
1520
1521 // Fifth argument: instances limit
1522 if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
1523 if (( sscanf( argv[4].strptr, "%d", &iLimit )) != 1 ) return ( 40 );
1524 if (( iLimit > 1 ) && ( iLimit < 255 ))
1525 flPipe = iLimit;
1526 else if ( !iLimit || ( iLimit == -1 ))
1527 flPipe = NP_UNLIMITED_INSTANCES;
1528 else
1529 return ( 40 );
1530 }
1531
1532 // Sixth argument: blocking mode
1533 if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
1534 strupr( argv[5].strptr );
1535 if ( argv[5].strptr[0] == 'N' )
1536 flPipe |= NP_NOWAIT;
1537 else if ( argv[5].strptr[0] != 'W' )
1538 return ( 40 );
1539 }
1540
1541 // Seventh argument: pipe mode (direction)
1542 if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
1543 strupr( argv[6].strptr );
1544 if (strcspn(argv[6].strptr, "IOD") > 0 ) return ( 40 );
1545 switch ( argv[6].strptr[0] ) {
1546 case 'O': flOpen |= NP_ACCESS_OUTBOUND; break;
1547 case 'D': flOpen |= NP_ACCESS_DUPLEX; break;
1548 default : break; // default is 0
1549 }
1550 }
1551
1552 // Eighth argument: inheritance mode
1553 if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
1554 strupr( argv[7].strptr );
1555 if ( argv[7].strptr[0] == '1' )
1556 flOpen |= NP_NOINHERIT;
1557 else if ( argv[7].strptr[0] != '0' )
1558 return ( 40 );
1559 }
1560
1561 // Ninth argument: write mode
1562 if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
1563 strupr( argv[8].strptr );
1564 if ( argv[8].strptr[0] == '1' )
1565 flOpen |= NP_NOWRITEBEHIND;
1566 else if ( argv[8].strptr[0] != '0' )
1567 return ( 40 );
1568 }
1569
1570 // Now the first argument: pipe name
1571 pszNPName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
1572 if ( pszNPName == NULL ) {
1573 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
1574 MAKERXSTRING( *prsResult, "0", 1 );
1575 return ( 0 );
1576 }
1577 strncpy( pszNPName, argv[0].strptr, RXSTRLEN(argv[0]) );
1578
1579 // All good, now create the pipe
1580 rc = DosCreateNPipe( pszNPName, &hp, flOpen, flPipe, ulBufOut, ulBufIn, ulTimeout );
1581 if (rc) {
1582 WriteErrorCode( rc, "DosCreateNPipe");
1583 MAKERXSTRING( *prsResult, "", 0 );
1584 return 0;
1585 }
1586
1587 // Return the handle as the REXX result string
1588 sprintf( achHandle, "%8X", hp );
1589 MAKERXSTRING( *prsResult, achHandle, strlen( achHandle ));
1590
1591 free( pszNPName );
1592 return ( 0 );
1593}
1594
1595
1596/* ------------------------------------------------------------------------- *
1597 * Sys2ConnectNamedPipe *
1598 * *
1599 * Start 'listening' by allowing clients to connect to a previously-created *
1600 * named pipe. *
1601 * *
1602 * REXX ARGUMENTS: *
1603 * 1. The pipe handle, as returned by Sys2CreateNamedPipe. (REQUIRED) *
1604 * *
1605 * REXX RETURN VALUE: *
1606 * 1 on success, or 0 if an error occurred. *
1607 * ------------------------------------------------------------------------- */
1608ULONG APIENTRY Sys2ConnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1609{
1610 HPIPE hp;
[26]1611 ULONG ulState = 0;
[16]1612 APIRET rc;
1613
1614 // Reset the error indicator
1615 WriteErrorCode( 0, NULL );
1616
1617 // Parse the handle
1618 if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1619 if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
1620
[26]1621 // Determine the pipe mode
1622 DosQueryNPHState( hp, &ulState );
1623
[16]1624 // Connect the pipe
1625 rc = DosConnectNPipe( hp );
[26]1626
1627 // A non-blocking pipe returns ERROR_PIPE_NOT_CONNECTED on success
1628 if ((( ulState & NP_NOWAIT ) && ( rc != ERROR_PIPE_NOT_CONNECTED )) ||
1629 ( rc != NO_ERROR ))
1630 {
[16]1631 WriteErrorCode( rc, "DosConnectNPipe");
1632 MAKERXSTRING( *prsResult, "0", 1 );
1633 return ( 0 );
1634 }
1635
1636 // Return 1 on success
1637 MAKERXSTRING( *prsResult, "1", 1 );
1638 return ( 0 );
1639}
1640
1641
1642/* ------------------------------------------------------------------------- *
1643 * Sys2DisconnectNamedPipe *
1644 * *
1645 * Unlocks a named pipe after a client has closed its connection. *
1646 * *
1647 * REXX ARGUMENTS: *
1648 * 1. The pipe handle, as returned by Sys2CreateNamedPipe. (REQUIRED) *
1649 * *
1650 * REXX RETURN VALUE: *
1651 * 1 on success, or 0 if an error occurred. *
1652 * ------------------------------------------------------------------------- */
1653ULONG APIENTRY Sys2DisconnectNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1654{
1655 HPIPE hp;
1656 APIRET rc;
1657
1658 // Reset the error indicator
1659 WriteErrorCode( 0, NULL );
1660
1661 // Parse the handle
1662 if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1663 if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
1664
1665 // Connect the pipe
1666 rc = DosDisConnectNPipe( hp );
1667 if ( rc != NO_ERROR ) {
1668 WriteErrorCode( rc, "DosDisConnectNPipe");
1669 MAKERXSTRING( *prsResult, "0", 1 );
1670 return ( 0 );
1671 }
1672
1673 // Return 1 on success
1674 MAKERXSTRING( *prsResult, "1", 1 );
1675 return ( 0 );
1676}
1677
1678
1679/* ------------------------------------------------------------------------- *
1680 * Sys2CheckNamedPipe *
1681 * *
1682 * Check the status of a named pipe. *
1683 * *
1684 * REXX ARGUMENTS: *
1685 * 1. The pipe handle (from Sys2CreateNamedPipe or DosOpen). (REQUIRED) *
1686 * *
1687 * REXX RETURN VALUE: *
1688 * String of the format "bytes status", where bytes is the number of bytes *
1689 * currently waiting in the pipe, and status is one of: DISCONNECTED, *
1690 * LISTENING, CONNECTED, or CLOSING. *
1691 * ------------------------------------------------------------------------- */
1692ULONG APIENTRY Sys2CheckNamedPipe( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1693{
1694 HPIPE hp;
1695 ULONG cbActual, ulState;
1696 AVAILDATA avd;
1697 CHAR szStatus[ US_PIPESTATUS_MAXZ ];
1698 APIRET rc;
1699
1700 // Reset the error indicator
1701 WriteErrorCode( 0, NULL );
1702
1703 // Parse the handle
1704 if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1705 if (( sscanf( argv[0].strptr, "%8X", &hp )) != 1 ) return ( 40 );
1706
1707 rc = DosPeekNPipe( hp, NULL, 0, &cbActual, &avd, &ulState );
1708 if ( rc != NO_ERROR ) {
1709 WriteErrorCode( rc, "DosPeekNPipe");
1710 MAKERXSTRING( *prsResult, "", 0 );
1711 return ( 0 );
1712 }
1713 sprintf( szStatus, "%u ", avd.cbpipe );
1714 switch ( ulState ) {
1715 case NP_STATE_DISCONNECTED: strncat( szStatus, "DISCONNECTED", US_PIPESTATUS_MAXZ-1 ); break;
1716 case NP_STATE_LISTENING: strncat( szStatus, "LISTENING", US_PIPESTATUS_MAXZ-1 ); break;
1717 case NP_STATE_CONNECTED: strncat( szStatus, "CONNECTED", US_PIPESTATUS_MAXZ-1 ); break;
1718 case NP_STATE_CLOSING: strncat( szStatus, "CLOSING", US_PIPESTATUS_MAXZ-1 ); break;
1719 default: strncat( szStatus, "UNKNOWN", US_PIPESTATUS_MAXZ-1 ); break;
1720 }
1721
1722 if ( ! SaveResultString( prsResult, szStatus, strlen( szStatus ))) {
1723 MAKERXSTRING( *prsResult, "", 0 );
1724 }
1725 return ( 0 );
1726}
1727
1728
1729/* ------------------------------------------------------------------------- *
1730 * Sys2Open *
1731 * *
1732 * Wrapper to DosOpenL: open a file or stream (with >2GB support). *
1733 * Direct-DASD mode is not supported by this function, nor is setting the *
1734 * initial extended attributes. *
1735 * *
1736 * REXX ARGUMENTS: *
1737 * 1. Name of file or stream to open. (REQUIRED) *
1738 * 2. Open action flags, must be either "O" (open if exists), "R" (replace *
1739 * if exists), or nothing (fail if exists), optionally followed by "C" *
1740 * (create if file does not exist). If "C" is not specified, the *
1741 * operation will fail if the file does not exist. Note that a value *
1742 * of "" alone will therefore fail automatically. (DEFAULT: "O") *
1743 * In summary, the possible combinations are: *
1744 * O = Open only (if file exists, open it; if not, fail) *
1745 * OC= Open/create (if file exists, open it; if not, create it) *
1746 * R = Replace only (if file exists, replace it; if not, fail) *
1747 * RC= Replace/create (if file exists, replace it; if not, create it) *
1748 * C = Create only (if file exists, fail; if not, create it) *
1749 * (empty) = No-op (if file exists, fail; if not, fail) *
1750 * 3. Access mode flags, one or both of: (DEFAULT: "RW") *
1751 * R = Open file with read access. *
1752 * W = Open file with write access. *
1753 * 4. Sharing mode flags, any combination of: (DEFAULT: "W") *
1754 * R = Deny read access to other processes *
1755 * W = Deny write access to other processes *
1756 * 5. Deny legacy DosOpen access, one of: *
1757 * 0 = Allow DosOpen to access the file (DEFAULT) *
1758 * 1 = Deny access using the DosOpen API *
1759 * 6. Privacy/inheritance flag, one of: *
1760 * 0 = The file handle is inherited by child processes. (DEFAULT) *
1761 * 1 = The file handle is private to the current process. *
1762 * 7. Initial file attributes when creating a file: (DEFAULT: "") *
1763 * A = Archive attribute set *
1764 * D = Directory attribute set *
1765 * S = System attribute set *
1766 * H = Hidden attribute set *
1767 * R = Read-only attribute set *
1768 * 8. Initial file size when creating or replacing a file; ignored if *
1769 * access mode is read-only. (DEFAULT: 0) *
1770 * 9. I/O mode flags, any or all of: (DEFAULT: "") *
1771 * T = Write-through mode (default is normal write) *
1772 * N = No-cache mode (default is to use filesystem cache) *
1773 * S = Sequential access *
1774 * R = Random access *
1775 * * S and R can combine as follows: *
1776 * Neither: No locality known (default) *
1777 * S only: Mainly sequential access *
1778 * R only: Mainly random access *
1779 * Both: Random/sequential (i.e. random with some locality) *
1780 * *
1781 * REXX RETURN VALUE: *
1782 * File handle, or "" in case of error. *
1783 * ------------------------------------------------------------------------- */
1784ULONG APIENTRY Sys2Open( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1785{
1786 PSZ pszFile;
1787 HFILE hf;
1788 ULONG fsAction = 0,
1789 fsMode = 0,
1790 ulResult = 0,
1791 ulAttr = FILE_NORMAL;
1792 LONGLONG llSize = {0};
1793 CHAR achHandle[ 9 ];
1794 APIRET rc;
1795
1796
1797 // Reset the error indicator
1798 WriteErrorCode( 0, NULL );
1799
1800 // Make sure we have at least one valid argument (the file name)
1801 if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) ))
1802 return ( 40 );
1803
1804 // (Validate the first argument last to simplify error processing)
1805
1806 // Second argument: open action
1807 if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
1808 strupr( argv[1].strptr );
1809 if ( strcspn(argv[1].strptr, "OCR") > 0 ) return ( 40 );
1810 if ( strchr(argv[1].strptr, 'O'))
1811 fsAction |= OPEN_ACTION_OPEN_IF_EXISTS;
1812 else if ( strchr(argv[1].strptr, 'R'))
1813 fsAction |= OPEN_ACTION_REPLACE_IF_EXISTS;
1814 if ( strchr(argv[1].strptr, 'C'))
1815 fsAction |= OPEN_ACTION_CREATE_IF_NEW;
1816 }
1817 else
1818 fsAction = OPEN_ACTION_OPEN_IF_EXISTS;
1819
1820 // Third argument: access mode
1821 if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
1822 strupr( argv[2].strptr );
1823 if ( strcspn(argv[2].strptr, "RW") > 0 ) return ( 40 );
1824 if ( strchr(argv[2].strptr, 'R')) {
1825 if (strchr(argv[2].strptr, 'W'))
1826 fsMode = OPEN_ACCESS_READWRITE;
1827 else
1828 fsMode = OPEN_ACCESS_READONLY;
1829 }
1830 else if (strchr(argv[2].strptr, 'W'))
1831 fsMode = OPEN_ACCESS_WRITEONLY;
1832 else
1833 return ( 40 );
1834 }
1835 else
1836 fsMode = OPEN_ACCESS_READWRITE;
1837
1838 // Fourth argument: sharing mode
1839 if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
1840 strupr( argv[3].strptr );
1841 if ( strcspn(argv[3].strptr, "RW") > 0 ) return ( 40 );
1842 if ( strchr(argv[3].strptr, 'R')) {
1843 if (strchr(argv[3].strptr, 'W'))
1844 fsMode |= OPEN_SHARE_DENYREADWRITE;
1845 else
1846 fsMode |= OPEN_SHARE_DENYREAD;
1847 }
1848 else if (strchr(argv[3].strptr, 'W'))
1849 fsMode |= OPEN_SHARE_DENYWRITE;
1850 else
1851 fsMode |= OPEN_SHARE_DENYNONE;
1852 }
1853 else
1854 fsMode |= OPEN_SHARE_DENYWRITE;
1855
1856 // Fifth argument: deny legacy mode
1857 if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
1858 strupr( argv[4].strptr );
1859 if ( argv[4].strptr[0] == '1' )
1860 fsMode |= OPEN_SHARE_DENYLEGACY;
1861 else if ( argv[4].strptr[0] != '0' )
1862 return ( 40 );
1863 }
1864
1865 // Sixth argument: inheritance mode
1866 if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
1867 strupr( argv[5].strptr );
1868 if ( argv[5].strptr[0] == '1' )
1869 fsMode |= OPEN_FLAGS_NOINHERIT;
1870 else if ( argv[5].strptr[0] != '0' )
1871 return ( 40 );
1872 }
1873
1874 // Seventh argument: attributes
1875 if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
1876 strupr( argv[6].strptr );
1877 if (strcspn(argv[6].strptr, "ADSHR") > 0 ) return ( 40 );
1878 if ( strchr(argv[6].strptr, 'A')) ulAttr |= FILE_ARCHIVED;
1879 if ( strchr(argv[6].strptr, 'D')) ulAttr |= FILE_DIRECTORY;
1880 if ( strchr(argv[6].strptr, 'S')) ulAttr |= FILE_SYSTEM;
1881 if ( strchr(argv[6].strptr, 'H')) ulAttr |= FILE_HIDDEN;
1882 if ( strchr(argv[6].strptr, 'R')) ulAttr |= FILE_READONLY;
1883 }
1884
1885 // Eighth argument: initial size
1886 if ( argc >= 8 && RXVALIDSTRING(argv[7]) ) {
1887 if (( sscanf( argv[7].strptr, "%lld", &llSize )) != 1 ) return ( 40 );
1888 }
1889
1890 // Ninth argument: I/O mode flags
1891 if ( argc >= 9 && RXVALIDSTRING(argv[8]) ) {
1892 strupr( argv[8].strptr );
1893 if (strcspn(argv[8].strptr, "TNSR") > 0 ) return ( 40 );
1894 if ( strchr(argv[8].strptr, 'T')) fsMode |= OPEN_FLAGS_WRITE_THROUGH;
1895 if ( strchr(argv[8].strptr, 'N')) fsMode |= OPEN_FLAGS_NO_CACHE;
1896 if ( strchr(argv[8].strptr, 'S')) fsMode |= OPEN_FLAGS_SEQUENTIAL;
1897 if ( strchr(argv[8].strptr, 'R')) fsMode |= OPEN_FLAGS_RANDOM;
1898 }
1899
1900 // Now the first argument: file name
1901 pszFile = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
1902 if ( pszFile == NULL ) {
1903 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
1904 MAKERXSTRING( *prsResult, "0", 1 );
1905 return ( 0 );
1906 }
1907 strncpy( pszFile, argv[0].strptr, RXSTRLEN(argv[0]) );
1908
1909 // Try and open the file
1910 rc = DosOpenL( pszFile, &hf, &ulResult, llSize, ulAttr, fsAction, fsMode, NULL );
1911 if (rc) {
1912 WriteErrorCode( rc, "DosOpenL");
1913 MAKERXSTRING( *prsResult, "", 0 );
1914 free( pszFile );
1915 return ( 0 );
1916 }
1917
1918 // Return the handle as the REXX result string
1919 sprintf( achHandle, "%8X", hf );
1920 MAKERXSTRING( *prsResult, achHandle, strlen( achHandle ));
1921
1922 free( pszFile );
1923 return ( 0 );
1924}
1925
1926
1927/* ------------------------------------------------------------------------- *
1928 * Sys2Close *
1929 * *
[17]1930 * Wrapper to DosClose: close a file/stream. *
[16]1931 * *
1932 * REXX ARGUMENTS: *
1933 * 1. File handle (returned by Sys2Open) (REQUIRED) *
1934 * *
1935 * REXX RETURN VALUE: *
1936 * 1 on success, or 0 if an error occurred. *
1937 * ------------------------------------------------------------------------- */
1938ULONG APIENTRY Sys2Close( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1939{
1940 HFILE hf;
1941 APIRET rc;
1942
1943 // Reset the error indicator
1944 WriteErrorCode( 0, NULL );
1945
1946 // Make sure we have exactly one valid argument (the file handle)
1947 if ( argc != 1 || ( !RXVALIDSTRING(argv[0]) ))
1948 return ( 40 );
1949 if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
1950
1951 // Close the file
1952 rc = DosClose( hf );
1953 if ( rc != NO_ERROR ) {
1954 WriteErrorCode( rc, "DosClose");
1955 MAKERXSTRING( *prsResult, "0", 1 );
1956 }
1957 else {
1958 MAKERXSTRING( *prsResult, "1", 1 );
1959 }
1960
1961 return ( 0 );
1962}
1963
1964
1965/* ------------------------------------------------------------------------- *
1966 * Sys2Seek *
1967 * *
1968 * Wrapper to DosSetFilePtrL: move the read/write pointer to the specified *
1969 * location in a stream. *
1970 * *
1971 * REXX ARGUMENTS: *
1972 * 1. File handle (returned by Sys2Open) (REQUIRED) *
1973 * 2. The signed distance in bytes to move (REQUIRED) *
1974 * 3. Move method, one of: *
1975 * B = Beginning of file *
1976 * C = Current position (DEFAULT) *
1977 * E = End of file *
1978 * *
1979 * REXX RETURN VALUE: *
1980 * The new file position, in bytes. *
1981 * ------------------------------------------------------------------------- */
1982ULONG APIENTRY Sys2Seek( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1983{
1984 HFILE hf;
1985 LONGLONG llPos,
1986 llActual;
1987 ULONG ulMethod = FILE_CURRENT;
1988 CHAR achActual[ US_LONGLONG_MAXZ ];
1989 APIRET rc;
1990
1991 // Reset the error indicator
1992 WriteErrorCode( 0, NULL );
1993
1994 // Make sure we have at least two valid arguments
1995 if ( argc < 2 || ( !RXVALIDSTRING(argv[0]) ) || ( !RXVALIDSTRING(argv[1]) ))
1996 return ( 40 );
1997
1998 // First argument: file handle
1999 if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2000
2001 // Second argument: requested offset
2002 if (( sscanf( argv[1].strptr, "%lld", &llPos )) != 1 ) return ( 40 );
2003
2004 // Third argument: starting position
2005 if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
2006 strupr( argv[2].strptr );
2007 if ( strcspn(argv[2].strptr, "BCE") > 0 ) return ( 40 );
[17]2008 switch ( argv[2].strptr[0] ) {
[16]2009 case 'B': ulMethod = FILE_BEGIN; break;
2010 case 'E': ulMethod = FILE_END; break;
2011 default : ulMethod = FILE_CURRENT; break;
2012 }
2013 }
2014
2015 rc = DosSetFilePtrL( hf, llPos, ulMethod, &llActual );
2016 if ( rc != NO_ERROR ) {
2017 WriteErrorCode( rc, "DosSetFilePtrL");
2018 MAKERXSTRING( *prsResult, "", 0 );
2019 return ( 0 );
2020 }
2021
2022 // Return the new position as the REXX result string
2023 sprintf( achActual, "%lld", llActual );
2024 MAKERXSTRING( *prsResult, achActual, strlen( achActual ));
2025
2026 return ( 0 );
2027}
2028
2029
2030/* ------------------------------------------------------------------------- *
2031 * Sys2Read *
2032 * *
2033 * Wrapper to DosRead: read bytes from a previously-opened stream. *
2034 * *
2035 * REXX ARGUMENTS: *
2036 * 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
2037 * 2. Number of bytes to read (REQUIRED) *
2038 * *
2039 * REXX RETURN VALUE: *
2040 * String containing the bytes read, or "" in case of error. *
2041 * ------------------------------------------------------------------------- */
2042ULONG APIENTRY Sys2Read( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
2043{
2044 HFILE hf;
2045 ULONG cb,
2046 cbActual;
2047 PSZ pszData;
2048 APIRET rc;
2049
2050 // Reset the error indicator
2051 WriteErrorCode( 0, NULL );
2052
2053 // Make sure we have two valid arguments
2054 if ( argc != 2 || ( !RXVALIDSTRING(argv[0]) ) || ( !RXVALIDSTRING(argv[1]) ))
2055 return ( 40 );
2056
2057 // First argument: handle
2058 if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2059
2060 // Second argument: number of bytes to read
2061 if (( sscanf( argv[1].strptr, "%u", &cb )) != 1 ) return ( 40 );
2062 if ( cb < 1 ) return ( 40 );
2063 pszData = (PSZ) malloc( cb );
2064
2065 rc = DosRead( hf, pszData, cb, &cbActual );
2066 if ( rc || !cbActual ) {
2067 WriteErrorCode( rc, "DosRead");
2068 MAKERXSTRING( *prsResult, "", 0 );
2069 goto cleanup;
2070 }
2071 if ( ! SaveResultString( prsResult, pszData, cbActual )) {
2072 MAKERXSTRING( *prsResult, "", 0 );
2073 }
2074
2075cleanup:
2076 free( pszData );
2077 return ( 0 );
2078}
2079
2080
2081/* ------------------------------------------------------------------------- *
2082 * Sys2Write *
2083 * *
2084 * Wrapper to DosWrite: write bytes to a previously-opened stream. *
2085 * *
2086 * REXX ARGUMENTS: *
2087 * 1. File handle (returned by Sys2Open or Sys2CreateNamedPipe) (REQUIRED) *
2088 * 2. Data to be written (REQUIRED) *
2089 * *
2090 * REXX RETURN VALUE: *
[17]2091 * Number of bytes written. *
[16]2092 * ------------------------------------------------------------------------- */
2093ULONG APIENTRY Sys2Write( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
2094{
2095 HFILE hf;
2096 ULONG cbActual;
[17]2097 CHAR szActual[ US_INTEGER_MAXZ ];
[16]2098 APIRET rc;
2099
2100 // Reset the error indicator
2101 WriteErrorCode( 0, NULL );
2102
2103 // Make sure we have two valid arguments
2104 if ( argc != 2 || ( !RXVALIDSTRING(argv[0]) ) || ( !RXVALIDSTRING(argv[1]) ))
2105 return ( 40 );
2106
2107 // First argument: handle
2108 if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2109
2110 // (Second argument can be left in standard RXSTRING form)
2111
[17]2112 rc = DosWrite( hf, argv[1].strptr, argv[1].strlength, &cbActual );
[16]2113 if ( rc != NO_ERROR ) {
2114 WriteErrorCode( rc, "DosWrite");
2115 MAKERXSTRING( *prsResult, "0", 1 );
[17]2116 return ( 0 );
[16]2117 }
2118
[17]2119 sprintf( szActual, "%d", cbActual );
2120 MAKERXSTRING( *prsResult, szActual, strlen( szActual ));
[16]2121 return ( 0 );
2122}
2123
2124
[25]2125/* ------------------------------------------------------------------------- *
2126 * Sys2SyncBuffer *
2127 * *
2128 * Wrapper to DosResetBuffer: for external files, write the buffer to disk; *
2129 * for pipes, block until the far end of the pipe has read the contents. *
2130 * *
2131 * REXX ARGUMENTS: *
2132 * 1. File handle (returned by Sys2Open) (REQUIRED) *
2133 * *
2134 * REXX RETURN VALUE: *
2135 * 1 on success, or 0 if an error occurred. *
2136 * ------------------------------------------------------------------------- */
2137ULONG APIENTRY Sys2SyncBuffer( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
2138{
2139 HFILE hf;
2140 APIRET rc;
2141
2142 // Reset the error indicator
2143 WriteErrorCode( 0, NULL );
2144
2145 // Make sure we have exactly one valid argument (the file handle)
2146 if ( argc != 1 || ( !RXVALIDSTRING(argv[0]) ))
2147 return ( 40 );
2148 if (( sscanf( argv[0].strptr, "%8X", &hf )) != 1 ) return ( 40 );
2149
2150 // Sync the buffer
2151 rc = DosResetBuffer( hf );
2152 if ( rc != NO_ERROR ) {
2153 WriteErrorCode( rc, "DosResetBuffer");
2154 MAKERXSTRING( *prsResult, "0", 1 );
2155 }
2156 else {
2157 MAKERXSTRING( *prsResult, "1", 1 );
2158 }
2159
2160 return ( 0 );
2161}
2162
2163
2164
[4]2165// -------------------------------------------------------------------------
2166// INTERNAL FUNCTIONS
2167// -------------------------------------------------------------------------
2168
2169
2170/* ------------------------------------------------------------------------- *
2171 * GetProcess *
2172 * *
2173 * Gets information about the specified process (if found). If pszProgram *
2174 * is NULL, the search is done on the process ID in pulPID; otherwise, the *
2175 * search is done on the executable name in pszProgram (which may or may not *
2176 * include the extension). *
2177 * *
2178 * ARGUMENTS: *
2179 * PSZ pszProgram : The requested executable (process name). (I) *
2180 * PSZ pszFullName: The returned fully-qualified process name. (O) *
2181 * PULONG pulPID : The process ID. (IO) *
2182 * PULONG pulPPID : The returned process parent ID. (O) *
2183 * PULONG pulType : The returned process type. (O) *
2184 * PUSHORT pusPriority: The returned process priority. (O) *
2185 * PULONG pulCPU : The returned process CPU time. (O) *
2186 * *
2187 * RETURNS: ULONG *
2188 * 0 on success, or a non-zero API return code in the case of an error. *
2189 * ------------------------------------------------------------------------- */
2190ULONG GetProcess( PSZ pszProgram,
2191 PSZ pszFullName,
2192 PULONG pulPID,
2193 PULONG pulPPID,
2194 PULONG pulType,
2195 PUSHORT pusPriority,
2196 PULONG pulCPU )
2197{
2198#ifdef USE_DQPS
2199 QSPTRREC *pBuf; // Data returned by DosQProcStatus()
2200#else
[23]2201 QSPTRREC *pBuf; // Data returned by DosQuerySysState() // 2015-04-23 SHL
[4]2202#endif
2203 QSPREC *pPrec; // Pointer to process information block
2204 QSTREC *pTrec; // Pointer to thread information block
2205 CHAR szName[ CCHMAXPATH ] = {0}, // Fully-qualified name of process
2206 szNoExt[ CCHMAXPATH ] = {0}; // Program name without extension
[20]2207 PPIB ppib; // pointer to current process info block
[4]2208 PSZ pszCurrent, // Program name of a queried process
2209 c; // Pointer to substring
2210 ULONG ulCPU; // Process CPU time
2211 USHORT usPriority, // Process priority class
2212 i; // index
2213 BOOL fMatch = FALSE; // The current process is a match?
2214 APIRET rc; // Return code
2215
2216
[20]2217 // Use current process when PID is 0 and program name is not specified
2218 if (( pszProgram == NULL ) && ( *pulPID == 0 )) {
2219 rc = DosGetInfoBlocks( NULL, &ppib );
2220 if ( rc != NO_ERROR ) {
2221 WriteErrorCode( rc, "DosGetInfoBlocks");
2222 return ( rc );
2223 }
2224 *pulPID = ppib->pib_ulpid;
2225 }
2226
[4]2227#ifdef USE_DQPS
2228 pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE );
2229#else
[23]2230 pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE ); // 2015-04-23 SHL
[4]2231#endif
2232
2233 if ( pBuf == NULL ) {
2234 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
2235 return ( ERROR_NOT_ENOUGH_MEMORY );
2236 }
2237
2238#ifdef USE_DQPS
2239 // Get running process information using DosQProcStatus()
2240 rc = DosQProcStatus( pBuf, UL_SSBUFSIZE );
2241 if ( rc != NO_ERROR ) {
2242 WriteErrorCode( rc, "DosQProcStatus");
2243 return ( rc );
2244 }
2245 pPrec = pBuf->pProcRec;
2246#else
2247 // Get running process information using DosQuerySysState()
2248 rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE );
2249 if ( rc != NO_ERROR ) {
2250 WriteErrorCode( rc, "DosQuerySysState");
2251 return ( rc );
2252 }
[23]2253 pPrec = (QSPREC *)(((QSPTRREC*)pBuf) -> pProcRec); // 2015-04-23 SHL
[4]2254#endif
2255
2256 *pulPPID = 0;
2257 *pulType = 0;
2258 *pusPriority = 0;
2259 *pulCPU = 0;
2260 if ( pszProgram != NULL ) *pulPID = 0;
2261 else if ( *pulPID == 0 ) return 0;
2262
2263 // Now look for the specified process
2264 while (( pPrec->RecType == 1 ) && ( !fMatch )) {
2265
2266 if ( pszProgram == NULL ) {
2267 if ( pPrec->pid == *pulPID ) {
2268 fMatch = TRUE;
2269 // Get the program name
2270 if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
2271 sprintf( pszFullName, "--");
2272 else
2273 strcpy( pszFullName, szName );
2274
2275 // Get the process priority
2276 if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
2277 usPriority = 0;
2278
2279 // Get the CPU time of the process by querying each of its threads
2280 ulCPU = 0;
2281 pTrec = pPrec->pThrdRec;
2282 for ( i = 0; i < pPrec->cTCB; i++ ) {
2283 ulCPU += ( pTrec->systime + pTrec->usertime );
2284 pTrec++;
2285 }
2286
2287 *pulPPID = pPrec->ppid;
2288 *pulType = pPrec->type;
2289 *pusPriority = usPriority;
2290 *pulCPU = ulCPU;
2291 }
2292 }
2293 else {
2294 // Get the program name (without the path)
2295 if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
2296 sprintf( pszCurrent, "--");
2297 else
2298 pszCurrent = strrchr( szName, '\\') + 1;
2299
2300 // Create a copy without the extension
2301 strcpy( szNoExt, pszCurrent );
2302 if (( c = strrchr( szNoExt, '.')) != NULL ) memset( c, 0, strlen(c) );
2303 if (( pszCurrent != NULL ) &&
2304 (( stricmp(pszCurrent, pszProgram) == 0 ) || ( stricmp(szNoExt, pszProgram) == 0 )))
2305 {
2306 fMatch = TRUE;
2307
2308 // Get the process priority
2309 if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
2310 usPriority = 0;
2311
2312 // Get the CPU time of the process by querying each of its threads
2313 ulCPU = 0;
2314 pTrec = pPrec->pThrdRec;
2315 for ( i = 0; i < pPrec->cTCB; i++ ) {
2316 ulCPU += ( pTrec->systime + pTrec->usertime );
2317 pTrec++;
2318 }
2319
2320 *pulPID = pPrec->pid;
2321 *pulPPID = pPrec->ppid;
2322 *pulType = pPrec->type;
2323 *pusPriority = usPriority;
2324 *pulCPU = ulCPU;
2325 strcpy( pszFullName, szName );
2326 }
2327 }
2328 pPrec = (QSPREC *) ( (PBYTE) (pPrec->pThrdRec) + ( pPrec->cTCB * sizeof(QSTREC) ) );
2329 }
2330 if ( !fMatch ) *pulPID = 0;
2331
2332 free( pBuf );
2333 return ( 0 );
2334}
2335
2336
2337/* ------------------------------------------------------------------------- *
2338 * SaveResultString *
2339 * *
2340 * Writes new string contents to the specified RXSTRING, allocating any *
2341 * additional memory that may be required. If the string to be written has *
2342 * zero length, nothing is done. *
2343 * *
2344 * This function should be used in place of MAKERXSTRING if there is a *
2345 * possibility that the string contents could be longer than 256 characters. *
2346 * *
2347 * ARGUMENTS: *
2348 * PRXSTRING prsResult: Pointer to an existing RXSTRING for writing. *
2349 * PCH pchBytes : The string contents to write to prsResult. *
2350 * ULONG ulBytes : The number of bytes in pchBytes to write. *
2351 * *
2352 * RETURNS: BOOL *
2353 * TRUE if prsResult was successfully updated. FALSE otherwise. *
2354 * ------------------------------------------------------------------------- */
2355BOOL SaveResultString( PRXSTRING prsResult, PCH pchBytes, ULONG ulBytes )
2356{
2357 ULONG ulRC;
2358 PCH pchNew;
2359
2360 if ( ulBytes == 0 ) return ( FALSE );
2361 if ( ulBytes > 256 ) {
2362 // REXX provides 256 bytes by default; allocate more if necessary
2363 ulRC = DosAllocMem( (PVOID) &pchNew, ulBytes, PAG_WRITE | PAG_COMMIT );
2364 if ( ulRC != 0 ) {
2365 WriteErrorCode( ulRC, "DosAllocMem");
2366 return ( FALSE );
2367 }
[24]2368 // 2015-06-03 SHL dropped DosFreeMem(prsResult->strptr);
2369 // 2015-06-03 SHL Pointer not allocated by DosAllocMem
[4]2370 prsResult->strptr = pchNew;
2371 }
2372 memcpy( prsResult->strptr, pchBytes, ulBytes );
2373 prsResult->strlength = ulBytes;
2374
2375 return ( TRUE );
2376}
2377
2378
2379/* ------------------------------------------------------------------------- *
2380 * WriteStemElement *
2381 * *
2382 * Creates a stem element (compound variable) in the calling REXX program *
2383 * using the REXX shared variable pool interface. *
2384 * *
2385 * ARGUMENTS: *
2386 * PSZ pszStem : The name of the stem (before the '.') *
2387 * ULONG ulIndex : The number of the stem element (after the '.') *
2388 * PSZ pszValue : The value to write to the compound variable. *
2389 * *
2390 * RETURNS: BOOL *
2391 * TRUE on success, FALSE on failure. *
2392 * ------------------------------------------------------------------------- */
2393BOOL WriteStemElement( PSZ pszStem, ULONG ulIndex, PSZ pszValue )
2394{
2395 SHVBLOCK shvVar; // REXX shared variable pool block
2396 ULONG ulRc,
2397 ulBytes;
[24]2398 CHAR szCompoundName[ US_COMPOUND_MAXZ ];
[4]2399
2400 sprintf( szCompoundName, "%s.%d", pszStem, ulIndex );
2401 if ( pszValue == NULL ) {
[24]2402 pszValue = "";
[4]2403 ulBytes = 0;
2404 } else {
[24]2405 // 2015-06-03 SHL Was using DosAllocMem and leaking memory
2406 // REXX API does not free this kind of buffer
[4]2407 ulBytes = strlen( pszValue );
[29]2408 }
[4]2409 MAKERXSTRING( shvVar.shvname, szCompoundName, strlen(szCompoundName) );
[24]2410 shvVar.shvvalue.strptr = pszValue;
[4]2411 shvVar.shvvalue.strlength = ulBytes;
2412 shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
2413 shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
2414 shvVar.shvcode = RXSHV_SYSET;
2415 shvVar.shvnext = NULL;
2416 ulRc = RexxVariablePool( &shvVar );
2417 if ( ulRc > 1 ) {
2418 WriteErrorCode( shvVar.shvret, "RexxVariablePool (SHVBLOCK.shvret)");
2419 return FALSE;
2420 }
2421 return TRUE;
2422
2423}
2424
2425
2426/* ------------------------------------------------------------------------- *
2427 * WriteErrorCode *
2428 * *
2429 * Writes an error code to a special variable in the calling REXX program *
2430 * using the REXX shared variable pool interface. This is used to return *
2431 * API error codes to the REXX program, since the REXX functions themselves *
2432 * normally return string values. *
2433 * *
2434 * ARGUMENTS: *
2435 * ULONG ulError : The error code returned by the failing API call. *
2436 * PSZ pszContext: A string describing the API call that failed. *
2437 * *
2438 * RETURNS: N/A *
2439 * ------------------------------------------------------------------------- */
2440void WriteErrorCode( ULONG ulError, PSZ pszContext )
2441{
2442 SHVBLOCK shvVar; // REXX shared variable pool block
2443 ULONG ulRc;
2444 CHAR szErrorText[ US_ERRSTR_MAXZ ];
2445
2446 if ( pszContext == NULL )
[17]2447 sprintf( szErrorText, "%u", ulError );
[4]2448 else
[17]2449 sprintf( szErrorText, "%u: %s", ulError, pszContext );
[4]2450 MAKERXSTRING( shvVar.shvname, SZ_ERROR_NAME, strlen(SZ_ERROR_NAME) );
2451 MAKERXSTRING( shvVar.shvvalue, szErrorText, strlen(szErrorText) );
2452 shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
2453 shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
2454 shvVar.shvcode = RXSHV_SYSET;
2455 shvVar.shvnext = NULL;
2456 ulRc = RexxVariablePool( &shvVar );
2457 if ( ulRc > 1 )
[23]2458 printf("Unable to set %s: rc = %d, ulRc = %x\n", shvVar.shvname.strptr, shvVar.shvret, ulRc ); /* 2015-04-23 SHL */
[4]2459}
2460
2461
Note: See TracBrowser for help on using the repository browser.