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  (