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 <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.