home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
pmsw.zip
/
PMSW
/
PMSWALL.ZIP
/
OS2
/
APPS
/
FINDDIR.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-06-16
|
14KB
|
496 lines
/*
RxMP: REXX Multiprocessing Package
FindDir REXX to search all drives for a given directory name.
Version 1.0
Copyright (C) 1994 Bruce E. Högman All Rights Reserved.
1338 Avocado Isle
Fort Lauderdale, FL 33315 USA 1994-06-12
See the .doc file for the RXMP package for license details.
*/
/*
Edit the next lines to suit your personal environment
*/
ExitOnIdleSecs = 30 /* Prompt user to respond after n seconds */
/*
If you prefer a monochrome output, then comment out the call to
the ANSI_Define procedure. Otherwise, the call will display
data using ANSI Color escape sequences.
*/
Call ANSI_Null /* Define null ANSI video strings */
Call ANSI_Define /* Define ANSI video strings */
DisplayColor = White /* This is the color in which to display data*/
TimeOutColor = WhiteOnRed
bTimeOutProcessing = 0
bAdjustScreenSize = 1 /* 1: uses mode to increase screen to 33 lines*/
MaxScreenSize = 33
ScreenLine.0=0 /* This is where we store lines to screen */
/*
Load REXXUTIL functions if not already
*/
if 0 < RxFuncQuery('SysLoadFuncs') then
do;
Call rxfuncadd 'SysLoadFuncs','REXXUTIL','SysLoadFuncs';
Call SysLoadFuncs;
end;
else nop
/*
Get our location in the file system
*/
parse source OSName CmdName OurName
/*
Parse the input arguments into variables
*/
parse upper arg DirName DriveList AdditionalArgs
DirName = strip(DirName)
DriveList = strip(DriveList)
if DirName = '' then DirName = '/HELP'
select
when DirName = '/?' | DirName = '/HELP' then
do
Call Syntax
Call charout ,RES
say 'Hit ENTER to end.'
pull reply
return 0
end
when DirName = '/S' then
do
Call SubProcessor AdditionalArgs
return 0
end
otherwise nop
end
/*
Construct a drives list from user input or from all used drives
*/
if DriveList='' then DriveList = SysDriveMap('C:','USED')
else
do
xStr = DriveList; DriveList = ''
do i = 1 to length(xStr)
if DriveList \= '' then
if ' ' \= right(DriveList,1) then
DriveList = DriveList || ' '
else nop
else nop
DriveList = DriveList || substr(xStr,i,1) || ': '
end
end
/*
Compute the number of tasks we will launch using start command,
initialize each task entry with drive letter, and make boolean.
*/
Task.0=(length(DriveList)+2)%3
j=0;
do i = 1 to length(DriveList) by 3
j = j+1; Task.j = substr(DriveList,i,2)
TaskEnd.j = 0;
TaskFound.j=0;
end
Call DisplayLineOnScreen DisplayColor||,
"Searching" Task.0 "drives:" DriveList
/*
Rexx will create a queuename for us
*/
QName = RxQueue("Create")
TName = RxQueue("Set",QName); TName = RxQueue("Get")
if TName \= QName then
do
say 'Failure in RxQueue "Set"'
say 'Processing may be unsuccessful.'
end
else nop
/*
Start a process for each drive letter in list
*/
do i=1 to Task.0 by 1
CurrentDrive = Task.i
'@start "'CurrentDrive dirname'" /c /min' OurName ||,
' /S X' QName CurrentDrive dirname
end
/*
Counters for processing
*/
EndTaskCount = 0
DriveFoundCount = 0
CountFound = 0
DirList.0=0
IdleSecondsCounter = ExitOnIdleSecs
bWeDeleteQueue = 1
bMainLoop = 1
do while bMainLoop
if 0 < queued() then Call QueuePull
else
do
IdleSecondsCounter = IdleSecondsCounter-1
Call SysSleep 1
end
if EndTaskCount = Task.0 then leave
else nop
if IdleSecondsCounter<1 then
do;
Call TimeOutProcessing
Call DisplayScreenData
end
end
Call DisplayLineOnScreen DisplayColor||,
'Found' CountFound 'directories on' DriveFoundCount 'drives.'
if bWeDeleteQueue then Call RxQueue "Delete",QName
else
do
Call DisplayLineOnScreen WhiteOnRed"Results may be incomplete."
end
Call DisplayScreenData
Call charout ,RES
say 'Hit ENTER to end.'
pull reply
return 0
ANSI_Define:
ESC =d2c(27)'['
RES =ESC'0;1;37;40m' /* Reset color to dull white */
TAB =d2c(9)
Cyan =ESC'0;1;36;40m' /* Bright Cyan */
White =ESC'0;1;37;40m' /* Bright White */
Yellow =ESC'0;1;33;40m' /* Bright Yellow */
Pink =ESC'0;1;35;40m' /* Bright Pink */
Red =ESC'0;1;31;40m' /* Bright Red */
Hdr =ESC'0;1;44;33m'
WhiteOnRed=ESC'0;1;5;41;37m'
return
ANSI_Null:
ESC=''
RES=''
TAB=d2c(9)
Cyan='' /* Bright Cyan */
White=''
Yellow=''
Pink=''
Red=''
Hdr=''
WhiteOnRed=''
return
DisplayLineOnScreen:
parse arg ScreenLineData
nSLine = ScreenLine.0; nSLine = NSLine+1; ScreenLine.0 = nSLine
ScreenLine.nSLine = ScreenLineData
if \bTimeOutProcessing then say ScreenLineData
return
DisplayScreenData:
parse value SysTextScreenSize() with ScrRows ScrCols
if ScreenLine.0 > ScrRows & ScrRows < MaxScreenSize & bAdjustScreenSize then
do
'@mode 80,'MaxScreenSize
end
call charout ,DisplayColor||d2c(27)'[2J'd2c(27)'[2;1H'
ScrRows = ScrRows-2
ScrLineCount = 0;
do sLine = 1 to ScreenLine.0
ScrLineCount = ScrLineCount+1
if ScrLineCount > ScrRows then
do
say d2c(27)'[sHit ENTER for next screen of data'
Call QueuePull; pull reply
ScrLineCount = 1
call charout ,d2c(27)'[u'd2c(27)'[K'
end
say ScreenLine.sLine
end
return
/*
QueuePull - pulls all data from queues while queued()>0.
This is called first by code that also pulls keyboard
input to empty active queue before attempting to read keyboard.
*/
QueuePull:
do while 0 < queued()
parse upper pull queuemarker filespec VerbOrCount
select
when 0 < pos('\', filespec) then
do
Call DisplayLineOnScreen TAB filespec
DirList.0=(DirList.0)+1
end
when VerbOrCount = 'END' then
do
bDrvLoop = 1
do nDrv = 1 to Task.0 while bDrvLoop
if filespec = Task.nDrv then
do
TaskEnd.nDrv = 1
bDrvLoop = 0
EndTaskCount = EndTaskCount+1
end
end
end
when DataType(VerbOrCount,'Whole Number') then
do
CountFound = CountFound + VerbOrCount
bDrvLoop = 1
do nDrv = 1 to Task.0 while bDrvLoop
if filespec = Task.nDrv then
do
TaskFound.nDrv = 1;
bDrvLoop = 0
DriveFoundCount = DriveFoundCount+1
end
end
end
/* when VerbOrCount = 'NONE' then
say filespec 'NO' 'directory found'
*/
otherwise nop
end
end
return
Syntax:
say d2c(27)'[2J'd2c(27)'[2;1H'
xstr = center('── RxMP FindDir ─ Find Directory on Drives ── '||,
'(C) 1994 Bruce E. Högman',80)
Call charout ,Hdr||xstr
call charout ,Cyan
say White'Syntax:'Cyan
say ' 'Yellow||Ourname ' directory_name ' Cyan'[ '||,
Yellow'drive_list 'Cyan']'
call charout ,Yellow
say ''
say 'directory_name: 'Cyan'simple name of directory'
say ''
call charout ,White
say ' This may be \dir1\dir2 as example, and only entries under \dir1 will be'
say ' found. Name may contain usual wild-card characters. In every case,'
say ' the search for directories starts at the root directory on each drive,'
say ' not at the current directory on that drive. The program supplies a'
say ' leading "\" if not is present.'
say ''
call charout ,Yellow
say 'drive_list: 'Cyan'string of letters to include in search.'
say ''
call charout ,White
say ' If omitted, then all used drives, both local and remote will be searched.'
say ''
call charout ,Cyan
say 'Example: finddir dll Example: finddir os2\dll'
call charout ,White
say ' Finds all DLL directories. Finds \os2\dll, \os2\apps\dll, etc.'
say ''
xstr = center(' ',80)
Call charout ,Hdr||xstr
call charout ,RES
return
/*
TimeOutProcessing is entered when no task has queued data for the
number of seconds specified by ExitOnIdleSecs
*/
TimeOutProcessing:
RJ=d2c(27)'[80D'd2c(27)'[30C'
IdleSecondsCounter = ExitOnIdleSecs /* reset counter */
bTimeOutProcessing = 1
/*
Construct display box to overlay running display
*/
TOP.1="Expired Timer Exit:"
TOP.2="Long tasks incomplete after "ExitOnIdleSecs" seconds."
TOP.3="These drive processes still running:"
TOP.4=''
do rDrv = 1 to Task.0
if \TaskEnd.rDrv then TOP.4 = TOP.4||Task.rDrv||' '
end
TOP.5="Reply Q to quit, else any other"
TOP.6="reply to continue processing."
TOP.0=6
mxTOP=0;
do mxi=1 to TOP.0
mxl=length(TOP.mxi)
if mxl > mxTOP then mxTOP = mxl
end
do mxi=1 to TOP.0
TOP.mxi=left(TOP.mxi||copies(' ',mxTOP),mxTOP)
end
parse value SysTextScreenSize() with sRows sCols
cRow = ((sRows+1) - TOP.0)%2
cCol = ((sCols+1) - mxl)%2
do mxi=1 to TOP.0
call charout ,TimeOutColor||d2c(27)'['cRow';'cCol'H'TOP.mxi
cRow=cRow+1
end
Call QueuePull; pull reply
if reply = 'Q' then
do
bWeDeleteQueue = 0
bMainLoop = 0
'@start "'QDelete||':'||QName'" /c /min '||,
SubFile QNAME '/D dummy'
end
bTimeOutProcessing = 0
return
/*
Subprocessor to FINDDIR.CMD
Input:
Identifier/queuename that identifies srch4dir task
Drive letter to search
Directory name to search for
If Drive letter is "/D" this is a request to delete the queue
using RxQueue "Delete" call because the main program was ended
before the work of all subprocesses was complete. This subprocess
will request deletion of the queue and wait until it can complete.
When /d is 2nd argument, a dummy 3rd argument is present.
Returns:
queuename date time NONE no entries found
queuename date time nnnn number of entries following
queuename date time xxxxxxxxx entries
*/
SubProcessor: procedure
parse upper arg QName DriveLtr DirName DebugOption
if QName='' | DriveLtr='' | DirName='' then return 0
if DriveLtr = '/D' then
do
Call QDelete QName
return 0
end
/*
Load REXXUTIL functions if not already
*/
if 0 < RxFuncQuery('SysLoadFuncs') then
do;
Call rxfuncadd 'SysLoadFuncs','REXXUTIL','SysLoadFuncs';
Call SysLoadFuncs;
end;
/*
Set named queue as active queue
*/
TName = RxQueue("Set",QName); TName = RxQueue("Get")
if TName \= QName then
do
say 'TName='TName 'QName='QName
say 'Failure in RxQueue Set queue named:' QName
return 1
end
/*
Adjust arguments as needed
*/
if '\' \= left(DirName,1) then DirName='\'DirName
if '\' = right(DriveLtr,1) then
DriveLtr=substr(DriveLtr,1,length(DriveLtr)-1)
if ':' \= right(DriveLtr,1) & length(DriveLtr)=1 then
DriveLtr=DriveLtr':'
/*
Get date & time for queue identifier and put on queue
*/
queue QName'_'TimeStamp() DriveLtr 'START'
/*
Do real work of routine
*/
Call SysFileTree DriveLtr||DirName,'DirStem','DSO'
/*
Return results as queue entries
*/
queue QName'_'TimeStamp() DriveLtr 'READY'
select
when DirStem.0=0 then queue QName'_'TimeStamp() DriveLtr 'NONE'
when DirStem.0>0 then queue QName'_'TimeStamp() DriveLtr DirStem.0
otherwise
do
say 'DirStem.0='DirStem.0
say 'REXX internal logic error in select.'; return 1
end
end
if DirStem.0>0 then
do i=1 to DirStem.0
queue QName'_'TimeStamp() DirStem.i
end
queue QName'_'TimeStamp() DriveLtr 'END'
return 0
/*
Input: queuename to delete
Output: loops until queue is deleted
*/
QDelete: procedure
say ''
say 'QDelete'
parse arg QName
bLoop = 1
do while bLoop
sRC = RxQueue("Delete",QName)
select
when sRC = 0 then
do
bLoop = 0
say 'Queue deleted:' QName
end
when sRC = 5 then
do
say "Not valid queue name:" QName
bLoop = 0
end
when sRC = 9 then
do
say "Queue does not exist:" QName
bLoop = 0
end
when sRC = 10 then
do
say "Queue is busy" QName
Call SysSleep 3
end
when sRC = 12 then
do
say "Memory failure has occurred"
bLoop = 0
pull reply
end
when sRC = 1000 then
do
say "Initialization error has occurred."
bLoop = 0
pull reply
end
otherwise
do
say "Unexpected return code from RxQueue of" sRC
pull reply
bLoop = 0
end
end
end
return
TimeStamp: procedure
return Date('s')||"_"Time('l')