Path: utzoo!attcan!uunet!cs.utexas.edu!sun-barr!newstop!sun!sunfedcomm!grapevine!koreth%panarthea.ebay@sun.com
From: koreth%panarthea.ebay@sun.com (Steven Grimm)
Newsgroups: comp.sources.atari.st
Subject: v02i071: ff31 -- File finder version 3.1
Keywords: Pascal
Message-ID: <34084@grapevine.uucp>
Date: 10 Aug 89 19:56:04 GMT
Sender: news@grapevine.uucp
Lines: 247
Approved: koreth%panarthea.ebay@sun.com
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 (