[futurebasic] Find File Program

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : November 1997 : Group Archive : Group : All Groups

From: "Yates, Phil" <YATESP@...>
Date: Tue, 11 Nov 97 13:04:00 PST
To all those of you who have asked for a copy of the completed program, here 
it is. Except that it isn't really complete.

To reduce the program to a practical minimum in an attempt to reduce the 
size of this EMail, I have not included any standard Mac GUI stuff, but it is 
a full and workable program that you can copy, paste, use and amend as you 
wish, free of copyright and therefore guilt on your part.

Apart from the GUI, I'm adding the ability to move the found files to the 
trash (rather than KILL them outright), and have it all work automatically, 
rather than pause on each found file. Also, I'll probably add searches on 
dates, etc.

The program searches all folders on all mounted discs of all types, for a 
file name, file type, creator, or combination of file type and creator. The 
file name search is not case sensitive, and is a "contains" search. File Type 
and Creator are case sensitive. It stops when it finds a match, and hitting 
the minus (-) key will DELETE the found file FOREVER !

If you want, you can amend the program to list all mounted hard discs. It's 
amazing the amount of rubbish that piles up.

You can speed up the program dramatically by stopping it printing as it runs.

This program is unsupported. Please DO NOT ask me for support or help, 'cause 
you won't get it, and I don't like being rude.

The eagle-eyed amongst you may detect the origins of the program, which 
you've all got on your hard discs. My acknowledgements to either Staz or 
Andy, who probably wrote the original.

Finally, this program is essentially a Kludge to get around the problem of 
System 8 Find File. It is neither pretty nor elegant. So please don't tell me 
all of the things I could do better. I know. And also if you amend the 
program and trash your hard disc, this is your problem, not mine. The program 
is unwarrantied, unsupported, and generally un-everything.

Regards, and I hope it's of use.

Phil Yates.

' Program Starts :

OUTPUT FILE "Hunter"
WINDOW OFF
GLOBALS
DIM gOption,gType$,gSearch$,gFileType$,gCreatorType$
END GLOBALS
GOTO "Main Program"
'                                                   
LOCAL FN EnterParams
"Retry"
BEEP
CLS
PRINT : PRINT
PRINT " Select your option ... "
PRINT
PRINT " 0. Exit and Quit."
PRINT " 1. Search on File name. "
PRINT " 2. Search on File Type. "
PRINT " 3. Search on Creator. "
PRINT " 4. Search on Creator AND File Type. "
PRINT 
INPUT " Enter a number (0 - 4) : ";Option$
IF (VAL(Option$) < 0) OR (VAL(Option$) > 4) THEN "Retry"
PRINT
Option = VAL(Option$)
SELECT Option
CASE 0
'
CASE 1
INPUT " Enter the text to Search on : ";gSearch$
IF LEN(gSearch$) > 31 THEN "Retry"
gSearch$ = UCASE$(gSearch$)
gType$ = " for File Name containing : " + gSearch$
CASE 2
INPUT "Enter File Type you wish to search for : ";gFileType$
IF LEN(gFileType$) <> 4 THEN "Retry"
gType$ = " on File Type of : " + gFileType$
CASE 3
INPUT "Enter Creator Type you wish to search for : ";gCreatorType$
IF LEN(gCreatorType$) <> 4 THEN "Retry"
gType$ = " on Creator of : " + gCreatorType$
CASE 4
INPUT "Enter Creator Type you wish to search for : ";gCreatorType$
IF LEN(gCreatorType$) <> 4 THEN "Retry"
INPUT "Enter File Type you wish to search for : ";gFileType$
IF LEN(gFileType$) <> 4 THEN "Retry"
gType$ = " on Creator of : " + gCreatorType$ + " and file type of : " + 
gFileType$
END SELECT
CLS
CALL MOVETO (20,360)
PRINT "Scanning";gType$;SPACE$(255);
CALL MOVETO (20,400)
PRINT "Press Any Key to Stop ";
END FN = Option
'
'                                                   
'
CLEAR LOCAL
DIM ParamBlock.128
DIM 255 FilePath$
DIM 4 Type$                                       ' type and creator strings
DIM 4 Creator$
_ioBuff4 = 36
LOCAL FN rootContents (root$,level):              'look in root
FOR x = 1 TO 2000
IF LEN(INKEY$) THEN END:                      'break out
rootFiles$ = FILES$(-x,"",root$,volRefNum%)
LONG IF LEN(rootFiles$)
LONG IF INSTR(1,rootFiles$,":"):            'is it another folder?
CALL MOVETO (20,20 + (level * 20))
PRINT rootFiles$;SPACE$(255);
subRoot$ = root$ + rootFiles$
FN rootContents(subRoot$,level + 1):      '(recursive)
XELSE
FilePath$ = root$ + rootFiles$
ParamBlock.ioNamePtr&  = @FilePath$
ParamBlock.ioVRefNum%   = 0
ParamBlock.ioFDirIndex% = 0
ParamBlock.ioDirID&     = 0
osErr% = FN GETCATINFO (@ParamBlock)
LONG IF osErr% = _noErr
Creator$ = MKI$(ParamBlock.ioBuff4&)
Type$    = MKI$(ParamBlock.ioBuffer&)
Test = 0
SELECT gOption
CASE 1:                               'File name contains Search$ ?
Scan = 0
Scan = INSTR(1,UCASE$(rootFiles$),gSearch$)
IF Scan <> 0 THEN Test = 1
CASE 2:                               'File Type Matches ?
LONG IF gFileType$ = Type$
Test = 2
END IF
CASE 3:                               'Creator Matches ?
LONG IF gCreatorType$ = Creator$
Test = 3
END IF
CASE 4:                               'Both match
LONG IF (gCreatorType$ = Creator$) AND (gFileType$ = Type$)
Test = 4
END IF
END SELECT
LONG IF Test <> 0
LONG COLOR 0,0,65535
CALL MOVETO (20,20 + (level * 20))
PRINT FilePath$;SPACE$(255);
CALL MOVETO (20,360)
PRINT "Matched - Press Minus (-) Key to Delete, Enter key to continue";
DO
In$ = INKEY$
UNTIL (ASC(In$) = 45) OR (ASC(In$) = 3)
IF ASC(In$) = 45 THEN KILL FilePath$
LONG COLOR 0,0,0
CALL MOVETO (20,360)
PRINT "Scanning";gType$;SPACE$(255);
XELSE
LONG COLOR 0,0,0
CALL MOVETO (20,20 + (level * 20))
PRINT rootFiles$;SPACE$(255);
END IF
END IF
END IF
XELSE
x = 2000
END IF
NEXT
CALL MOVETO (20,20 + (level * 20))
PRINT SPACE$(255);
END FN
'                                                   
LOCAL FN DisplayDirectory
FOR x = 1 TO 100:                               ' Checks root volumes
root$ = FILES$(-x,"",,volRefNum%):            ' Root vol 
LONG IF LEN(root$):                           ' Search root vol
CALL MOVETO (20,20)
PRINT root$;SPACE$(255);
FN rootContents (root$,1)
XELSE
x = 100:                                    ' No more root names
END IF
NEXT
END FN
'                                                   
LOCAL FN buildWindow
DEFSTR LONG:                                    'Essential to get correct 
Creator & File type
WINDOW #1, "Search",(10,48)-(630,470)
TEXT _sysFont,12,0,0
AUTOCLIP = 0
WIDTH = -2
END FN
'                                                   
"Main Program"
FN buildWindow
gOption = FN EnterParams
IF gOption = 0 THEN END
FN DisplayDirectory
END
'                                                   
' Program 
Ends