{$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+,Y+}
{$M 16384,0,655360}

{ TEST OF FASTDIR UNIT }
{ You will need TPCrt and TPPick for TURBO POWER to use }
{ or you can modify to use some other pick list routine }

Uses DOS,TPCrt,FastDir,TPPick;

CONST
    Row  : BYTE = 4;
    Col  : BYTE = 4;
    Rows : BYTE = 18;
    Cols : BYTE = 57;

VAR
     aList  : DirList;
     bList  : DirList;
     I      : Word;
     fTYpe  : FileTypes;
     aCh,
     bCh    : WORD;
     VA     : PickColorArray;
     VB     : PickColorArray;
     Title  : STRING;
     Done   : BOOLEAN;
     fName  : PathStr;

     FUNCTION FileNameString (VAR F : SearchRec) : STRING ;

     VAR  DT : DateTime;
          AttrStr, FILESIZE, FileDate, FileTime : STRING [8];
          Mo, Day, Yr,
          Hr, Minute, Am_Pm : STRING [2];
          Len : INTEGER;

     BEGIN

     AttrStr := '    ';

     IF (F.Attr AND Directory <> 0) THEN
        FILESIZE := PadL ('<DIR>', 8) ELSE STR (F.Size : 10, FILESIZE);

     IF F.Attr AND ReadOnly <> 0 THEN AttrStr [1] := 'R';
     IF F.Attr AND Hidden   <> 0 THEN AttrStr [2] := 'H';
     IF F.Attr AND SysFile  <> 0 THEN AttrStr [3] := 'S';
     IF F.Attr AND Archive  <> 0 THEN AttrStr [4] := 'A';

     UNPACKTIME (F.Time, DT);

     STR (DT.Month : 2, MO);
     STR (DT.Day   : 2, Day);
     STR (DT.Year - 1900 : 2, Yr);

     FileDate := Mo+'/'+Day+'/'+Yr;
     FOR Len  := 1 TO Length(FileDate) DO
         IF FileDate[Len] = #32 THEN FileDate[Len] := '0';

       CASE DT.Hour OF
         0     : BEGIN
                   DT.Hour := 12;
                   IF DT.Min = 0
                   THEN  Am_Pm := 'M '
                   ELSE  Am_Pm := 'Am';
                 END;
         1..11 : Am_Pm := 'Am';
         12    : IF DT.Min = 0
                 THEN  Am_Pm := 'N '
                 ELSE  Am_Pm := 'Pm';
         13..23 : BEGIN
                   DT.Hour := DT.Hour - 12;
                   Am_Pm := 'Pm';
                 END;
       END; {case}

     STR (DT.Hour : 2, Hr);
     STR (DT.Min  : 2, Minute);

     FileTime := Hr+':'+Minute + Am_Pm;
     FOR Len  := 1 TO Length(FileTime) DO
         IF FileTime[Len] = #32 THEN FileTime[Len] := '0';

     FileNameString := PadR(F.Name,  13) +
                       PadR(FILESIZE, 9) +
                       PadR(FileDate, 9) +
                       PadR(FileTime, 8) +
                       AttrStr;

     END;

     FUNCTION FileString (Item : WORD) : STRING; FAR;

     VAR
        SR : SearchRec;

     BEGIN
     FILLCHAR (SR, SIZEOF (SR), #0);
     aList.Current := NthDirItem(aList,PRED(Item));
     WITH SR, aList DO
          BEGIN
          SR.Name := Current ^.Name;
          SR.Attr := Current ^.Attr;
          SR.Time := Current ^.Time;
          SR.Size := Current ^.Size;
          END;
     FileString := ' '+FileNameString (SR)+'  '+PadR(FileTypeString(aList.Current^.fType),6);
     END;

     FUNCTION ArchiveString (Item : WORD) : STRING; FAR;

     VAR
        SR : SearchRec;

     BEGIN
     FILLCHAR (SR, SIZEOF (SR), #0);
     bList.Current := NthDirItem(bList,PRED(Item));
     WITH SR, bList DO
          BEGIN
          SR.Name := Current ^.Name;
          SR.Attr := Current ^.Attr;
          SR.Time := Current ^.Time;
          SR.Size := Current ^.Size;
          END;

     ArchiveString := FileNameString (SR) +'  '+PadR(FileTypeString(bList.Current^.fType),6);
     END;

BEGIN

 ResetAttr(7);
 clrscr;
 FastFillWindow(25*80,#177,1,1,7);

 InitializeDir (aList);
 GetCommandLine(aList.Mask);

 aList.Path := FExpand('\');
 aList.Mask := '*.zip *.arj *.lzh *.arc';  { find multiple items }
 aList.Recurse := TRUE;  { look in all sub dirs too }

 Title := aList.Path + aList.Mask;


 GetFiles(aList,aList.Path,aList.Mask,LessName);

 SetPickColors (VA, 31, 31, 31, 126, 31, 127);
 SetPickColors (VB, 79, 79, 79, 126, 79, 127);
 TPPick.picksrch := stringpicksrch;

 Done := FALSE;

 REPEAT
 IF PickWindow(@FileString, aList.Count, Col, Row, Cols, Rows, TRUE,
          VA, ' '+Title+' ', aCH) THEN
          case PickCmdNum of
          PKSSelect : BEGIN

                      aList.Current := NthDirItem(aList,PRED(aCh));
                      fName := FullPathName(aList.Current^.Path,aList.Current^.Name);

                      IF IsDir(fName) THEN
                         BEGIN
                         ReleaseFiles (aList);
                         GetFiles(aList,fName,'*.*',LessName);
                         Title := aList.Path+aList.Mask;
                         aCh   := 0;
                         END ELSE

                      IF IsArchive(fName) THEN
                         BEGIN
                         bCh := 0;
                         GetFiles(bList,fName,'*.*',LessName);
                         REPEAT
                         IF PickWindow(@ArchiveString, bList.Count, Col+2, Row+2, Cols+2, Rows+2, TRUE,
                             VB, ' '+bList.Path+bList.Mask+' ', bCh) THEN
                         case PickCmdNum of
                              PKSSelect : ;  { do whatever }
                              PKSExit   : ReleaseFiles(bList);
                         END;
                         UNTIL (PickCmdNum = PKSEXIT);
                         END;

                      END ;
          PKSExit   : Done := TRUE;
          END;
 Until Done;

ReleaseFiles (aList);
END.