home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / DIRLIST.ZIP / DIRLIST.PAS
Encoding:
Pascal/Delphi Source File  |  1986-11-07  |  5.4 KB  |  158 lines
  1. program DirList;
  2. {$P256}
  3.  
  4. { This Program will display a Directory Listing including all System,   }
  5. { Hidden, and Read Only files, along with the File Attribute Status,    }
  6. { including Archive Status.                                             }
  7. {                                                                       }
  8. {                                    written by David W. Terry  4/29/85 }
  9.  
  10. type
  11.   str2  = string[2];
  12.   str6  = string[6];
  13.   str9  = string[9];
  14.   str15 = string[15];
  15.   FileList = array[1..128] of record
  16.                Name: string[13];
  17.                Attrib: byte;
  18.                Size: real;
  19.                Date,Time: str9;
  20.                end;
  21.   regpack  = record
  22.                ax,bx,cx,dx,bp,si,di,ds,es,flags:integer
  23.                end;
  24. var
  25.   List: filelist;
  26.   FileMask: str15;
  27.   X,total: byte;
  28.   recpack: regpack;
  29.   Hidden,System,ReadOnly,Normal,Archive,Dircty: boolean;
  30.  
  31. const
  32.   H ='Hidden '; S ='System '; R ='Read Only '; N ='Normal '; A ='Archive '; D ='Dir';
  33.   HN='------ '; SN='------ '; RN='--------- '; NN='------ '; AN='------- '; DN='---';
  34.  
  35. procedure Directory(FileMask: str15; var List: FileList; var Total: byte);
  36. var Dta: string[44];
  37.  
  38. function FileSize: real;           { decypher the File's Size in Bytes }
  39. var Size: real;
  40.     Byte1,Byte2,Byte3,Byte4: byte;
  41. begin
  42.   Byte1:=ord(copy(dta,28,1));
  43.   Byte2:=ord(copy(dta,27,1));
  44.   Byte3:=ord(copy(dta,29,1));
  45.   Byte4:=ord(copy(dta,30,1));
  46.   Size:=Byte1 shl 8+Byte2;
  47.   if Size<0 then Size:=Size+65536.0;   { adjust for negative values }
  48.   Size:=(Byte3 shl 8+Byte4)*256.0+Size;
  49.   FileSize:=Size;
  50.   end;  { filesize }
  51.  
  52. function FileDate: str9;         { decypher the File's Date Stamp }
  53. var Day,Month,Year: str2;
  54.     Temp: integer;
  55.     Byte1,Byte2: byte;
  56. begin
  57.   Byte1:=ord(copy(dta,25,1));
  58.   Byte2:=ord(copy(dta,26,1));
  59.   str(Byte1 and 31:2,Day);
  60.   Temp:=(Byte1 shr 5) and 7+(Byte2 and 1) shl 3;
  61.   str(Temp:2,Month);
  62.   str((Byte2 shr 1)+80:2,Year);
  63.   if Day[1]=' ' then Day[1]:='0';
  64.   if Year[1]=' ' then Year[1]:='0';
  65.   FileDate:=Month+'-'+Day+'-'+Year;
  66.   end;  { filedate }
  67.  
  68. function FileTime: str6;            { decypher the File's Time Stamp }
  69. var Hour,Min: str2;
  70.     Temp: integer;
  71.     AmPm: char;
  72.     Byte1,Byte2: byte;
  73. begin
  74.   Byte1:=ord(copy(dta,23,1));
  75.   Byte2:=ord(copy(dta,24,1));
  76.   Temp:=(Byte1 shr 5) and 7+(Byte2 and 7) shl 3;
  77.   str(Temp:2,Min);
  78.   Temp:=Byte2 shr 3;
  79.   if Temp<13 then AmPm:='a' else begin
  80.     Temp:=Temp-12;
  81.     AmPm:='p';
  82.     end;
  83.   str(Temp:2,Hour);
  84.   if Min[1]=' ' then Min[1]:='0';
  85.   FileTime:=Hour+':'+Min+AmPm;
  86.   end;  { filetime }
  87.  
  88. procedure FillRecord(RecNo: byte);        { fill List.[RecNo] with file info }
  89. begin
  90.   with List[RecNo] do begin
  91.     Name:=copy(Dta,31,13);
  92.     Attrib:=ord(copy(Dta,22,1));
  93.     Size:=FileSize;
  94.     Date:=FileDate;
  95.     Time:=FileTime;
  96.     if (Name[1]<>'.') and (pos('.',Name)<>0) then begin        { line up the }
  97.       while pos('.',Name)<9 do insert(' ',Name,pos('.',Name)); { file ext.   }
  98.       Name[pos('.',Name)]:=' ';
  99.       end;
  100.     end;
  101.   end;  { fillrecord }
  102.  
  103. procedure FillDirList;
  104. begin
  105.   Total:=1;
  106.   FillRecord(Total);
  107.   repeat
  108.     recpack.Ax:=$4f shl 8;
  109.     MsDos(recpack);
  110.     if (recpack.Ax<>18) and (recpack.Ax<>2) then begin
  111.       Total:=Total+1;
  112.       FillRecord(Total);
  113.       end;                              { repeat filling until no more }
  114.     until (recpack.flags and 1)<>0;     { files are found              }
  115.   end;  { filldirlist }
  116.  
  117. begin  { Directory }
  118.   Total:=0;
  119.   Dta:='                                           ';
  120.   FileMask:=FileMask+#0;
  121.   with recpack do begin                        { First, Set aside the DTA    }
  122.     Ax:=$1a shl 8;                             { or Data Transfer Area,      }
  123.     Ds:=Seg(Dta); Dx:=Ofs(Dta)+1;              { call $1A then call $4E to   }
  124.     MsDos(recpack);                            { find the First Match. Set   }
  125.     Ax:=$4e shl 8;                             { set Cx to 23 to include all }
  126.     Ds:=Seg(FileMask); Dx:=Ofs(FileMask)+1;    { hidden files. Then up above }
  127.     Cx:=23;                                    { call $4F to find subsequent }
  128.     MsDos(recpack);                            { matches, filling List.      }
  129.     if (flags and 1)=0 then FillDirList;
  130.     end;
  131.   end;  { directory }
  132.  
  133. begin
  134.   TextColor(White);
  135.   FileMask:='*.*';                               { default to all files *.* }
  136.   if ParamCount=1 then FileMask:=ParamStr(1);    { but use command line if  }
  137.   Directory(FileMask,List,Total);                { if available             }
  138.   for X:=1 to total do
  139.     with List[X] do begin
  140.       Normal:=True; Hidden:=False; System:=False; ReadOnly:=False; Archive:=False; Dircty:=False;
  141.       if Attrib<>0 then Normal:=False;
  142.       if (Attrib and  1)= 1 then ReadOnly:=True;    { determine Attribute }
  143.       if (Attrib and  2)= 2 then Hidden:=  True;    { Meanings            }
  144.       if (Attrib and  4)= 4 then System:=  True;
  145.       if (Attrib and 16)=16 then Dircty:=  True;
  146.       if (Attrib and 32)=32 then Archive:= True;
  147.       write(Name,Size:6:0,' ',Date:8,' ',Time:6,'  ');
  148.       if Normal   then write(N) else write(NN);
  149.       if Archive  then write(A) else write(AN);
  150.       if ReadOnly then write(R) else write(RN);
  151.       if Hidden   then write(H) else write(HN);
  152.       if System   then write(S) else write(SN);
  153.       if Dircty   then write(D) else write(DN);
  154.       writeln;
  155.       end;
  156.   writeln; writeln('Total Number of files: ',Total);
  157.   end.
  158.