home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DIRTE.ZIP / DIRTE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-09-26  |  13.5 KB  |  375 lines
  1. program DIRTExt;
  2.  
  3. {DIR + automatic comments of .PAS files.                                      }
  4. {SHORT dir prints 2nd to 43rd characters of 3rd line of .PAS .INC files.      }
  5. {LONG prints entire 3rd, 4th and 5th lines of .PAS .INC files                 }
  6. {                                                                             }
  7. {   DIRTE DIRECTORY                                                           }
  8. {   Idea for Self-Documentating PASCAL directories was conceived and          }
  9. {   implemented by:                                                           }
  10. {                    Phil Somers                                              }
  11. {                    258 Wilkes Court                                         }
  12. {                    Beavercreek, Ohio                                        }
  13. {                    45385                                                    }
  14. {                                                                             }
  15. {   This program is an adaptation of an excellent directory program called    }
  16. {   DIRLIST.PAS written by David W. Terry  4/29/85 . Much of his program is   }
  17. {   intact in this program. However, I don't know David because he left only  }
  18. {   his name with his program.                                                }
  19. {                                                                             }
  20. {   The name DIRTE comes from DIRectory plus TExt. It could also be           }
  21. {   DIrectory TErry.                                                          }
  22. {                                                                             }
  23. {   This program is released to PUBLIC DOMAIN in hopes of the following:      }
  24. {     1.  That it will encourage a standard PASCAL documentation style.       }
  25. {     2.  That PASCAL programs may become easier to catalog.                  }
  26. {     3.  That DIRTE DIRECTORY will be modified and enhanced.                 }
  27. {                                                                             }
  28. {   How best to document for DIRTE DIRECTORY:                                 }
  29. {     1. Line 3 should start with a left brace followed by 42 letters         }
  30. {        concisely describing the PASCAL program.                             }
  31. {     2. The rest of line 3, and all of line 4 and line 5 should further      }
  32. {        describe the program, in detail.                                     }
  33. {     3. All three lines start and end with left and right braces.            }
  34. {     4. The right braces should be in column 79 or less (NOT in 80).         }
  35. {     5. All three lines should be filled, or at least have braces.           }
  36. {                                                                             }
  37. {   Suggested Modifications:                                                  }
  38. {     1. Make it possible to select the drive to list. Currently DIRTE.COM    }
  39. {        must be on the drive to list, or it is invoked from the drive to     }
  40. {        list. For example, to get directory of drive B: with DIRTE.COM on    }
  41. {        drive B: and drive B: being the default drive, simply type           }
  42. {        DIRTE .  If you want a listing of drive A: when DIRTE.COM is on      }
  43. {        drive B:, go to drive A: and type B:DIRTE .                          }
  44. {     2. DIRTE DIRECTORY could be used with any text files, not just PASCAL   }
  45. {        The only requirement is that lines 3,4,and 5 contain the info        }
  46. {        in ASCII printable characters.                                       }
  47. {     3. Perhaps the folks who write the ARC utilities could find a way       }
  48. {        to leave lines 3,4 and 5 oftheir README.DOC file in ASCII.           } 
  49. {     4. An easy enhancement would be to provide a condensed printout for     }
  50. {        diskette labels. Currently, hardcopy is full size.                   }
  51. {                                                                             }
  52. {     REQUEST:                                                                }
  53. {        If you modify DIRTE DIRECTORY, please stick to the standard of having}
  54. {        the comments on lines 3, 4, and 5, as described. This way, any       }
  55. {        version of DIRTE DIRECTORY will be able to read all PASCAL files     }
  56. {        that follow that convention. It is also a sensible way to document   }
  57. {        your PASCAL files anyway.                                            }
  58. {                                                                             }
  59. {        If you produce a nice enhancement, please send me a listing or a copy}
  60. {        at the address above, or at WAREHOUSE RBBS, Dayton, Ohio , phone     }
  61. {        513-258-0020. At least, release it to public domain.                 }
  62. {                                                                             }
  63.  
  64.  
  65. type
  66.  
  67.   str2  = string[2];
  68.   str6  = string[6];
  69.   str9  = string[9];
  70.   str15 = string[15];
  71.   FileList = array[1..128] of record
  72.                Name: string[13];
  73.                Attrib: byte;
  74.                Size: real;
  75.                Date,Time: str9;
  76.                end;
  77.   regpack  = record
  78.                ax,bx,cx,dx,bp,si,di,ds,es,flags:integer
  79.                end;
  80. var
  81.   List: filelist;
  82.   FileMask: str15;
  83.   X,total: byte;
  84.   recpack: regpack;
  85.   Hidden,System,ReadOnly,Normal,Archive,Dircty: boolean;
  86.   lineone: string[80];
  87.   Oldname : array[1..128] of string[12];
  88.   FileName: text;
  89.   Lines : integer;
  90.   Extend : char;
  91. procedure Directory(FileMask: str15; var List: FileList; var Total: byte);
  92. var Dta: string[44];
  93.  
  94. function FileSize: real;           { decypher the File's Size in Bytes }
  95. var Size: real;
  96.     Byte1,Byte2,Byte3,Byte4: byte;
  97. begin
  98.   Byte1:=ord(copy(dta,28,1));
  99.   Byte2:=ord(copy(dta,27,1));
  100.   Byte3:=ord(copy(dta,29,1));
  101.   Byte4:=ord(copy(dta,30,1));
  102.   Size:=Byte1 shl 8+Byte2;
  103.   if Size<0 then Size:=Size+65536.0;   { adjust for negative values }
  104.   Size:=(Byte3 shl 8+Byte4)*256.0+Size;
  105.   FileSize:=Size;
  106.   end;  { filesize }
  107.  
  108. function FileDate: str9;         { decypher the File's Date Stamp }
  109. var Day,Month,Year: str2;
  110.     Temp: integer;
  111.     Byte1,Byte2: byte;
  112. begin
  113.   Byte1:=ord(copy(dta,25,1));
  114.   Byte2:=ord(copy(dta,26,1));
  115.   str(Byte1 and 31:2,Day);
  116.   Temp:=(Byte1 shr 5) and 7+(Byte2 and 1) shl 3;
  117.   str(Temp:2,Month);
  118.   str((Byte2 shr 1)+80:2,Year);
  119.   if Day[1]=' ' then Day[1]:='0';
  120.   if Year[1]=' ' then Year[1]:='0';
  121.   FileDate:=Month+'-'+Day+'-'+Year;
  122.   end;  { filedate }
  123.  
  124. function FileTime: str6;            { decypher the File's Time Stamp }
  125. var Hour,Min: str2;
  126.     Temp: integer;
  127.     AmPm: char;
  128.     Byte1,Byte2: byte;
  129. begin
  130.   Byte1:=ord(copy(dta,23,1));
  131.   Byte2:=ord(copy(dta,24,1));
  132.   Temp:=(Byte1 shr 5) and 7+(Byte2 and 7) shl 3;
  133.   str(Temp:2,Min);
  134.   Temp:=Byte2 shr 3;
  135.   if Temp<13 then AmPm:='a' else begin
  136.     Temp:=Temp-12;
  137.     AmPm:='p';
  138.     end;
  139.   str(Temp:2,Hour);
  140.   if Min[1]=' ' then Min[1]:='0';
  141.   FileTime:=Hour+':'+Min+AmPm;
  142.   end;  { filetime }
  143.  
  144. procedure FillRecord(RecNo: byte);        { fill List.[RecNo] with file info }
  145. begin
  146.   with List[RecNo] do begin
  147.     Name:=copy(Dta,31,13);
  148.     oldname[RecNo] := Name;
  149.     Attrib:=ord(copy(Dta,22,1));
  150.     Size:=FileSize;
  151.     Date:=FileDate;
  152.     Time:=FileTime;
  153.     if (Name[1]<>'.') and (pos('.',Name)<>0) then begin        { line up the }
  154.       while pos('.',Name)<9 do insert(' ',Name,pos('.',Name)); { file ext.   }
  155.       Name[pos('.',Name)]:=' ';
  156.       end;
  157.     end;
  158.   end;  { fillrecord }
  159.  
  160. procedure FillDirList;
  161. begin
  162.   Total:=1;
  163.   FillRecord(Total);
  164.   repeat
  165.     recpack.Ax:=$4f shl 8;
  166.     MsDos(recpack);
  167.     if (recpack.Ax<>18) and (recpack.Ax<>2) then begin
  168.       Total:=Total+1;
  169.       FillRecord(Total);
  170.       end;                              { repeat filling until no more }
  171.     until (recpack.flags and 1)<>0;     { files are found              }
  172.   end;  { filldirlist }
  173.  
  174. begin  { Directory }
  175.   Total:=0;
  176.   Dta:='                                           ';
  177.   FileMask:=FileMask+#0;
  178.   with recpack do begin                        { First, Set aside the DTA    }
  179.     Ax:=$1a shl 8;                             { or Data Transfer Area,      }
  180.     Ds:=Seg(Dta); Dx:=Ofs(Dta)+1;              { call $1A then call $4E to   }
  181.     MsDos(recpack);                            { find the First Match. Set   }
  182.     Ax:=$4e shl 8;                             { set Cx to 23 to include all }
  183.     Ds:=Seg(FileMask); Dx:=Ofs(FileMask)+1;    { hidden files. Then up above }
  184.     Cx:=23;                                    { call $4F to find subsequent }
  185.     MsDos(recpack);                            { matches, filling List.      }
  186.     if (flags and 1)=0 then FillDirList;
  187.     end;
  188.   end;  { directory }
  189.  
  190.  
  191. procedure ShortDirectory;
  192. begin
  193.   lines := 1;
  194.   for X:=1 to total do
  195.     with List[X] do begin
  196.  
  197.  
  198.       if (copy(Name,10,3) = 'PAS') or (copy(Name,10,3) = 'INC')
  199.          then
  200.             begin
  201.                write(Name,Size:6:0,' ',Date:8,' ',Time:6,'  ');
  202.                assign(Filename,OldName[x] );
  203.                Reset(Filename);
  204.                readln(Filename,LineOne);
  205.                readln(Filename,LineOne);
  206.                readln(Filename,LineOne);
  207.                writeln( Copy(LineOne,2,42) );
  208.  
  209.                lines := lines + 1;
  210.                if lines > 24 then
  211.                   begin
  212.                     write('Press  <SPACE BAR> to continue');
  213.                     read(KBD,Extend);
  214.                     lines := 1;
  215.                   end;
  216.             end;
  217.       end;
  218. end; {ShortDirectory}
  219.  
  220.  
  221. procedure LongDirectory;
  222. begin
  223.   lines := 1;
  224.   for X:=1 to total do
  225.     with List[X] do begin
  226.  
  227.  
  228.       if (copy(Name,10,3) = 'PAS') or (copy(Name,10,3) = 'INC')
  229.          then
  230.             begin
  231.                writeln(Name,Size:6:0,' ',Date:8,' ',Time:6,'  ');
  232.                assign(Filename,OldName[x] );
  233.                Reset(Filename);
  234.                readln(Filename,LineOne);
  235.                readln(Filename,LineOne);
  236.                readln(Filename,LineOne);
  237.                writeln(LineOne);
  238.                readln(Filename,LineOne);
  239.                writeln(LineOne);
  240.                readln(Filename,LineOne);
  241.                writeln(LineOne);
  242.                lines := lines + 5;
  243.                if lines > 24 then
  244.                   begin
  245.                     read(KBD,Extend);
  246.                     lines := 1;
  247.                     clrscr;
  248.                   end
  249.                else writeln;
  250.             end;
  251.       end;
  252. end; {LongDirectory}
  253.  
  254.  
  255. procedure PrintShortDirectory;
  256. begin
  257.   lines := 1;
  258.   for X:=1 to total do
  259.     with List[X] do begin
  260.  
  261.  
  262.       if (copy(Name,10,3) = 'PAS') or (copy(Name,10,3) = 'INC')
  263.          then
  264.             begin
  265.                write(LST,Name,Size:6:0,' ',Date:8,' ',Time:6,'  ');
  266.                assign(Filename,OldName[x] );
  267.                Reset(Filename);
  268.                readln(Filename,LineOne);
  269.                readln(Filename,LineOne);
  270.                readln(Filename,LineOne);
  271.                writeln(LST,Copy(LineOne,2,42) );
  272.  
  273.                lines := lines + 1;
  274.                if lines > 60 then
  275.                   begin
  276.                     writeln(LST);
  277.                     writeln(LST);
  278.                     writeln(LST);
  279.                     writeln(LST);
  280.                     writeln(LST);
  281.                     writeln(LST);
  282.                     writeln(LST);
  283.                     writeln(LST);
  284.                     lines := 1;
  285.                   end;
  286.             end;
  287.       end;
  288. end; {PrintShortDirectory}
  289.  
  290.  
  291. procedure PrintLongDirectory;
  292. begin
  293.   lines := 1;
  294.   for X:=1 to total do
  295.     with List[X] do begin
  296.  
  297.  
  298.       if (copy(Name,10,3) = 'PAS') or (copy(Name,10,3) = 'INC')
  299.          then
  300.             begin
  301.                writeln(LST,Name,Size:6:0,' ',Date:8,' ',Time:6,'  ');
  302.                assign(Filename,OldName[x] );
  303.                Reset(Filename);
  304.                readln(Filename,LineOne);
  305.                readln(Filename,LineOne);
  306.                readln(Filename,LineOne);
  307.                writeln(LST,LineOne);
  308.                readln(Filename,LineOne);
  309.                writeln(LST,LineOne);
  310.                readln(Filename,LineOne);
  311.                writeln(LST,LineOne);
  312.                writeln(LST);
  313.                lines := lines + 5;
  314.                if lines > 56 then
  315.                   begin
  316.                     writeln(LST);
  317.                     writeln(LST);
  318.                     writeln(LST);
  319.                     writeln(LST);
  320.                     writeln(LST);
  321.                     writeln(LST);
  322.                     lines := 1;
  323.                   end
  324.                else writeln;
  325.             end;
  326.       end;
  327. end; {LongDirectory}
  328.  
  329.  
  330. procedure SelectPrint;
  331. begin
  332.   Extend := ' ';
  333.   while upcase(Extend) <> 'E' do
  334.     begin
  335.       clrscr;
  336.       gotoxy(20,6);
  337.       writeln('            DIRTE DIRECTORY');
  338.       gotoxy(20,8);
  339.       writeln('         Ensure printer is ready');
  340.       gotoxy(10,10);
  341.       writeln('Type <S> for SHORT,  <L>  for LONG directory,  <E> to end');
  342.       read(KBD,Extend);
  343.       if upcase(Extend) = 'S' then PrintShortDirectory;
  344.       if upcase(Extend) = 'L' then PrintLongDirectory;
  345.     end;
  346. end; {SelectPrint}
  347.  
  348. begin
  349.   clrscr;
  350.   Gotoxy(30,10);
  351.   Writeln('DIRTE DIRECTORY');
  352.   TextColor(White);
  353.   FileMask:='*.*';                               { default to all files *.* }
  354.   Directory(FileMask,List,Total);
  355.   clrscr;
  356.   ShortDirectory;
  357.   writeln;
  358.   write(
  359.     '<SPACE BAR> for Long Directory, <P> for Printer Options,  <C/R> to end');
  360.   read(KBD,Extend);
  361.   writeln;
  362.   if Extend = ' ' then
  363.      begin
  364.        clrscr;
  365.        LongDirectory;
  366.      end;
  367.   if upcase(Extend) = 'P' then
  368.      begin
  369.        clrscr;
  370.        SelectPrint;
  371.      end;
  372.  
  373.   end.
  374. 
  375.