koreth%panarthea.ebay@sun.com (Steven Grimm) (08/11/89)
Submitted-by: f-leoe@ifi.uio.no (Lars-Erik 0sterud)
Posting-number: Volume 2, Issue 71
Archive-name: ff31
THe newest version of my File-Finder...
Start with no parameters for Help...
Source-code in Personal Pascal 2...
leoe@ifi.uio.no / f-leoe@ifi.uio.no
---
{$C-,D-,E-,P-,R-,T-,S100} {** All sjekking av, Ikke rense hele RAM'en **}
PROGRAM file_finder_3_1;
TYPE fname = PACKED ARRAY [1..14] OF CHAR;
filerec = PACKED RECORD
reserved : PACKED ARRAY [0..19] OF BYTE;
attributes,reserved2: BYTE;
date_stamp,time_stamp : INTEGER;
file_size : LONG_INTEGER;
file_name : fname;
END; {record filrec}
path_name = PACKED ARRAY [1..80] OF CHAR;
directory = ^dirtype;
dirtype = RECORD
dirname:STRING;
neste:directory;
END; {record dirtype}
VAR buffer:filerec;
drive,path:STRING;
choice,start,stopp,printer,a:CHAR;
print_ut:TEXT;
run_program:BOOLEAN;
folders,files,found:INTEGER;
PROCEDURE Datestring(date:INTEGER);
VAR dag,mnd,aar:INTEGER;
BEGIN
dag:=date & 31;
mnd:=ShR(date,5) & 15;
aar:=1980+ShR(date,9) & 127;
WRITE(print_ut,' ');
IF dag<10 THEN WRITE(print_ut,'0');
WRITE(print_ut,dag,'/');
IF mnd<10 THEN WRITE(print_ut,'0');
WRITELN(print_ut,mnd,'-',aar);
END; {proc datestring}
PROCEDURE wait_for_key;
GEMDOS($07);
PROCEDURE Set_Dta (VAR buffer:filerec);
GEMDOS($1A); {*** Set Disk Transfer-buffer ***}
FUNCTION Get_First (VAR path:path_name;attributes:INTEGER):BOOLEAN;
GEMDOS($4E); {*** Find first matching file ***}
FUNCTION Get_Next:BOOLEAN;
GEMDOS($4F); {*** Find next match ***}
PROCEDURE make_array(innavn:STRING;VAR utnavn:path_name);
VAR a:INTEGER;
BEGIN
FOR a:=1 TO Length(innavn) DO utnavn[a]:=innavn[a];
utnavn[a]:=CHR(0); {*** Slutt paa tekststrengen ***}
END; {proc make_array}
PROCEDURE make_string(innavn:fname;VAR utnavn:STRING);
VAR a:INTEGER;
BEGIN
a:=1;
WHILE innavn[a]<>CHR(0) DO a:=a+1;
utnavn:=Copy(innavn,1,a-1);
END; {func wrt_name}
PROCEDURE search(name,path:STRING);
VAR temp:STRING;
funnet:BOOLEAN;
sdirpath,sfilpath:path_name;
start,current,last:directory;
BEGIN
temp:=Concat(name,'*.*');
make_array(temp,sdirpath);
temp:=Concat(name,path);
make_array(temp,sfilpath);
WRITE(CHR(13),' Searching ',name,path,CHR(27),'K');
{*** Scan for directories ***}
NEW(start);
start^.neste:=NIL;
current:=start;
funnet:=NOT Get_First(sdirpath,16);
WHILE funnet DO BEGIN
IF (buffer.attributes=16) THEN BEGIN
IF (buffer.file_name[1]<>'.') THEN BEGIN
folders:=folders+1; {*** Telle directorier ***}
last:=current;
NEW(current);
last^.neste:=current;
make_string(buffer.file_name,temp);
current^.dirname:=Concat(name,temp,'\');
current^.neste:=NIL;
END; {if buffer.attr}
END
ELSE files:=files+1; {*** Telle vanlige filer ***}
funnet:=NOT Get_Next;
END; {while funnet}
{*** Scan for file ***}
funnet:=NOT Get_First(sfilpath,15);
WHILE funnet DO BEGIN
found:=found+1; {*** telle antall funnet ***}
make_string(buffer.file_name,temp);
temp:=Concat(name,temp);
WRITE(print_ut,CHR(13),' Found file ',temp);
WRITE(print_ut,buffer.file_size:(52-Length(temp)));
Datestring(buffer.date_stamp);
IF run_program THEN
IF (Pos('.TOS',temp)>0) OR (Pos('.TTP',temp)>0) OR
(Pos('.PRG',temp)>0) OR (Pos('.APP',temp)>0) THEN BEGIN
WRITE(CHR(27),'e');CHAIN(temp);WRITELN(CHR(27),'f');
END; {if executable}
funnet:=NOT Get_Next;
END; {while funnet}
{*** Search next directory - Recursive ! ***}
WHILE start^.neste<>NIL DO BEGIN
current:=start^.neste;
search(current^.dirname,path);
start^.neste:=current^.neste;
DISPOSE(current);
END; {while start^.neste}
DISPOSE(start);
END; {proc search}
PROCEDURE upcase(VAR tekst:STRING);
VAR a:INTEGER;
BEGIN
FOR a:=1 TO Length(tekst) DO
IF tekst[a] IN ['a'..'z'] THEN tekst[a]:=CHR(ORD(tekst[a])-32);
END; {proc upcase}
FUNCTION peek_l(adresse:LONG_INTEGER):LONG_INTEGER;
VAR magic: RECORD CASE BOOLEAN OF
FALSE:(long:LONG_INTEGER);
TRUE :(ptr :^LONG_INTEGER)
END; {record}
BEGIN
magic.long:=adresse;
peek_l:=magic.ptr^
END; {func peek_l}
FUNCTION Super(inn:LONG_INTEGER):LONG_INTEGER;
GEMDOS($20);
FUNCTION disk(drive:CHAR):BOOLEAN;
VAR stack:LONG_INTEGER;
BEGIN
stack:=Super(0);
disk:=((ShR(peek_l($4C2),ORD(drive)-65)&1)=1);
stack:=Super(stack);
END; {func disk}
PROCEDURE get_drive_path(VAR drive:CHAR;VAR path:STRING);
{*** Leser inn drive og sokepath ***}
VAR output,dummy:STRING;
a:INTEGER;
BEGIN
IF Cmd_Args<1 THEN BEGIN {*** Ingen parametere ***}
drive:='0';
WRITELN(' Use: FF <name> (<option>) (<output>) (<exec>)',CHR(10));
WRITELN(' Options: /H = Search All Hard-disks (default)');
WRITELN(' /A = Search All drives in system');
WRITELN(' /Sx = Serach Only on Drive x:',CHR(10));
WRITELN(' Output: >CON: = To Screen (default)');
WRITELN(' >LST: = To Printer');
WRITELN(' >FILE.EXT = To Textfile',CHR(10));
WRITELN(' Execute: ## = Start programs when found',CHR(10));
END
ELSE BEGIN
Cmd_GetArg(1,path);upcase(path);
drive:='1';output:='CON:';run_program:=FALSE;
FOR a:=2 TO Cmd_Args DO BEGIN
Cmd_GetArg(a,dummy);upcase(dummy);
IF dummy[1]='/' THEN BEGIN
CASE dummy[2] OF
'A' :drive:='2'; {*** Alle driver ***}
'S' :drive:=dummy[3]; {*** en drive ***}
ELSE:drive:='1'; {*** Alle harddisker ***}
END; {case switch}
END
ELSE IF dummy[1]='>' THEN output:=Copy(dummy,2,Length(dummy)-1)
ELSE IF dummy='##' THEN run_program:=TRUE;
END; {for a}
IF Length(output)<3 THEN REWRITE(print_ut,'CON:')
ELSE REWRITE(print_ut,output)
END; {if cmds}
END; {proc get_drive_path}
BEGIN
files:=0;
folders:=0;
found:=0;
Set_Dta(buffer);
WRITELN(CHR(27),'f');
WRITELN(' File-Finder 3.1 ',CHR($BD),' Lars-Erik 0sterud 1989',CHR(10));
get_drive_path(choice,path);
IF choice<>'0' THEN BEGIN
WRITE(print_ut,' Search ');
IF choice='1' THEN BEGIN
WRITE(print_ut,'All Hard-Disks');
start:='C';stopp:='Z';
END
ELSE IF choice='2' THEN BEGIN
WRITE(print_ut,'All drives');
start:='A';stopp:='Z';
END
ELSE BEGIN
WRITE(print_ut,'drive ',choice,':');
start:=choice;stopp:=choice;
END; {if choice}
WRITE(print_ut,' for ',path);
IF run_program THEN WRITE(print_ut,' and execute programs');
WRITELN(print_ut,CHR(10));
FOR a:=start TO stopp DO IF disk(a) THEN BEGIN
drive:=Concat(a,':\');
search(drive,path);
END; {for a}
WRITE(CHR(27),'l',CHR(7),CHR(13)); {*** Fjerne siste linje ***}
WRITELN(print_ut);
WRITE(print_ut,' ',files,' files, ',folders,' directories searched -');
WRITELN(print_ut,' ',found,' matching files found',CHR(10));
CLOSE(print_ut);
WRITE(' Search completed -');
END; {for/if}
WRITE(' Press any key to exit File-Finder');
wait_for_key;WRITELN;WRITELN;
END.