source: rxutilex/trunk/rxutilex.c@ 4

Last change on this file since 4 was 4, checked in by Alex Taylor, 12 years ago

RXUTILEX: initial import
File size: 66.0 KB
Line 
1/******************************************************************************
2 * REXX Utility Functions - Extended (RXUTILEX.DLL) *
3 * (C) 2011 Alex Taylor. *
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
41
42#define INCL_WINATOM
43#define INCL_WINCLIPBOARD
44#define INCL_WINERRORS
45#define INCL_DOSMISC
46#define INCL_DOSPROCESS
47#define INCL_DOSPROFILE
48#define INCL_DOSERRORS
49#define INCL_DOSMODULEMGR
50#ifndef OS2_INCLUDED
51 #include <os2.h>
52#endif
53#include <locale.h>
54#include <stdio.h>
55#include <stdlib.h>
56#include <string.h>
57#include <time.h>
58#define INCL_RXSHV
59#define INCL_RXFUNC
60#include <rexxsaa.h>
61
62#pragma import( DosGetPrty, "DosGetPrty", "DOSCALL1", 9 )
63USHORT APIENTRY16 DosGetPrty( USHORT usScope, PUSHORT pusPriority, USHORT pid );
64
65#ifdef USE_DQPS
66#pragma import( DosQProcStatus, "DosQProcStatus", "DOSCALL1", 154 )
67USHORT APIENTRY16 DosQProcStatus( PVOID pBuf, USHORT cbBuf );
68#endif
69
70// CONSTANTS
71
72#define SZ_LIBRARY_NAME "RXUTILEX" // Name of this library
73#define SZ_ERROR_NAME "SYS2ERR" // REXX variable used to store error codes
74#define SZ_VERSION "0.0.4" // Current version of this library
75
76// Maximum string lengths...
77#define US_COMPOUND_MAXZ 250 // ...of a compound variable
78#define US_INTEGER_MAXZ 12 // ...of an integer string
79#define US_STEM_MAXZ ( US_COMPOUND_MAXZ - US_INTEGER_MAXZ ) // ...of a stem
80#define US_ERRSTR_MAXZ 250 // ...of an error string
81#define US_PIDSTR_MAXZ ( CCHMAXPATH + 100 ) // ...of a process information string
82#define US_TIMESTR_MAXZ 256 // ...of a formatted time string
83
84#define UL_SSBUFSIZE 0xFFFF // Buffer size for the DosQuerySysState() data
85
86 // Time string formats
87#define FL_TIME_DEFAULT 0
88#define FL_TIME_ISO8601 1
89#define FL_TIME_LOCALE 2
90
91
92// List of functions to be registered by Sys2LoadFuncs
93static PSZ RxFunctionTbl[] = {
94 "Sys2DropFuncs",
95 "Sys2GetClipboardText",
96 "Sys2PutClipboardText",
97 "Sys2QueryProcess",
98 "Sys2QueryProcessList",
99 "Sys2KillProcess",
100 "Sys2QueryForegroundProcess",
101 "Sys2QueryPhysicalMemory",
102 "Sys2FormatTime",
103 "Sys2GetEpochTime",
104 "Sys2ReplaceModule",
105 "Sys2LocateDLL",
106 "Sys2Version"
107};
108
109
110// FUNCTION DECLARATIONS
111
112// Exported REXX functions
113RexxFunctionHandler Sys2LoadFuncs;
114RexxFunctionHandler Sys2DropFuncs;
115RexxFunctionHandler Sys2Version;
116
117RexxFunctionHandler Sys2FormatTime;
118RexxFunctionHandler Sys2GetEpochTime;
119
120RexxFunctionHandler Sys2GetClipboardText;
121RexxFunctionHandler Sys2PutClipboardText;
122// RexxFunctionHandler Sys2GetClipboardData;
123// RexxFunctionHandler Sys2PutClipboardData;
124
125RexxFunctionHandler Sys2QueryProcess;
126RexxFunctionHandler Sys2QueryProcessList;
127RexxFunctionHandler Sys2KillProcess;
128RexxFunctionHandler Sys2QueryForegroundProcess;
129
130RexxFunctionHandler Sys2QueryPhysicalMemory;
131
132RexxFunctionHandler Sys2LocateDLL;
133RexxFunctionHandler Sys2ReplaceModule;
134
135RexxFunctionHandler Sys2ReplaceObjectClass;
136
137
138// Private internal functions
139ULONG GetProcess( PSZ pszProgram, PSZ pszFullName, PULONG pulPID, PULONG pulPPID, PULONG pulType, PUSHORT pusPriority, PULONG pulCPU );
140BOOL SaveResultString( PRXSTRING prsResult, PCH pchBytes, ULONG ulBytes );
141BOOL WriteStemElement( PSZ pszStem, ULONG ulIndex, PSZ pszValue );
142void WriteErrorCode( ULONG ulError, PSZ pszContext );
143
144
145// MACROS
146#define TIME_SECONDS( timeval ) ( timeval / 32 )
147#define TIME_HUNDREDTHS( timeval ) (( timeval % 32 ) * 100 / 32 )
148
149
150/* ------------------------------------------------------------------------- *
151 * Sys2LoadFuncs *
152 * *
153 * Register all Sys2* REXX functions (except this one, obviously). *
154 * *
155 * REXX ARGUMENTS: None *
156 * REXX RETURN VALUE: "" *
157 * ------------------------------------------------------------------------- */
158ULONG APIENTRY Sys2LoadFuncs( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
159{
160 int entries,
161 i;
162
163 // Reset the error indicator
164 WriteErrorCode( 0, NULL );
165
166 if ( argc > 0 ) return ( 40 );
167 entries = sizeof(RxFunctionTbl) / sizeof(PSZ);
168 for ( i = 0; i < entries; i++ )
169 RexxRegisterFunctionDll( RxFunctionTbl[i], SZ_LIBRARY_NAME, RxFunctionTbl[i] );
170
171 MAKERXSTRING( *prsResult, "", 0 );
172 return ( 0 );
173}
174
175
176/* ------------------------------------------------------------------------- *
177 * Sys2DropFuncs *
178 * *
179 * Deregister all Sys2* REXX functions. *
180 * *
181 * REXX ARGUMENTS: None *
182 * REXX RETURN VALUE: "" *
183 * ------------------------------------------------------------------------- */
184ULONG APIENTRY Sys2DropFuncs( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
185{
186 int entries,
187 i;
188
189 // Reset the error indicator
190 WriteErrorCode( 0, NULL );
191
192 if ( argc > 0 ) return ( 40 );
193 entries = sizeof(RxFunctionTbl) / sizeof(PSZ);
194 for ( i = 0; i < entries; i++ )
195 RexxDeregisterFunction( RxFunctionTbl[i] );
196
197 MAKERXSTRING( *prsResult, "", 0 );
198 return ( 0 );
199}
200
201
202/* ------------------------------------------------------------------------- *
203 * Sys2Version *
204 * *
205 * Returns the current library version. *
206 * *
207 * REXX ARGUMENTS: None *
208 * REXX RETURN VALUE: Current version in the form "major.minor.refresh" *
209 * ------------------------------------------------------------------------- */
210ULONG APIENTRY Sys2Version( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
211{
212 CHAR szVersion[ 12 ];
213
214 // Reset the error indicator
215 WriteErrorCode( 0, NULL );
216
217 if ( argc > 0 ) return ( 40 );
218 sprintf( szVersion, "%s", SZ_VERSION );
219
220 MAKERXSTRING( *prsResult, szVersion, strlen(szVersion) );
221 return ( 0 );
222}
223
224
225/* ------------------------------------------------------------------------- *
226 * Sys2PutClipboardText *
227 * *
228 * Write a string to the clipboard in plain-text format. Specifying either *
229 * no value or an empty string in the first argument will simply clear the *
230 * clipboard of CF_TEXT data. *
231 * *
232 * REXX ARGUMENTS: *
233 * 1. String to be written to the clipboard (DEFAULT: "") *
234 * 2. Flag indicating whether other clipboard formats should be cleared: *
235 * Y = yes, call WinEmptyClipbrd() before writing text (DEFAULT) *
236 * N = no, leave (non-CF_TEXT) clipboard data untouched *
237 * *
238 * REXX RETURN VALUE: 1 on success, 0 on failure *
239 * ------------------------------------------------------------------------- */
240ULONG APIENTRY Sys2PutClipboardText( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
241{
242 PSZ pszShareMem; // text in clipboard
243 ULONG ulRC = 0, // return code
244 ulBytes = 0, // size of input string
245 ulPType = 0; // process-type flag
246 BOOL fEmptyCB = TRUE, // call WinEmptyClipbrd() first?
247 fHabTerm = TRUE; // terminate HAB ourselves?
248 HAB hab; // anchor-block handle (for Win*)
249 HMQ hmq; // message-queue handle
250 PPIB ppib; // process information block
251 PTIB ptib; // thread information block
252
253
254 // Reset the error indicator
255 WriteErrorCode( 0, NULL );
256
257 // Make sure we have at least one valid argument (the input string)
258 if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
259
260 // The second argument is optional, but must be correct if specified
261 if ( argc >= 2 ) {
262 // second argument: flag to clear clipboard (Y/N, but also accept 0/1)
263 if ( RXVALIDSTRING(argv[1]) ) {
264 strupr( argv[1].strptr );
265 if ( strcspn(argv[1].strptr, "YN01") > 0 ) return ( 40 );
266 switch ( argv[1].strptr[0] ) {
267 case 'N':
268 case '0': fEmptyCB = FALSE; break;
269 case 'Y':
270 case '1':
271 default : fEmptyCB = TRUE; break;
272 }
273 } else fEmptyCB = TRUE;
274 }
275
276 // Initialize the PM API
277 DosGetInfoBlocks( &ptib, &ppib );
278 ulPType = ppib->pib_ultype;
279 ppib->pib_ultype = 3;
280 hab = WinInitialize( 0 );
281 if ( !hab ) {
282 fHabTerm = FALSE;
283 hab = 1;
284 }
285
286 /* Try to create a message-queue if one doesn't exist. We don't need to
287 * check the result, because it could fail if a message queue already exists
288 * (in the calling process), which is also OK.
289 */
290 hmq = WinCreateMsgQueue( hab, 0);
291
292 // Place the string on the clipboard as CF_TEXT
293 ulRC = WinOpenClipbrd( hab );
294 if ( ulRC ) {
295
296 if ( fEmptyCB ) WinEmptyClipbrd( hab );
297
298 ulBytes = argv[0].strlength + 1;
299 ulRC = DosAllocSharedMem( (PVOID) &pszShareMem, NULL, ulBytes,
300 PAG_READ | PAG_WRITE | PAG_COMMIT | OBJ_GIVEABLE );
301 if ( ulRC == 0 ) {
302 memset( pszShareMem, 0, ulBytes );
303 strncpy( pszShareMem, argv[0].strptr , ulBytes - 1 );
304 if ( ! WinSetClipbrdData( hab, (ULONG) pszShareMem, CF_TEXT, CFI_POINTER ))
305 WriteErrorCode( ERRORIDERROR(WinGetLastError(hab)), "WinSetClipbrdData");
306 else
307 MAKERXSTRING( *prsResult, "", 0 );
308 } else {
309 WriteErrorCode( ulRC, "DosAllocSharedMem");
310 MAKERXSTRING( *prsResult, "", 0 );
311 }
312
313 WinCloseClipbrd( hab );
314 } else {
315 WriteErrorCode( ulRC, "WinOpenClipbrd");
316 MAKERXSTRING( *prsResult, "", 0 );
317 }
318
319 if ( hmq != NULLHANDLE ) WinDestroyMsgQueue( hmq );
320 if ( fHabTerm ) WinTerminate( hab );
321 ppib->pib_ultype = ulPType;
322
323 return ( 0 );
324}
325
326
327/* ------------------------------------------------------------------------- *
328 * Sys2GetClipboardText *
329 * *
330 * Retrieve a plain-text string from the clipboard if one is available. *
331 * *
332 * REXX ARGUMENTS: *
333 * None. *
334 * *
335 * REXX RETURN VALUE: The retrieved clipboard string *
336 * ------------------------------------------------------------------------- */
337ULONG APIENTRY Sys2GetClipboardText( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
338{
339 PSZ pszClipText, // pointer to clipboard data
340 pszLocalText; // our copy of the data (to return)
341 ULONG ulRC = 0, // return code
342 ulBytes = 0, // size in bytes of output string
343 ulPType = 0; // process-type flag
344 BOOL fHabTerm = TRUE; // terminate HAB ourselves?
345 HAB hab; // anchor-block handle (for Win*)
346 HMQ hmq; // message-queue handle
347 PPIB ppib; // process information block
348 PTIB ptib; // thread information block
349
350
351 // Reset the error indicator
352 WriteErrorCode( 0, NULL );
353
354 // Initialize the PM API
355 DosGetInfoBlocks( &ptib, &ppib );
356 ulPType = ppib->pib_ultype;
357 ppib->pib_ultype = 3;
358 hab = WinInitialize( 0 );
359 if ( !hab ) {
360 fHabTerm = FALSE;
361 hab = 1;
362 }
363
364 /* Note: A message-queue must exist before we can access the clipboard. We
365 * don't actually use the returned value. In fact, we don't even
366 * verify it, because it could be NULLHANDLE if this function was
367 * called from a PM process (e.g. VX-REXX) - in which case, a message
368 * queue should already exist, and we can proceed anyway.
369 */
370 hmq = WinCreateMsgQueue( hab, 0 );
371
372 // Open the clipboard
373 ulRC = WinOpenClipbrd( hab );
374 if ( ulRC ) {
375
376 // Read plain text from the clipboard, if available
377 if (( pszClipText = (PSZ) WinQueryClipbrdData( hab, CF_TEXT )) != NULL ) {
378
379 ulBytes = strlen( pszClipText ) + 1;
380 if (( pszLocalText = (PSZ) malloc( ulBytes )) != NULL ) {
381 memset( pszLocalText, 0, ulBytes );
382 strncpy( pszLocalText, pszClipText, ulBytes - 1 );
383 if ( ! SaveResultString( prsResult, pszLocalText, ulBytes - 1 )) {
384 MAKERXSTRING( *prsResult, "", 0 );
385 }
386 free( pszLocalText );
387 } else {
388 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
389 MAKERXSTRING( *prsResult, "", 0 );
390 }
391
392 } else {
393 // Either no text exists, or clipboard is not readable
394 MAKERXSTRING( *prsResult, "", 0 );
395 }
396
397 WinCloseClipbrd( hab );
398 } else {
399 WriteErrorCode( ulRC, "WinOpenClipbrd");
400 MAKERXSTRING( *prsResult, "", 0 );
401 }
402
403 if ( hmq != NULLHANDLE ) WinDestroyMsgQueue( hmq );
404 if ( fHabTerm ) WinTerminate( hab );
405
406 ppib->pib_ultype = ulPType;
407
408 return ( 0 );
409}
410
411
412/* ------------------------------------------------------------------------- *
413 * Sys2QueryProcess *
414 * *
415 * Queries information about the specified process. *
416 * *
417 * REXX ARGUMENTS: *
418 * 1. The process identifier (program name or process ID) (REQUIRED) *
419 * 2. Flag indicicating the identifier type: *
420 * 'P': decimal process ID *
421 * 'H': hexadecimal process ID *
422 * 'N': executable program name (with or without extension) (DEFAULT) *
423 * *
424 * REXX RETURN VALUE: *
425 * A string of the format *
426 * pid parent-pid process-type priority cpu-time executable-name *
427 * "priority" is in hexadecimal notation, all other numbers are decimal. *
428 * "" is returned if the process was not found or if an internal error *
429 * occurred. *
430 * ------------------------------------------------------------------------- */
431ULONG APIENTRY Sys2QueryProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
432{
433 PSZ pszProcName; // Requested process name
434 UCHAR szFullName[ CCHMAXPATH ] = {0}, // Fully-qualified name
435 szReturn[ US_PIDSTR_MAXZ ] = {0}; // Buffer for return value
436 ULONG ulPID = 0, // Process ID
437 ulPPID = 0, // Parent process ID
438 ulType = 0, // Process type
439 ulTime = 0; // Process CPU time
440 USHORT usPrty = 0; // Process priority
441 APIRET rc; // API return code
442
443
444 // Reset the error indicator
445 WriteErrorCode( 0, NULL );
446
447 // Make sure we have at least one valid argument (the input string)
448 if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
449
450 // Parse the ID type flag
451 if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
452 strupr( argv[1].strptr );
453 if (strcspn(argv[1].strptr, "HNP") > 0 ) return ( 40 );
454 switch ( argv[1].strptr[0] ) {
455
456 case 'H': if (( sscanf( argv[0].strptr, "%X", &ulPID )) != 1 ) return ( 40 );
457 pszProcName = NULL;
458 break;
459
460 case 'P': if (( sscanf( argv[0].strptr, "%u", &ulPID )) != 1 ) return ( 40 );
461 pszProcName = NULL;
462 break;
463
464 default : pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
465 if ( pszProcName == NULL ) {
466 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
467 MAKERXSTRING( *prsResult, "0", 1 );
468 return ( 0 );
469 }
470 strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) );
471 break;
472 }
473 } else {
474 pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
475 if ( pszProcName == NULL ) {
476 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
477 MAKERXSTRING( *prsResult, "0", 1 );
478 return ( 0 );
479 }
480 strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) );
481 }
482
483 // See if the requested process is running and get its PID/PPID
484 rc = GetProcess( pszProcName, szFullName, &ulPID, &ulPPID, &ulType, &usPrty, &ulTime );
485 if (( rc != NO_ERROR ) || ( ulPID == 0 )) {
486 MAKERXSTRING( *prsResult, "", 0 );
487 return ( 0 );
488 }
489
490 sprintf( szReturn, "%u %u %u %04X %02u:%02u.%02u %s",
491 ulPID, ulPPID, ulType, usPrty, TIME_SECONDS( ulTime ) / 60,
492 TIME_SECONDS( ulTime ) % 60, TIME_HUNDREDTHS( ulTime ), szFullName );
493
494 MAKERXSTRING( *prsResult, szReturn, strlen(szReturn) );
495
496 return ( 0 );
497}
498
499
500/* ------------------------------------------------------------------------- *
501 * Sys2KillProcess *
502 * *
503 * Terminate the (first) running process with the specified executable name *
504 * or process-ID. *
505 * *
506 * REXX ARGUMENTS: *
507 * 1. The process identifier (program name or process ID) (REQUIRED) *
508 * 2. Flag indicicating the identifier type: *
509 * 'P': decimal process ID *
510 * 'H': hexadecimal process ID *
511 * 'N': executable program name (with or without extension) (DEFAULT) *
512 * *
513 * REXX RETURN VALUE: 1 on success or 0 on failure. *
514 * ------------------------------------------------------------------------- */
515ULONG APIENTRY Sys2KillProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
516{
517 PSZ pszProcName; // Requested process name
518 UCHAR szFullName[ CCHMAXPATH ] = {0}; // Fully-qualified name
519 ULONG ulPID = 0, // Process ID
520 ulPPID = 0, // Parent process ID (not used)
521 ulType = 0, // Process type (not used)
522 ulTime = 0; // Process CPU time (not used)
523 USHORT usPrty = 0; // Process priority (not used)
524 APIRET rc; // API return code
525
526
527 // Reset the error indicator
528 WriteErrorCode( 0, NULL );
529
530 // Make sure we have at least one valid argument (the input string)
531 if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
532
533 // Parse the ID type flag
534 if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
535 strupr( argv[1].strptr );
536 if (strcspn(argv[1].strptr, "HNP") > 0 ) return ( 40 );
537 switch ( argv[1].strptr[0] ) {
538
539 case 'H': if (( sscanf( argv[0].strptr, "%X", &ulPID )) != 1 ) return ( 40 );
540 pszProcName = NULL;
541 break;
542
543 case 'P': if (( sscanf( argv[0].strptr, "%u", &ulPID )) != 1 ) return ( 40 );
544 pszProcName = NULL;
545 break;
546
547 default : pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
548 if ( pszProcName == NULL ) {
549 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
550 MAKERXSTRING( *prsResult, "0", 1 );
551 return ( 0 );
552 }
553 strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) );
554 break;
555 }
556 } else {
557 pszProcName = (PSZ) calloc( RXSTRLEN(argv[0]) + 1, sizeof(UCHAR) );
558 if ( pszProcName == NULL ) {
559 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
560 MAKERXSTRING( *prsResult, "0", 1 );
561 return ( 0 );
562 }
563 strncpy( pszProcName, argv[0].strptr, RXSTRLEN(argv[0]) );
564 }
565
566 if ( pszProcName != NULL ) {
567 // Get the process PID
568 rc = GetProcess( pszProcName, szFullName, &ulPID, &ulPPID, &ulType, &usPrty, &ulTime );
569 if (( rc != NO_ERROR ) || ( ulPID == 0 )) {
570 MAKERXSTRING( *prsResult, "0", 1 );
571 return ( 0 );
572 }
573 }
574
575 // Now attempt to kill the process using DosKillProcess()
576 rc = DosKillProcess( 1, ulPID );
577 if ( rc != NO_ERROR ) {
578 WriteErrorCode( rc, "DosKillProcess");
579 MAKERXSTRING( *prsResult, "0", 1 );
580 return ( 0 );
581 }
582
583 MAKERXSTRING( *prsResult, "1", 1 );
584 return ( 0 );
585}
586
587
588/* ------------------------------------------------------------------------- *
589 * Sys2QueryProcessList *
590 * *
591 * Gets the process ID of the specified executable, if it is running. *
592 * The results will be returned in a stem variable, where stem.0 contains *
593 * number of items, and each stem item is a string of the form: *
594 * pid parent-pid process-type priority cpu-time executable-name *
595 * "priority" is in hexadecimal notation, all other numbers are decimal. *
596 * *
597 * Notes: *
598 * - "process-type" will be one of: *
599 * 0 Full screen protect-mode session *
600 * 1 Requires real mode. Dos emulation. *
601 * 2 VIO windowable protect-mode session *
602 * 3 Presentation Manager protect-mode session *
603 * 4 Detached protect-mode process. *
604 * - If "priority" is 0 then the priority class could not be determined. *
605 * - If "executable-name" is "--" then the name could not be identified. *
606 * *
607 * REXX ARGUMENTS: *
608 * 1. The name of the stem in which to return the results (REQUIRED) *
609 * *
610 * REXX RETURN VALUE: Number of processes found, or "" in case of error. *
611 * ------------------------------------------------------------------------- */
612ULONG Sys2QueryProcessList( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
613{
614#ifdef USE_DQPS
615 QSPTRREC *pBuf; // Data returned by DosQProcStatus()
616#else
617 QSGREC **pBuf; // Data returned by DosQuerySysState()
618#endif
619 QSPREC *pPrec; // Pointer to process information block
620 QSTREC *pTrec; // Pointer to thread information block
621 CHAR szStem[ US_STEM_MAXZ ], // Buffers used for building strings ...
622 szNumber[ US_INTEGER_MAXZ ], // ...
623 szName[ CCHMAXPATH ], // Fully-qualified name of process
624 szPInfo[ US_PIDSTR_MAXZ ]; // Stem item string
625 ULONG ulCount, // Number of processes
626 ulCPU; // Process CPU time
627 USHORT usPriority, // Process priority class
628 i; // Loop counter
629 APIRET rc; // Return code
630
631
632 // Reset the error indicator
633 WriteErrorCode( 0, NULL );
634
635 // Do some validity checking on the arguments
636 if (( argc != 1 ) || // Make sure we have exactly one argument...
637 ( ! RXVALIDSTRING(argv[0]) ) || // ...which is a valid REXX string...
638 ( RXSTRLEN(argv[0]) > US_STEM_MAXZ )) // ...and isn't too long.
639 return ( 40 );
640
641 // Generate the stem variable name from the argument (stripping any final dot)
642 if ( argv[0].strptr[ argv[0].strlength-1 ] == '.') argv[0].strlength--;
643 strncpy( szStem, argv[0].strptr, RXSTRLEN(argv[0]) );
644 szStem[ RXSTRLEN(argv[0]) ] = '\0';
645
646#ifdef USE_DQPS
647 pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE );
648#else
649 pBuf = (QSGREC **) malloc( UL_SSBUFSIZE );
650#endif
651
652 if ( pBuf == NULL ) {
653 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
654 MAKERXSTRING( *prsResult, "", 0 );
655 return ( 0 );
656 }
657
658#ifdef USE_DQPS
659 // Get running process information using DosQProcStatus()
660 rc = DosQProcStatus( pBuf, UL_SSBUFSIZE );
661 if ( rc != NO_ERROR ) {
662 WriteErrorCode( rc, "DosQProcStatus");
663 MAKERXSTRING( *prsResult, "", 0 );
664 return ( 0 );
665 }
666 pPrec = pBuf->pProcRec;
667#else
668 // Get running process information using DosQuerySysState()
669 rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE );
670 if ( rc != NO_ERROR ) {
671 WriteErrorCode( rc, "DosQuerySysState");
672 MAKERXSTRING( *prsResult, "", 0 );
673 return ( 0 );
674 }
675 pPrec = (QSPREC *) ( (PBYTE) (*pBuf) + sizeof(QSGREC) );
676#endif
677
678 // Now get the list of processes
679 ulCount = 0;
680 while ( pPrec->RecType == 1 ) {
681 ulCount++;
682
683 // Get the program name of each process (including path)
684 if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
685 sprintf( szName, "--");
686 if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
687 usPriority = 0;
688
689 // Get the CPU time of the process by querying each of its threads
690 ulCPU = 0;
691 pTrec = pPrec->pThrdRec;
692 for ( i = 0; i < pPrec->cTCB; i++ ) {
693 ulCPU += ( pTrec->systime + pTrec->usertime );
694 pTrec++;
695 }
696
697 // Now generate the stem item with all of this information
698 sprintf( szPInfo, "%u %u %u %04X %02u:%02u.%02u %s",
699 pPrec->pid, // PID
700 pPrec->ppid, // Parent PID
701 pPrec->type, // Process type
702 usPriority, // Priority class
703 TIME_SECONDS( ulCPU ) / 60, // CPU time (hours)
704 TIME_SECONDS( ulCPU ) % 60, // CPU time (minutes)
705 TIME_HUNDREDTHS( ulCPU ), // CPU time (seconds)
706 szName ); // Executable name & path
707 WriteStemElement( szStem, ulCount, szPInfo );
708
709 pPrec = (QSPREC *) ( (PBYTE) (pPrec->pThrdRec) + ( pPrec->cTCB * sizeof(QSTREC) ) );
710 }
711
712 // Create the "0" stem element with the number of processes found
713 sprintf( szNumber, "%d", ulCount );
714 WriteStemElement( szStem, 0, szNumber );
715
716 // And also return the number of processes as the REXX return string
717 MAKERXSTRING( *prsResult, szNumber, strlen(szNumber) );
718
719 free( pBuf );
720 return ( 0 );
721}
722
723
724/* ------------------------------------------------------------------------- *
725 * Sys2QueryPhysicalMemory *
726 * *
727 * Queries the amount of physical memory (RAM) installed in the system. *
728 * *
729 * REXX ARGUMENTS: None *
730 * *
731 * REXX RETURN VALUE: *
732 * Integer representing the amount of installed memory, in KiB, or 0 if an *
733 * error occurred. *
734 * ------------------------------------------------------------------------- */
735ULONG APIENTRY Sys2QueryPhysicalMemory( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
736{
737 CHAR szMemSize[ US_INTEGER_MAXZ ];
738 ULONG ulMemBytes = 0,
739 ulMemKBytes = 0;
740 APIRET rc = 0;
741
742 // Reset the error indicator
743 WriteErrorCode( 0, NULL );
744
745 // Make sure we have no arguments
746 if ( argc > 0 ) return ( 40 );
747
748 // Query installed memory in bytes
749 rc = DosQuerySysInfo( QSV_TOTPHYSMEM, QSV_TOTPHYSMEM,
750 &ulMemBytes, sizeof(ulMemBytes) );
751 if ( rc != NO_ERROR ) {
752 WriteErrorCode( rc, "DosQuerySysInfo");
753 MAKERXSTRING( *prsResult, "0", 1 );
754 return ( 0 );
755 }
756
757 // Convert to binary kilobytes (any remainder is discarded)
758 ulMemKBytes = ulMemBytes / 1024;
759 sprintf( szMemSize, "%u", ulMemKBytes );
760
761 // Return the memory size as the REXX return string
762 MAKERXSTRING( *prsResult, szMemSize, strlen(szMemSize) );
763
764 return ( 0 );
765}
766
767
768/* ------------------------------------------------------------------------- *
769 * Sys2QueryForegroundProcess *
770 * *
771 * Queries the PID of the current foreground process. *
772 * *
773 * REXX ARGUMENTS: None *
774 * *
775 * REXX RETURN VALUE: *
776 * Integer representing the process ID (in decimal), or 0 if an error *
777 * occurred. *
778 * ------------------------------------------------------------------------- */
779ULONG APIENTRY Sys2QueryForegroundProcess( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
780{
781 CHAR szPID[ US_INTEGER_MAXZ ];
782 ULONG ulPID = 0;
783 APIRET rc = 0;
784
785 // Reset the error indicator
786 WriteErrorCode( 0, NULL );
787
788 // Make sure we have no arguments
789 if ( argc > 0 ) return ( 40 );
790
791 // Query installed memory in bytes
792 rc = DosQuerySysInfo( QSV_FOREGROUND_PROCESS,
793 QSV_FOREGROUND_PROCESS,
794 &ulPID, sizeof(ulPID) );
795 if ( rc != NO_ERROR ) {
796 WriteErrorCode( rc, "DosQuerySysInfo");
797 MAKERXSTRING( *prsResult, "0", 1 );
798 return ( 0 );
799 }
800 sprintf( szPID, "%u", ulPID );
801
802 // Return the PID as the REXX return string
803 MAKERXSTRING( *prsResult, szPID, strlen(szPID) );
804
805 return ( 0 );
806}
807
808
809/* ------------------------------------------------------------------------- *
810 * Sys2ReplaceModule *
811 * *
812 * Unlocks and optionally replaces an in-use (locked) DLL or EXE. *
813 * *
814 * REXX ARGUMENTS: *
815 * 1. The filespec of the module to be replaced. (REQUIRED) *
816 * 2. The filespec of the new module to replace it with. (DEFAULT: none) *
817 * 3. The filespec of the backup file to be created. (DEFAULT: none) *
818 * *
819 * REXX RETURN VALUE: *
820 * 1 on success, or 0 if an error occurred. *
821 * ------------------------------------------------------------------------- */
822ULONG APIENTRY Sys2ReplaceModule( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
823{
824 PSZ pszOldModule = NULL,
825 pszNewModule = NULL,
826 pszBackup = NULL;
827 APIRET rc = 0;
828
829 // Reset the error indicator
830 WriteErrorCode( 0, NULL );
831
832 // Make sure we have at least one valid argument (the module name)
833 if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) return ( 40 );
834 pszOldModule = calloc( argv[0].strlength + 1, sizeof(UCHAR) );
835 if ( pszOldModule == NULL ) {
836 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
837 MAKERXSTRING( *prsResult, "0", 1 );
838 return ( 0 );
839 }
840 strncpy( pszOldModule, argv[0].strptr, argv[0].strlength );
841
842 // Second argument: new module name (optional, but must be correct if specified)
843 if ( argc >= 2 ) {
844 if ( RXVALIDSTRING(argv[1]) ) {
845 pszNewModule = calloc( argv[1].strlength + 1, sizeof(char) );
846 if ( pszNewModule == NULL ) {
847 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
848 MAKERXSTRING( *prsResult, "0", 1 );
849 return ( 0 );
850 }
851 strncpy( pszNewModule, argv[1].strptr, argv[1].strlength );
852 } else return ( 40 );
853 }
854
855 // Third argument: backup filename (optional, but must be correct if specified)
856 if ( argc >= 3 ) {
857 if ( RXVALIDSTRING(argv[2]) ) {
858 pszBackup = calloc( argv[2].strlength + 1, sizeof(char) );
859 if ( pszBackup == NULL ) {
860 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "calloc");
861 MAKERXSTRING( *prsResult, "0", 1 );
862 return ( 0 );
863 }
864 strncpy( pszBackup, argv[2].strptr, argv[2].strlength );
865 } else return ( 40 );
866 }
867
868 // Now replace the module using DosReplaceModule
869 rc = DosReplaceModule( pszOldModule, pszNewModule, pszBackup );
870 if ( rc != NO_ERROR ) {
871 WriteErrorCode( rc, "DosReplaceModule");
872 MAKERXSTRING( *prsResult, "0", 1 );
873 return ( 0 );
874 }
875
876 // Return 1 on success
877 MAKERXSTRING( *prsResult, "1", 1 );
878
879 return ( 0 );
880}
881
882
883/* ------------------------------------------------------------------------- *
884 * Sys2FormatTime *
885 * *
886 * Convert a number of seconds from the epoch (1970-01-01 0:00:00 UTC) into *
887 * a formatted date and time string. *
888 * *
889 * REXX ARGUMENTS: *
890 * 1. Number of seconds (a positive integer) to be converted. (REQUIRED) *
891 * 2. Format type, one of: *
892 * D = return in the form 'yyyy-mm-dd hh:mm:ss (w)' where w *
893 * represents the weekday (0-6 where 0=Sunday) (DEFAULT) *
894 * I = return in ISO8601 combined form 'yyyy-mm-ddThh:mm:ss[Z]' *
895 * L = return in the form 'day month year (weekday) time' where month *
896 * and weekday are language-dependent abbreviations *
897 * Note: With D and I, time is returned in 24-hour format; L may vary. *
898 * 3. TZ conversion flag (indicates whether to convert to UTC from local *
899 * time), one of: *
900 * U = return in Coordinated Universal Time *
901 * L = convert to local time using the current TZ (DEFAULT) *
902 * *
903 * REXX RETURN VALUE: The formatted time string, or '' on error. *
904 * ------------------------------------------------------------------------- */
905ULONG APIENTRY Sys2FormatTime( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
906{
907 UCHAR szFormat[ US_TIMESTR_MAXZ ] = {0}, // strftime() format specifier
908 szTime[ US_TIMESTR_MAXZ ] = {0}; // Formatted time string
909 BYTE flFormat = FL_TIME_DEFAULT; // Time format flag
910 BOOL fUTC = FALSE; // UTC/local conversion flag
911 PSZ pszTZ, // Pointer to TZ environment var
912 pszSetTZ;
913 time_t ttSeconds; // Input timestamp (seconds)
914 struct tm *timeptr; // Timestamp structure
915 size_t stRC; // return code from strftime()
916
917 // Reset the error indicator
918 WriteErrorCode( 0, NULL );
919
920 // All arguments are optional but must be correct if specified
921
922 if ( argc >= 1 && RXVALIDSTRING(argv[0]) ) {
923 // first argument: epoch time value
924 if (( sscanf( argv[0].strptr, "%d", &ttSeconds )) != 1 ) return ( 40 );
925 }
926
927 if ( argc >= 2 ) {
928 // second argument: format flag
929 if ( RXVALIDSTRING(argv[1]) ) {
930 strupr( argv[1].strptr );
931 if ( strcspn(argv[1].strptr, "DIL") > 0 ) return ( 40 );
932 switch ( argv[1].strptr[0] ) {
933 case 'I': flFormat = FL_TIME_ISO8601; break;
934 case 'L': flFormat = FL_TIME_LOCALE; break;
935 default : flFormat = FL_TIME_DEFAULT; break;
936 }
937 }
938 }
939
940 if ( argc >= 3 ) {
941 // third argument: conversion flag
942 if ( RXVALIDSTRING(argv[2]) ) {
943 strupr( argv[2].strptr );
944 if ( strcspn(argv[2].strptr, "UL") > 0 ) return ( 40 );
945 switch ( argv[2].strptr[0] ) {
946 case 'U': fUTC = TRUE; break;
947 default : fUTC = FALSE; break;
948 }
949 }
950 }
951
952 /* These next 4 lines really shouldn't be necessary, but without them
953 * getenv() and (apparently) tzset() may see the value of TZ as NULL
954 * if the environment variable was changed in the REXX script.
955 */
956 DosScanEnv("TZ", &pszTZ );
957 pszSetTZ = (PSZ) malloc( strlen( pszTZ ) + 5 );
958 sprintf( pszSetTZ, "TZ=%s", pszTZ );
959 putenv( pszSetTZ );
960
961 // Use the locale and timezone settings from the environment
962 tzset();
963 setlocale( LC_TIME, "");
964
965 if ( argc < 1 || ( !RXVALIDSTRING(argv[0]) )) {
966 ttSeconds = time( NULL );
967 if ( ttSeconds == -1 ) {
968 WriteErrorCode( ttSeconds, "time");
969 MAKERXSTRING( *prsResult, "", 0 );
970 return 0;
971 }
972 }
973
974 if ( fUTC ) {
975 timeptr = gmtime( &ttSeconds );
976 if ( !timeptr ) {
977 WriteErrorCode( 1, "gmtime");
978 MAKERXSTRING( *prsResult, "0", 1 );
979 return 0;
980 }
981 }
982 else {
983 timeptr = localtime( &ttSeconds );
984 if ( !timeptr ) {
985 WriteErrorCode( 1, "localtime");
986 MAKERXSTRING( *prsResult, "0", 1 );
987 return 0;
988 }
989 }
990
991 switch ( flFormat ) {
992 default:
993 case FL_TIME_DEFAULT:
994 sprintf( szFormat, "%%Y-%%m-%%d %%T (%%w)");
995 break;
996
997 case FL_TIME_ISO8601:
998 sprintf( szFormat, "%%Y-%%m-%%dT%%T");
999 if ( fUTC ) strcat( szFormat, "Z");
1000 break;
1001
1002 case FL_TIME_LOCALE:
1003 sprintf( szFormat, "%%e %%b %%Y (%%a) %%X");
1004 break;
1005 }
1006
1007 stRC = strftime( szTime, US_TIMESTR_MAXZ-1, szFormat, timeptr );
1008 if ( stRC == NO_ERROR ) {
1009 WriteErrorCode( stRC, "strftime");
1010 MAKERXSTRING( *prsResult, "", 0 );
1011 return ( 0 );
1012 }
1013
1014 // Return the formatted time string
1015 MAKERXSTRING( *prsResult, szTime, strlen(szTime) );
1016
1017 free( pszSetTZ );
1018 return ( 0 );
1019}
1020
1021
1022/* ------------------------------------------------------------------------- *
1023 * Sys2GetEpochTime *
1024 * *
1025 * Convert formatted date and time into a number of seconds (UTC) from the *
1026 * epoch (defined as 1970-01-01 0:00:00). The input time is assumed to *
1027 * refer to the current timezone as defined in the TZ environment variable. *
1028 * *
1029 * If no parameters are specified, the current system time is used. If at *
1030 * least one parameter is specified, then any missing parameter is assumed *
1031 * to be its minimum possible value. *
1032 * *
1033 * Due to limitations in time_t, dates later than 2037 are not supported; *
1034 * the IBM library seems to convert them all to January 1 1970 00:00:00 UTC. *
1035 * *
1036 * REXX ARGUMENTS: *
1037 * 1. The year (0-99 or 1970+) (value <70 is assumed to be 20xx) *
1038 * 2. The month (1-12) *
1039 * 3. The day (1-31) *
1040 * 4. Hours (0-23) *
1041 * 5. Minutes (0-59) *
1042 * 6. Seconds (0-61) *
1043 * *
1044 * REXX RETURN VALUE: The number of seconds since the epoch, or 0 on error. *
1045 * ------------------------------------------------------------------------- */
1046ULONG APIENTRY Sys2GetEpochTime( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1047{
1048 ULONG ulYear = 1970, // Input year
1049 ulMonth = 1, // Input month
1050 ulDay = 1, // Input day
1051 ulHour = 0, // Input hours
1052 ulMin = 0, // Input minutes
1053 ulSec = 0; // Input seconds
1054 BOOL fYear = FALSE, // Year parameter specified?
1055 fMonth = FALSE, // Month parameter specified?
1056 fDay = FALSE, // Day parameter specified?
1057 fHour = FALSE, // Hours parameter specified?
1058 fMin = FALSE, // Minutes parameter specified?
1059 fSec = FALSE; // Seconds parameter specified?
1060 //SHORT sDST = 0; // Input time is DST?
1061 time_t timeval; // Calculated epoch time
1062 struct tm tsTime = {0}; // Time structure for mktime()
1063 UCHAR szEpochTime[ US_INTEGER_MAXZ ]; // Output string
1064 PSZ pszTZ,
1065 pszSetTZ;
1066
1067
1068 // Reset the error indicator
1069 WriteErrorCode( 0, NULL );
1070
1071 // Parse the various time items
1072 if ( argc >= 1 && RXVALIDSTRING(argv[0]) ) {
1073 if (( sscanf( argv[0].strptr, "%u", &ulYear )) != 1 ) return ( 40 );
1074 if ( ulYear < 100 ) {
1075 ulYear += (ulYear < 70) ? 2000 : 1900;
1076 }
1077 if ( ulYear < 1970 ) return ( 40 );
1078 fYear = TRUE;
1079 }
1080 if ( argc >= 2 && RXVALIDSTRING(argv[1]) ) {
1081 if (( sscanf( argv[1].strptr, "%u", &ulMonth )) != 1 ) return ( 40 );
1082 if ( ulMonth < 1 || ulMonth > 12 ) return ( 40 );
1083 fMonth = TRUE;
1084 }
1085 if ( argc >= 3 && RXVALIDSTRING(argv[2]) ) {
1086 if (( sscanf( argv[2].strptr, "%u", &ulDay )) != 1 ) return ( 40 );
1087 if ( ulDay < 1 || ulDay > 31 ) return ( 40 );
1088 fDay = TRUE;
1089 }
1090 if ( argc >= 4 && RXVALIDSTRING(argv[3]) ) {
1091 if (( sscanf( argv[3].strptr, "%u", &ulHour )) != 1 ) return ( 40 );
1092 if ( ulHour > 23 ) return ( 40 );
1093 fHour = TRUE;
1094 }
1095 if ( argc >= 5 && RXVALIDSTRING(argv[4]) ) {
1096 if (( sscanf( argv[4].strptr, "%u", &ulMin )) != 1 ) return ( 40 );
1097 if ( ulMin > 59 ) return ( 40 );
1098 fMin = TRUE;
1099 }
1100 if ( argc >= 6 && RXVALIDSTRING(argv[5]) ) {
1101 if (( sscanf( argv[5].strptr, "%u", &ulSec )) != 1 ) return ( 40 );
1102 if ( ulSec > 61 ) return ( 40 );
1103 fSec = TRUE;
1104 }
1105 if ( argc >= 7 ) return ( 40 );
1106/*
1107 // Parse the conversion flag
1108 if ( argc >= 7 && RXVALIDSTRING(argv[6]) ) {
1109 strupr( argv[6].strptr );
1110 if ( strcspn(argv[6].strptr, "SD") > 0 ) return ( 40 );
1111 switch ( argv[6].strptr[0] ) {
1112 case 'S': sDST = 0; break;
1113 case 'D': sDST = 1; break;
1114 default : sDST = -1; break;
1115 }
1116 }
1117*/
1118
1119 /* These next 4 lines really shouldn't be necessary, but without them
1120 * getenv() and (apparently) tzset() may see the value of TZ as NULL
1121 * if the environment variable was changed in the REXX script.
1122 */
1123 DosScanEnv("TZ", &pszTZ );
1124 pszSetTZ = (PSZ) malloc( strlen( pszTZ ) + 5 );
1125 sprintf( pszSetTZ, "TZ=%s", pszTZ );
1126 putenv( pszSetTZ );
1127
1128// This seems to conflict with time() under some shells -AT
1129 tzset();
1130
1131 // Use the locale settings from the environment
1132 setlocale( LC_TIME, "");
1133
1134 if ( !fYear && !fMonth && !fDay && !fHour && !fMin && !fSec ) {
1135 timeval = time( NULL );
1136 if ( timeval == -1 ) {
1137 WriteErrorCode( timeval, "time");
1138 MAKERXSTRING( *prsResult, "0", 1 );
1139 return 0;
1140 }
1141 }
1142 else {
1143//printf("TZ=%s\n", getenv("TZ"));
1144 tsTime.tm_sec = ulSec;
1145 tsTime.tm_min = ulMin;
1146 tsTime.tm_hour = ulHour;
1147 tsTime.tm_mday = ulDay;
1148 tsTime.tm_mon = ulMonth - 1;
1149 tsTime.tm_year = ulYear - 1900;
1150 tsTime.tm_isdst = -1;
1151 timeval = mktime( &tsTime );
1152 if ( timeval == -1 ) {
1153 WriteErrorCode( timeval, "mktime");
1154 MAKERXSTRING( *prsResult, "0", 1 );
1155 return 0;
1156 }
1157 }
1158
1159 // Return the calculated time value
1160 sprintf( szEpochTime, "%u", timeval );
1161 MAKERXSTRING( *prsResult, szEpochTime, strlen(szEpochTime) );
1162
1163 free( pszSetTZ );
1164 return ( 0 );
1165}
1166
1167
1168/* ------------------------------------------------------------------------- *
1169 * Sys2LocateDLL *
1170 * *
1171 * Search for an installed or loaded DLL by module name. *
1172 * Code derived from 'whichdll' by Alessandro Cantatore (public domain). *
1173 * *
1174 * REXX ARGUMENTS: *
1175 * 1. The name of the DLL to search for. (REQUIRED) *
1176 * *
1177 * REXX RETURN VALUE: *
1178 * The fully-qualified path of the DLL, if found (or '' if not found). *
1179 * ------------------------------------------------------------------------- */
1180ULONG APIENTRY Sys2LocateDLL( PSZ pszName, ULONG argc, RXSTRING argv[], PSZ pszQueue, PRXSTRING prsResult )
1181{
1182 HMODULE hmod;
1183 CHAR achModuleName[ CCHMAXPATH ];
1184 BOOL bUnload = FALSE;
1185 APIRET rc;
1186
1187 // Reset the error indicator
1188 WriteErrorCode( 0, NULL );
1189
1190 // Parse the various time items
1191 if ( !(argc == 1 && RXVALIDSTRING(argv[0])) ) return ( 40 );
1192
1193 // See if the DLL is already loaded
1194 rc = DosQueryModuleHandle( argv[0].strptr, &hmod );
1195 if ( rc ) {
1196 // Guess not; try to load it now
1197 rc = DosLoadModule( NULL, 0, argv[0].strptr, &hmod );
1198 if ( rc ) {
1199 WriteErrorCode( rc, "DosLoadModule");
1200 MAKERXSTRING( *prsResult, "", 0 );
1201 return 0;
1202 }
1203 bUnload = TRUE;
1204 }
1205
1206 // Get the full path name of the DLL
1207 rc = DosQueryModuleName( hmod, CCHMAXPATH, achModuleName );
1208 if ( rc ) {
1209 WriteErrorCode( rc, "DosQueryModuleName");
1210 MAKERXSTRING( *prsResult, "", 0 );
1211 if ( bUnload ) DosFreeModule( hmod );
1212 return 0;
1213 }
1214
1215 // Free the module if we loaded it ourselves
1216 if ( bUnload ) DosFreeModule( hmod );
1217
1218 // Return the full path name
1219 if ( ! SaveResultString( prsResult, achModuleName, strlen( achModuleName ))) {
1220 MAKERXSTRING( *prsResult, "", 0 );
1221 }
1222
1223 return 0;
1224}
1225
1226
1227
1228// -------------------------------------------------------------------------
1229// INTERNAL FUNCTIONS
1230// -------------------------------------------------------------------------
1231
1232
1233/* ------------------------------------------------------------------------- *
1234 * GetProcess *
1235 * *
1236 * Gets information about the specified process (if found). If pszProgram *
1237 * is NULL, the search is done on the process ID in pulPID; otherwise, the *
1238 * search is done on the executable name in pszProgram (which may or may not *
1239 * include the extension). *
1240 * *
1241 * ARGUMENTS: *
1242 * PSZ pszProgram : The requested executable (process name). (I) *
1243 * PSZ pszFullName: The returned fully-qualified process name. (O) *
1244 * PULONG pulPID : The process ID. (IO) *
1245 * PULONG pulPPID : The returned process parent ID. (O) *
1246 * PULONG pulType : The returned process type. (O) *
1247 * PUSHORT pusPriority: The returned process priority. (O) *
1248 * PULONG pulCPU : The returned process CPU time. (O) *
1249 * *
1250 * RETURNS: ULONG *
1251 * 0 on success, or a non-zero API return code in the case of an error. *
1252 * ------------------------------------------------------------------------- */
1253ULONG GetProcess( PSZ pszProgram,
1254 PSZ pszFullName,
1255 PULONG pulPID,
1256 PULONG pulPPID,
1257 PULONG pulType,
1258 PUSHORT pusPriority,
1259 PULONG pulCPU )
1260{
1261#ifdef USE_DQPS
1262 QSPTRREC *pBuf; // Data returned by DosQProcStatus()
1263#else
1264 QSGREC **pBuf; // Data returned by DosQuerySysState()
1265#endif
1266 QSPREC *pPrec; // Pointer to process information block
1267 QSTREC *pTrec; // Pointer to thread information block
1268 CHAR szName[ CCHMAXPATH ] = {0}, // Fully-qualified name of process
1269 szNoExt[ CCHMAXPATH ] = {0}; // Program name without extension
1270 PSZ pszCurrent, // Program name of a queried process
1271 c; // Pointer to substring
1272 ULONG ulCPU; // Process CPU time
1273 USHORT usPriority, // Process priority class
1274 i; // index
1275 BOOL fMatch = FALSE; // The current process is a match?
1276 APIRET rc; // Return code
1277
1278
1279#ifdef USE_DQPS
1280 pBuf = (QSPTRREC *) malloc( UL_SSBUFSIZE );
1281#else
1282 pBuf = (QSGREC **) malloc( UL_SSBUFSIZE );
1283#endif
1284
1285 if ( pBuf == NULL ) {
1286 WriteErrorCode( ERROR_NOT_ENOUGH_MEMORY, "malloc");
1287 return ( ERROR_NOT_ENOUGH_MEMORY );
1288 }
1289
1290#ifdef USE_DQPS
1291 // Get running process information using DosQProcStatus()
1292 rc = DosQProcStatus( pBuf, UL_SSBUFSIZE );
1293 if ( rc != NO_ERROR ) {
1294 WriteErrorCode( rc, "DosQProcStatus");
1295 return ( rc );
1296 }
1297 pPrec = pBuf->pProcRec;
1298#else
1299 // Get running process information using DosQuerySysState()
1300 rc = DosQuerySysState( QS_PROCESS, 0L, 0L, 0L, pBuf, UL_SSBUFSIZE );
1301 if ( rc != NO_ERROR ) {
1302 WriteErrorCode( rc, "DosQuerySysState");
1303 return ( rc );
1304 }
1305 pPrec = (QSPREC *) ( (PBYTE) (*pBuf) + sizeof(QSGREC) );
1306#endif
1307
1308 *pulPPID = 0;
1309 *pulType = 0;
1310 *pusPriority = 0;
1311 *pulCPU = 0;
1312 if ( pszProgram != NULL ) *pulPID = 0;
1313 else if ( *pulPID == 0 ) return 0;
1314
1315 // Now look for the specified process
1316 while (( pPrec->RecType == 1 ) && ( !fMatch )) {
1317
1318 if ( pszProgram == NULL ) {
1319 if ( pPrec->pid == *pulPID ) {
1320 fMatch = TRUE;
1321 // Get the program name
1322 if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
1323 sprintf( pszFullName, "--");
1324 else
1325 strcpy( pszFullName, szName );
1326
1327 // Get the process priority
1328 if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
1329 usPriority = 0;
1330
1331 // Get the CPU time of the process by querying each of its threads
1332 ulCPU = 0;
1333 pTrec = pPrec->pThrdRec;
1334 for ( i = 0; i < pPrec->cTCB; i++ ) {
1335 ulCPU += ( pTrec->systime + pTrec->usertime );
1336 pTrec++;
1337 }
1338
1339 *pulPPID = pPrec->ppid;
1340 *pulType = pPrec->type;
1341 *pusPriority = usPriority;
1342 *pulCPU = ulCPU;
1343 }
1344 }
1345 else {
1346 // Get the program name (without the path)
1347 if (( rc = DosQueryModuleName( pPrec->hMte, CCHMAXPATH-1, szName )) != NO_ERROR )
1348 sprintf( pszCurrent, "--");
1349 else
1350 pszCurrent = strrchr( szName, '\\') + 1;
1351
1352 // Create a copy without the extension
1353 strcpy( szNoExt, pszCurrent );
1354 if (( c = strrchr( szNoExt, '.')) != NULL ) memset( c, 0, strlen(c) );
1355 if (( pszCurrent != NULL ) &&
1356 (( stricmp(pszCurrent, pszProgram) == 0 ) || ( stricmp(szNoExt, pszProgram) == 0 )))
1357 {
1358 fMatch = TRUE;
1359
1360 // Get the process priority
1361 if (( rc = DosGetPrty( PRTYS_PROCESS, &usPriority, pPrec->pid )) != NO_ERROR )
1362 usPriority = 0;
1363
1364 // Get the CPU time of the process by querying each of its threads
1365 ulCPU = 0;
1366 pTrec = pPrec->pThrdRec;
1367 for ( i = 0; i < pPrec->cTCB; i++ ) {
1368 ulCPU += ( pTrec->systime + pTrec->usertime );
1369 pTrec++;
1370 }
1371
1372 *pulPID = pPrec->pid;
1373 *pulPPID = pPrec->ppid;
1374 *pulType = pPrec->type;
1375 *pusPriority = usPriority;
1376 *pulCPU = ulCPU;
1377 strcpy( pszFullName, szName );
1378 }
1379 }
1380 pPrec = (QSPREC *) ( (PBYTE) (pPrec->pThrdRec) + ( pPrec->cTCB * sizeof(QSTREC) ) );
1381 }
1382 if ( !fMatch ) *pulPID = 0;
1383
1384 free( pBuf );
1385 return ( 0 );
1386}
1387
1388
1389/* ------------------------------------------------------------------------- *
1390 * SaveResultString *
1391 * *
1392 * Writes new string contents to the specified RXSTRING, allocating any *
1393 * additional memory that may be required. If the string to be written has *
1394 * zero length, nothing is done. *
1395 * *
1396 * This function should be used in place of MAKERXSTRING if there is a *
1397 * possibility that the string contents could be longer than 256 characters. *
1398 * *
1399 * ARGUMENTS: *
1400 * PRXSTRING prsResult: Pointer to an existing RXSTRING for writing. *
1401 * PCH pchBytes : The string contents to write to prsResult. *
1402 * ULONG ulBytes : The number of bytes in pchBytes to write. *
1403 * *
1404 * RETURNS: BOOL *
1405 * TRUE if prsResult was successfully updated. FALSE otherwise. *
1406 * ------------------------------------------------------------------------- */
1407BOOL SaveResultString( PRXSTRING prsResult, PCH pchBytes, ULONG ulBytes )
1408{
1409 ULONG ulRC;
1410 PCH pchNew;
1411
1412 if ( ulBytes == 0 ) return ( FALSE );
1413 if ( ulBytes > 256 ) {
1414 // REXX provides 256 bytes by default; allocate more if necessary
1415 ulRC = DosAllocMem( (PVOID) &pchNew, ulBytes, PAG_WRITE | PAG_COMMIT );
1416 if ( ulRC != 0 ) {
1417 WriteErrorCode( ulRC, "DosAllocMem");
1418 return ( FALSE );
1419 }
1420 DosFreeMem( prsResult->strptr );
1421 prsResult->strptr = pchNew;
1422 }
1423 memcpy( prsResult->strptr, pchBytes, ulBytes );
1424 prsResult->strlength = ulBytes;
1425
1426 return ( TRUE );
1427}
1428
1429
1430/* ------------------------------------------------------------------------- *
1431 * WriteStemElement *
1432 * *
1433 * Creates a stem element (compound variable) in the calling REXX program *
1434 * using the REXX shared variable pool interface. *
1435 * *
1436 * ARGUMENTS: *
1437 * PSZ pszStem : The name of the stem (before the '.') *
1438 * ULONG ulIndex : The number of the stem element (after the '.') *
1439 * PSZ pszValue : The value to write to the compound variable. *
1440 * *
1441 * RETURNS: BOOL *
1442 * TRUE on success, FALSE on failure. *
1443 * ------------------------------------------------------------------------- */
1444BOOL WriteStemElement( PSZ pszStem, ULONG ulIndex, PSZ pszValue )
1445{
1446 SHVBLOCK shvVar; // REXX shared variable pool block
1447 ULONG ulRc,
1448 ulBytes;
1449 CHAR szCompoundName[ US_COMPOUND_MAXZ ],
1450 *pchValue;
1451
1452 sprintf( szCompoundName, "%s.%d", pszStem, ulIndex );
1453 if ( pszValue == NULL ) {
1454 pchValue = "";
1455 ulBytes = 0;
1456 } else {
1457 ulBytes = strlen( pszValue );
1458 ulRc = DosAllocMem( (PVOID) &pchValue, ulBytes + 1, PAG_WRITE | PAG_COMMIT );
1459 if ( ulRc != 0 ) {
1460 WriteErrorCode( ulRc, "DosAllocMem");
1461 return FALSE;
1462 }
1463 memcpy( pchValue, pszValue, ulBytes );
1464 }
1465 MAKERXSTRING( shvVar.shvname, szCompoundName, strlen(szCompoundName) );
1466 shvVar.shvvalue.strptr = pchValue;
1467 shvVar.shvvalue.strlength = ulBytes;
1468 shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
1469 shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
1470 shvVar.shvcode = RXSHV_SYSET;
1471 shvVar.shvnext = NULL;
1472 ulRc = RexxVariablePool( &shvVar );
1473 if ( ulRc > 1 ) {
1474 WriteErrorCode( shvVar.shvret, "RexxVariablePool (SHVBLOCK.shvret)");
1475 return FALSE;
1476 }
1477 return TRUE;
1478
1479}
1480
1481
1482/* ------------------------------------------------------------------------- *
1483 * WriteErrorCode *
1484 * *
1485 * Writes an error code to a special variable in the calling REXX program *
1486 * using the REXX shared variable pool interface. This is used to return *
1487 * API error codes to the REXX program, since the REXX functions themselves *
1488 * normally return string values. *
1489 * *
1490 * ARGUMENTS: *
1491 * ULONG ulError : The error code returned by the failing API call. *
1492 * PSZ pszContext: A string describing the API call that failed. *
1493 * *
1494 * RETURNS: N/A *
1495 * ------------------------------------------------------------------------- */
1496void WriteErrorCode( ULONG ulError, PSZ pszContext )
1497{
1498 SHVBLOCK shvVar; // REXX shared variable pool block
1499 ULONG ulRc;
1500 CHAR szErrorText[ US_ERRSTR_MAXZ ];
1501
1502 if ( pszContext == NULL )
1503 sprintf( szErrorText, "%X", ulError );
1504 else
1505 sprintf( szErrorText, "%X: %s", ulError, pszContext );
1506 MAKERXSTRING( shvVar.shvname, SZ_ERROR_NAME, strlen(SZ_ERROR_NAME) );
1507 MAKERXSTRING( shvVar.shvvalue, szErrorText, strlen(szErrorText) );
1508 shvVar.shvnamelen = RXSTRLEN( shvVar.shvname );
1509 shvVar.shvvaluelen = RXSTRLEN( shvVar.shvvalue );
1510 shvVar.shvcode = RXSHV_SYSET;
1511 shvVar.shvnext = NULL;
1512 ulRc = RexxVariablePool( &shvVar );
1513 if ( ulRc > 1 )
1514 printf("Unable to set %s: rc = %d\n", shvVar.shvname.strptr, shvVar.shvret );
1515}
1516
1517
Note: See TracBrowser for help on using the repository browser.