home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TUR6_102.ZIP / DISKOVER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-01-24  |  59.0 KB  |  1,466 lines
  1.  
  2. program CreateFloppyCover;
  3. {$V-}
  4. (*  This program reads a floppy and creates a floppy cover sheet
  5. Program - Disk Cover (DISKOVER)
  6.  
  7. This program was written to replace the Public Domain program
  8. COVER.  This was a good program however it has a bug in it under
  9. Dos 3.1.  The free space routine did not work.  It gave you
  10. improper values.  The program COVER also went into the wild blue
  11. and hung my machine when it read a quad density (808K) diskette with
  12. 4 sub directories.
  13.  
  14. This program also allows you to dump the data to a disk file so
  15. that you can print it later with PRINT.  This also allows you to
  16. free up your machine faster.
  17.  
  18. If anyone has another brand of printer they could do a quick
  19. patch to the source to change the Condenced and form feed characters.
  20. The program also does a reset to the default values at end of
  21. the print.  If they don't have Turbo Pascal (who doesn't) they
  22. could patch the output print file with their own printer codes.
  23.  
  24. The program is set up to allow up to 40 directories and 700 files.
  25. (Anything larger causes a compile error)  Not many people have that on
  26. floppies, but it will read a hard disk also and create a mini type list.
  27.  
  28. The program does not allow you to create a file DIR.DIR on the disk
  29. that you are reading. It assumes that the device has a removable
  30. recording media and that if you are creating multiple labels then
  31. when the program would go to read the next diskette the file DIR.DIR
  32. would be gone.  To get a listing of the Hard Disk go to the A: drive
  33. and type C:DISKOVER, you could then create the file DIR.DIR on the A:
  34. drive.  The program could also be executed from the C: drive and just
  35. request the printer output instead of the file output.
  36.  
  37. The program uses the Volume-ID on the diskette or hard-disk and it gives
  38. you an option to create a volume-id if one is not on the disk.  I have
  39. read that you can not create a volume-id from a turbo program by writing
  40. a file and then changing it's attribute bytes.  That is a true statement
  41. because I tried it also but I found that if you use DOS Function call 3C
  42. then you can create the Volume ID.  But if you do this you must also do a
  43. close of the file call 3E or you end up out of file handles.  Take it from
  44. experience.
  45.  
  46. Program Written and Copyright (C) by Karson W. Morrison
  47.                                      Marty Morrison
  48.                                      Caleb Computing Center  (Numbers 13:30)
  49.                                      RD 1, Box 531,
  50.                                      Ringoes, New Jersey 08551
  51.  
  52. Please leave this Doc file with the program and source.          *)
  53. {-----------------------------------------------------------------------}
  54. {   Version 1.11                                                        }
  55. {    Changes to expand the program to read the Hard disk and accept     }
  56. {    up to 40 directories and 1000 files                                }
  57. {    and all the modifications there of.  Luckily only one person       }
  58. {    had version 1.00                                                   }
  59. {-----------------------------------------------------------------------}
  60. {   Version 1.12                                                        }
  61. {    Change to include the Volume-ID of the disk if it is on there      }
  62. {    if a volume id is not present, an option is provided to put one on }
  63. {    This version also included Windows.  The version of windows used   }
  64. {    was created by Lynn Canning                                        }
  65. {    Luckily no one had version 1.11                                    }
  66. {-----------------------------------------------------------------------}
  67. {   Version 1.13                                                        }
  68. {    Change to include the ability to read *.ARC files and extract the  }
  69. {    file information from them.  I used the public domain routines     }
  70. {    that had been written by Michael Quinlan as a CompuServ project    }
  71. {    to create a Turbo DeArcer.  I had a problem in using the Module    }
  72. {    TPARCV.PAS in that it worked for all *.ARC files I tried it on     }
  73. {    but one.  The module sure looked like it was running correct, but  }
  74. {    under one strange condition the seek for a new sector on the disk  }
  75. {    actually went backwards from where it was.  I rewrote the routine  }
  76. {    and it now works perfectly for that *.ARC file and all others I    }
  77. {    tried it on.  Michael if your out there I would like to talk to    }
  78. {    you about this one.                                                }
  79. {    Reduce the number of files from 1000 to 700 because of the ARC     }
  80. {    Capability.                Karson                                  }
  81. {-----------------------------------------------------------------------}
  82. {   Version 1.14                                                        }
  83. {    Change to include the ability to read *.LBR files and extract the  }
  84. {    file information from them.  I looked at the directory information }
  85. {    on many *.LBR files and tried to extract the information from them }
  86. {    I found three basic types of headers (1) one with no date or time  }
  87. {    in them, but they had binary zeros in the header. (2) One that had }
  88. {    the date as MM-DD-YY and time as HH:MM:SS. (3) one that had the    }
  89. {    date as the number of days from 1-1-78 and the time as is stored   }
  90. {    by DOS.  I have included routines to handle these formats.  If you }
  91. {    find any additional formats please let me know by letter to the    }
  92. {    following address (Please)  I would appreciate a diskette of the   }
  93. {    *.LBR file also.                                                   }
  94. {                             Karson                                    }
  95. {-----------------------------------------------------------------------}
  96. {   Version 1.15                                                        }
  97. {    Change to put a mini editor in the entry of data for Volume Id     }
  98. {    and the Diskover title message.  The codes are as follows          }
  99. {                                                                       }
  100. {     Ctrl A is left of line                                            }
  101. {     Ctrl F is right of line                                           }
  102. {     Ctrl S is left one character                                      }
  103. {     Ctrl D is right one character                                     }
  104. {     Ctrl G is delete character forward                                }
  105. {     Ctrl H is delete character backward (Backspace also)              }
  106. {     Ctrl Y is delete to end of line                                   }
  107. {                                                                       }
  108. {      *  Note Ctrl A and Ctrl Y delete the whole line of data. *       }
  109. {                                                                       }
  110. { You are always in an insert mode and anything typed at the cursor     }
  111. { causes the following characters to be moved to the right.             }
  112. {                                                                       }
  113. { These codes are similar to those in WordStar and Turbo.               }
  114. {     Coding by the Author with help from Borland's DataBase ToolBox    }
  115. {-----------------------------------------------------------------------}
  116. { Version 1.16 January 21, 1986                                         }
  117. {   Inserted coding to return the previous label with typing "F3" at    }
  118. {   the request for diskover label information.                         }
  119. {-----------------------------------------------------------------------}
  120. { Version 1.17 January 23, 1986                                         }
  121. {   Inserted coding to use the cursor keys for editing on the diskover  }
  122. {   label information. Left, right arrow Home and end work.             }
  123. {-----------------------------------------------------------------------}
  124. {   This program has been written and copyright by Karson W. Morrison   }
  125. {                                                  Marty Morrison       }
  126. {               Numbers 13:30                  Caleb Computing Center   }
  127. {                                       Rd1 Box 531 Ringoes NJ. 08551   }
  128. {                                                        201-788-1846   }
  129. {-----------------------------------------------------------------------}
  130.  
  131. const
  132.  
  133.   Max_dir              = 40;   { Max number of directory entries }
  134.                                     { it can be upped }
  135.   MaxWin               = 1;    {Maximum windows open at a time}
  136.   Max_Table_entries    = 700;
  137.   Max_Arc_Table_entries= 700;
  138.   DirStringLength      = 55;    { The length of the Directory String }
  139.   DirStringLengthMore  = 69;    { The length of the Dir String + file name }
  140.                                 { These values are above DOS maxinum. }
  141.  
  142.                  { Printer Constants }
  143. (*     Epson printer controls
  144. *)
  145.   Condenced_Print      = #$1B#$0F;   { Note this is ESC 15 for the Epson }
  146.   Top_Of_Form          = #$0C;       { Note this is 12 for the Epson }
  147.   Reset_Printer        = #$1B#$40;   { Note this is ESC @ for the Epson }
  148.   Line_Spacing         = #$1B#$30;   { Note this is line spacing of 1/8 in }
  149.  
  150. (*      Okidata 92 set
  151.   Condenced_Print      = #$1D;       { Note this is 17.1 CPI for the Okidata }
  152.   Top_Of_Form          = #$0C;       { Note this is FF for the Okidata }
  153.   Reset_Printer        = #$18;       { Note this is Clear Buffer Okidata }
  154.   Line_Spacing         = #$1B#$38;   { Note this is line spacing of 1/8 in }
  155. *)
  156.   Max_Print_Lines      = 39;         { Maximum number of print rows }
  157.                                      { Counting heading and data }
  158.  
  159. type
  160.  
  161.  
  162.   String20             = string[20];
  163.   String41             = string[41];
  164.   Str80                = string[80];
  165.   Str50                = string[50];
  166.   String82             = string[82];
  167.   String42             = string[42];
  168.   String13             = string[13];
  169.   AnyStr               = string[255];
  170.   CharSet              = set of Char;
  171.  
  172.   SortArray            = array[1..Max_Table_Entries] of String41;
  173.  
  174.   RegRec =                               { The data to pass to DOS }
  175.     record
  176.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  177.     end;
  178.   HalfRegtype = record Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:byte              end;
  179.  
  180. var
  181.                      { File and Drive areas }
  182.   FileMO,                                { File creation Month }
  183.   FileDA,                                { File creation Day }
  184.   FileYR,                                { File creation Year }
  185.   FileHR,                                { File creation Hour  24 hour clock }
  186.   FileMN,                                { File creation Minute 60 min clock }
  187.   ReadDrive,                             { This is the drive I will read }
  188.   DefaultDrive,                          { This is the current default drive }
  189.   WriteDrive           : String[2];      { Drives used in reading and writing }
  190.   DriveWanted          : String[1];      { What drive do you want to read }
  191.   VolumeIDWanted       : Char;           { Create Volume ID }
  192.   FileSizeString       : string[6];      { This is the file size string format }
  193.   SortList             : SortArray;      { This is the array being sorted }
  194.   ArcList              : SortArray;   { This is the array of files in the arc }
  195.   NumericDriveHold,                 { Used in the free space on floppy drive }
  196.   status,                                { Not checked on Val command }
  197.   BegSub,                                { The beginning subscript }
  198.   E, E_use,                              { Working integers }
  199.   HoldDirNum,                            { The file Dir in integer format }
  200.   SRN,                                   { SortRecordNumber }
  201.   ArcSrn,                                { Used in Arc file Manipulation }
  202.   Lbrsrn,                                { Used in LBR file manipulation }
  203.   SRNWork,                               { Used in the print of the cover }
  204.   SRNHold,                               {  "    "  "    "    "  "    "   }
  205.   SRN2ndHalf,                            {  "    "  "    "    "  "    "   }
  206.   FileSiLow,                             { Low order byte file size }
  207.   FileSiHigh           : integer;        { High order byte file size }
  208.   RealWork,                              { Used in the calculation }
  209.   TotalAreaOnDisk,                       { Used in calculation of space on disk }
  210.   FreeAreaOnDisk       : real;           { of free area on the floppy }
  211.   HoldDir,                               { Used to compare current dir }
  212.   HoldDirSave,                           { Used to restore HoldDir }
  213.   HoldDirComp,                           {  with previous directories  }
  214.   FileDir              : string[2];      { Directory Tree Subscript }
  215.   FileNme              : string[14];     { File Name }
  216.   FileDateDos          : integer;        { File Creation Date Dos Format }
  217.   FileHourDos          : integer;        { File Creation Time Dos Format }
  218.   FileSiz              : real;           { File size }
  219.   FileAttributes       : string[3];      { Codes for System, hidden, dir etc. }
  220.   FilVar               : text;           { Is it Disk: or LST: }
  221.   MaxEntries,                            { Have I reached Max in the table }
  222.   MaxArcEntries,                         { Have I reached Max in the table }
  223.   GoodFileName,                          { This is a disk file }
  224.   FirstTimeDrive,                        { First time in the Drive Routine }
  225.   FirstTime,                             { First time in this routine }
  226.   DriveOK,                               { Its OK to do this drive }
  227.   NotDir               : Boolean;        { This is not a directory rec I read }
  228.   Buffer,                                { Used in file name manipulation }
  229.   Buffer1,                               {               "                }
  230.   Buffer2              : String [DirStringLength];
  231.                                          {               "                }
  232.   DirTable             : Array [ 1..Max_dir ] of string[DirSTringLength];
  233.                                          { Dirs Found }
  234.   FileHidden,                            { The file is a hidden file }
  235.   FileRead,                              { The file is a read only file }
  236.   FileSystem           : Boolean;        { The file is a system file }
  237.   HoldDirName          : String41;       { used in arc handleing }
  238.   HoldDirNameSave      : String41;       { used in lbr handleing }
  239.   PrevLine             : AnyStr;         { used in title processing }
  240.  
  241.                      { Dos Areas }
  242.  
  243.   Regs                 : RegRec;         { Dos Registers }
  244.   HalfRegs             : halfregtype absolute regs;
  245.   NamR                 : String20;       { The file name from the DTA }
  246.   DTA                  : array [ 1..43 ] of Byte;  { Back from DOS }
  247.   Mask                 : array [ 1..DirStringLength ] of Char;
  248.                                          { What do we read DOS calls }
  249.   MaskArray            : Array [ 1..DirStringLengthMore ] of Char;
  250.                                          { The file name }
  251.   Error                : integer;        { Error code from Dos - Not used in }
  252.                                          { coding, this was a testing field }
  253.   VolumeIDWrite        : string[16];     { The disk Volume-id }
  254.   VolumeIDRead         : string[16];
  255.  
  256.  
  257.                      { Printer Areas }
  258.  
  259.   ColumnWork,                            { Work area for print columns }
  260.   Column               : string82;       { The slip sheet line for big dirs }
  261.   Column3              : string[88];     { The slip sheet line for big dirs }
  262.   Column1,                               { The slip sheet line for small dirs }
  263.   Column2              : string42;       { The second column for the slip sheet }
  264.   ExternalMessage      : string[50];     { What is printed on the slip sheet }
  265.   PrintLines,                            { Number of lines printed not }
  266.                                          { counting dashes }
  267.   SlipSheetLines,                        { Number of lines on a slip sheet }
  268.   PrintPages,                            { Number of Slip sheets on a page }
  269.   PrintColumn          : integer;        { Number of column being printed }
  270.   heading,                               { The heading line }
  271.   blankline,                             { The side lines }
  272.   Dashes               : string[88];     { What prints at top of form }
  273.   FoldLine             : string[88];     { The fold line on a long slip sheet }
  274.   PrintOption          : Boolean;        { Do we create the print report }
  275.  
  276.                      { Misc Areas }
  277.  
  278.   timestr              : string[11];     { like it says }
  279.   datestr              : string[15];     {     "        }
  280.   Option               : Char;
  281.   DirectoryChanged     : string[1];      { Did we just change a directory }
  282.   I,                                     { used for loops }
  283.   A, B, C,                               {        "         }
  284.   NumberRecs,                            { How many records on disk }
  285.   FileYear,                              { File Year actual not just since 1980 }
  286.   FileWork,                              { Work area }
  287.   FileWork2            : integer;        { Work area }
  288.   FileWork3            : real;           { Work area for file size }
  289.   NewDir,                                { Work areas in directory name }
  290.   NewDirWork : string[DirStringLengthMore];       {   and file name manipulation }
  291.   FileOption,                            { Do you want a dir file instead of }
  292.                                          {   a slip sheet  }
  293.   DirOption,                             { Do you only want to use 1 directory }
  294.   DirOptionContinued   : Boolean;        { Is this the second or more dir }
  295.                                          { when you are processing by dirs }
  296. {  DirectoryWanted      : string[DirStringLength]; } { only do each dir }
  297.  
  298. (*****************************************************************************
  299.               This is the beginning of the program code.
  300. *****************************************************************************)
  301. {$IWindo.Inc}
  302. {$IDISKARC.INC}
  303. {$IDISKLBR.INC}
  304. {----------------------------------------------------------------------------}
  305.                 {  This routine get the DOS date and makes it look good }
  306.  
  307. procedure date;           { What is todays date }
  308. const
  309.     montharr : array [1..12] of string[3] =
  310.                ('Jan','Feb','Mar','Apr','May',
  311.                 'Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  312.  
  313. var
  314.     regs:regrec;
  315.     month, day:string[2];
  316.     year:string[4];
  317.     dx, cx, result, tmpmonth:integer;
  318.  
  319. begin
  320.     with regs do
  321.     begin
  322.       ax:= $2a shl 8;
  323.     end;
  324.     msdos (regs);
  325.     with regs do
  326.     begin
  327.       str(cx:4, year);
  328.       str(dx shr 8:2, month);
  329.       str(dx mod 256:2, day);
  330.     end;
  331.     if month[1] = ' ' then month[1] := '0';
  332.     val (month, tmpmonth, result);
  333.     datestr:= day + '-' + montharr[tmpmonth] + '-' + year
  334. end; { procedure date }
  335.  
  336.  
  337.              { This routine gets the DOS time and makes it look good }
  338.  
  339. procedure time;               { What is the current time }
  340. var                           { Not on your watch! in the computer }
  341.   regs:regrec;
  342.   ah, al, ch, cl, dh:byte;
  343.   hour, min, sec, ampm:string[2];
  344.   tmptime, result:integer;
  345.  
  346. begin
  347.   ah := $2c;
  348.   with regs do
  349.   begin
  350.     ax := ah shl 8 + al;
  351.   end;
  352.   intr($21,regs);
  353.   with regs do
  354.   begin
  355.     str(cx shr 8:2, hour);
  356.     str(cx mod 256:2, min);
  357.     str(dx shr 8:2, sec);
  358.   end;
  359.   if (hour > '11') then
  360.     ampm := 'pm'
  361.   else
  362.     ampm := 'am';
  363.   if (hour < ' 1') then
  364.     begin
  365.       ampm := 'am';
  366.       hour := '12';
  367.     end;
  368.   if (hour > '12') then
  369.     begin
  370.       val (hour, tmptime, result);
  371.       tmptime:= tmptime - 12;
  372.       str (tmptime:2, hour);
  373.     end;
  374.   if (min[1] = ' ') then
  375.     min[1]:= '0';
  376.   if (sec[1] = ' ') then
  377.     sec[1]:= '0';
  378.   timestr := hour + ':' + min + ':' + sec + ' ' + ampm;
  379. end; { procedure time }
  380.  
  381.  
  382.           { This routine sets up the Data Transfer Area (DTA) for DOS }
  383.  
  384. procedure SetUpDTA;
  385. begin
  386.   Regs.AX := $1A00;                    { Function used to set the DTA }
  387.   Regs.DS := Seg(DTA);                 { store the parameter segment in DS }
  388.   Regs.DX := Ofs(DTA);                 {   "    "      "     offset in DX }
  389.   MSDos(Regs);                         { Set DTA location }
  390.   Error := Regs.AX and $FF;
  391. end;
  392.  
  393. {----------------------------------------------------------------------------}
  394.             { This routine reads the volume id in a directory }
  395.       {---  Written by Karson W Morrison Caleb Computing Center ---}
  396.  
  397. procedure ReadVolume;
  398. var i,a : integer;
  399. begin
  400.   VolumeIDWrite := DriveWanted + ':\????????.???' + chr(0);
  401.   for i := 1 to length(VolumeIDWrite) do
  402.     Mask[i] := VolumeIDWrite[i];
  403.   VolumeIDRead := '           ';
  404.   Regs.AX := $4E00;             { Get first directory entry }
  405.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  406.   Regs.DX := Ofs(Mask);
  407.   Regs.CX := $0008;             { Store the option for Volume label }
  408.   MSDos(Regs);                  { Execute MSDos call }
  409.   Error := Regs.AX and $FF;     { Get Error return }
  410.   a := 0;
  411.   if error = 0 then
  412.   for i := 1 to 12 do
  413.     if i <> 9 then
  414.       begin
  415.          a := a + 1;
  416.          VolumeIDRead[a] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+i]);
  417.       end;
  418.   for i := 1 to 12 do
  419.     if VolumeIDRead[i] = Chr(0) then
  420.        VolumeIDRead[i] := ' ';
  421. end;
  422.  
  423. {----------------------------------------------------------------------------}
  424.             { This routine writes the volume id in a directory }
  425.        {---  Written by Karson W Morrison Caleb Computing Center ---}
  426. procedure WriteVolume;
  427. var i,a : integer;
  428. begin
  429.   VolumeIDWrite := DriveWanted + ':' + VolumeIDWrite + chr(0);
  430.   a := 0;
  431.   for i := 1 to length(VolumeIDWrite) do
  432.    if i <> 11 then
  433.    begin
  434.      a := a + 1;
  435.      Mask[a] := VolumeIDWrite[i];
  436.    end
  437.    else
  438.    begin
  439.      a := a + 1;
  440.      Mask[a] := '.';
  441.      a := a + 1;
  442.      Mask[a] := VolumeIDWrite[i];
  443.    end;
  444.   Regs.AX := $3C00;             { Create a file }
  445.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  446.   Regs.DX := Ofs(Mask);
  447.   Regs.CX := $0008;             { Store the option for Volume label }
  448.   MSDos(Regs);                  { Execute MSDos call }
  449.   Regs.BX := Regs.AX;           { Put file handle in BX }
  450.   Regs.AX := $3E00;             { Close the file }
  451.   MSDos(Regs);                  { Execute MSDos call }
  452.   Error := Regs.AX and $FF;     { Get Error return }
  453. end;
  454.  
  455.  
  456.             { This routine reads the first record in a directory }
  457.  
  458. procedure ReadFirst;
  459. begin
  460.   Regs.AX := $4E00;                    { Get first directory entry }
  461.   Regs.DS := Seg(Mask);                { Point to the file Mask }
  462.   Regs.DX := Ofs(Mask);
  463.   Regs.CX := 23;                       { Store the option }
  464.   MSDos(Regs);                         { Execute MSDos call }
  465.   Error := Regs.Flags and $01;
  466. end;
  467.  
  468.  
  469.            { This routine reads all following records in a directory }
  470.  
  471. procedure ReadNext;
  472. begin
  473.     Error := 0;
  474.     Regs.AX := $4F00;                  { Function used to get the next }
  475.                                        { directory entry }
  476.     Regs.CX := 23;                     { Set the file option }
  477.     MSDos(Regs);                       { Call MSDos }
  478.     Error := Regs.AX or (Regs.Flags and $01) and $FF;  { get the Error return }
  479. end;
  480.  
  481.  
  482.            { This routine gets the name string from the directory }
  483.            {   VIA the DTA.  }
  484.  
  485. procedure SetUpNamR;                   { Get the file name from the directory }
  486. begin
  487.     repeat
  488.       NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
  489.       I := I + 1;
  490.     until not (NamR[I-1] in [' '..#$7F]) or (I>20);   { Note: The second item }
  491.                                        { being compared as in [' '..#$7F] is  }
  492.                                        { the 7Fh char DEL }
  493.  
  494.   NamR[0] := Chr(I-1);                 { set string length because assigning }
  495.                                        { by element does not set length }
  496. end;
  497.  
  498.  
  499.           { This routine gets the new directory name from the table }
  500.           {  that was built as we were reading the parent directory }
  501.           {  it is for this reason that the children directories are }
  502.           {  not built on the floppy imediately following the parent }
  503.           {  directories.  All parent directories are saved followed }
  504.           {  by all level 2 subdirectories, followed by the third level }
  505.           {  Etc. }
  506. {----------------------------------------------------------------------------}
  507.  
  508. procedure Set_Up_Dir_Chg;              { Get a new directory from the table }
  509. begin
  510.     E_Use := E_Use + 1;
  511.     Buffer := DirTable[E_use] + '\????????.???' + Chr( 0);
  512.     Buffer1 := DirTable[E_use];
  513.     GoToXY(25,18); ClrEol;
  514.     Write(Buffer1);
  515.     NewDir := DirTable[E_use] + Chr(0);
  516.     NewDir[1] := WriteDrive[1];       { overlay the read drive with the write }
  517.     NewDirWork := NewDir;       { this will be used to set up new directories }
  518.                                 { on a floppy if it changes floppies. }
  519.     if length(Buffer1) = 1 then Buffer1 := '';
  520.     for I := 1 to length(Buffer) do
  521.       Mask[I] := Buffer[I];
  522.     DirectoryChanged := '1';
  523. end;
  524.  
  525. {----------------------------------------------------------------------------}
  526.          {  This routine gets the Date from the DTA for the file }
  527.  
  528. procedure FindDate;                    { Translate the Date from the Disk to }
  529. begin                                  { Something readable }
  530.     FileMO := '  ';                       { yyyyyyymmmmddddd  in bits}
  531.     FileDA := '  ';
  532.     FileDateDos := MemW[Seg(DTA):Ofs(DTA)+24];
  533.     FileYear := FileDateDos shr 9;     { drop off the last 9 positions }
  534.     Str((FileYear + 80),FileYR);       { years are added to base year of 1980 }
  535.     FileWork := FileDateDos shl 7;     { drop off the first 7 positions }
  536.     Str((FileWork shr 12),FileMO);     { now move it back to the right }
  537.     FileWork := FileDateDos shl 11;    { drop off the left 11 positions }
  538.     Str((FileWork shr 11),FileDA);     { now move back to the right }
  539.     FileMO[0] := Chr(2);
  540.     FileDA[0] := Chr(2);
  541.     if FileDA[2] = ' ' then
  542.     begin
  543.        FileDA[2] := FileDA[1];
  544.        FileDA[1] := '0';
  545.     end;
  546.     if FileMO[2] = ' ' then
  547.     begin
  548.        FileMO[2] := FileMO[1];
  549.        FileMO[1] := '0';
  550.     end;
  551. end;
  552.  
  553. {----------------------------------------------------------------------------}
  554.         { This routine gets the time from the DTA for the file }
  555.  
  556. procedure FindTime;              { Get the time and put it in a format that }
  557. begin                            { we can use. The Dos Format in bits is    }
  558.     FileHR := '  ';                 { hhhhhmmmmmmsssss }
  559.     FileMN := '  ';
  560.     FileHourDos := MemW[Seg(DTA):Ofs(DTA)+22];
  561.     Str((FileHourDos shr 11),FileHR);  { Shift it around so the minutes and }
  562.     FileWork := FileHourDos shl 5;     { seconds disappear }
  563.     Str((FileWork shr 10),FileMN);
  564.     FileHR[0] := Chr(2);
  565.     FileMN[0] := Chr(2);
  566.     if FileHR[2] = ' ' then
  567.     begin
  568.        FileHR[2] := FileHR[1];
  569.        FileHR[1] := '0';
  570.     end;
  571.     if FileMN[2] = ' ' then
  572.     begin
  573.        FileMN[2] := FileMN[1];
  574.        FileMN[1] := '0';
  575.     end;
  576. end;
  577.  
  578. {----------------------------------------------------------------------------}
  579.          { This routine gets the file size from the DTA }
  580.  
  581. procedure FindSize;                       { Get the file size and format it so we can }
  582. begin                                     { use it                                    }
  583.     FileWork := MemW[Seg(DTA):Ofs(DTA)+26];  { Get from DTA, Low byte of size }
  584.     FileSiLow := FileWork;                   { Save Low byte size        }
  585.     FileWork2 := FileWork shr 15;            { Is the High bit on        }
  586.     FileWork3 := FileWork2 * 32768.0;        { yes! Save the size        }
  587.     FileWork2 := FileWork shl 1;             { Get rid of high bit       }
  588.     FileWork := FileWork2 shr 1;             { Now back to where we were }
  589.     FileWork3 := FileWork3 + FileWork;       { Lets add them together    }
  590.     FileWork := MemW[Seg(DTA):Ofs(DTA)+28];  { Get from DTA, High byte   }
  591.     FileSiHigh := FileWork;                  { Save High byte size       }
  592.     FileSiz := FileWork3 + (FileWork * 65536.0);   { Make size total    }
  593. end;
  594.  
  595. {----------------------------------------------------------------------------}
  596.            { This routine looks at the DTA to find the byte that }
  597.            { carries the attribute bytes with the indicator that }
  598.            { shows what is a directory.  This routine also get the }
  599.            { System, Hidden and read only attribute              }
  600.  
  601. procedure PrintDTA;
  602. var
  603.    FileAttr            : Byte;
  604. begin
  605.     FileHidden := false;
  606.     FileRead := false;
  607.     FileSystem := false;
  608.     GoodFileName := true;
  609.     FileAttr := Byte(Mem[Seg(DTA):Ofs(DTA)+21]);
  610.     if FileAttr > 31 then              { File Not Archived  }
  611.     begin
  612.       FileAttr := FileAttr - 32;
  613.     end;
  614.     if FileAttr > 15 then              { This is a directory entry      }
  615.     begin                              { Let's do it to it              }
  616.       GoodFileName := false;
  617.       E := E + 1;                      { Save the name in the table     }
  618.       Buffer2 := Buffer1;
  619.       A := Length(Buffer2) + 1;
  620.       B := Length(NamR);
  621.       C := 1;
  622.       Buffer2[A] := '\';
  623.       repeat
  624.         A := A + 1;
  625.         Buffer2[A] := NamR[C];
  626.         C := C + 1;
  627.       until C > B;
  628.       if A > 49 then      { Dos has a maxinum of 63, this is to allow file name }
  629.       begin
  630.         Writeln;
  631.         ClrEol;
  632.         Writeln('This program has encountered a directory string greater than');
  633.         ClrEol;
  634.         Writeln('DOS allowed.  Dos only allows a concatinated string length of');
  635.         ClrEol;
  636.         Writeln('63 positions.');
  637.         ClrEol;
  638.         Halt;
  639.       end;
  640.       Buffer2[0] := Chr(A - 1);
  641.       DirTable[ E ] := Buffer2;
  642.     end;
  643.     if FileAttr > 7 then               { Volume Label }
  644.        FileAttr := FileAttr - 8;
  645.     if FileAttr > 3 then               { System File }
  646.     begin
  647.        FileAttr := FileAttr - 4;
  648.        FileSystem := true;
  649.     end;
  650.     if FileAttr > 1 then               { Hidden File }
  651.     begin
  652.        FileAttr := FileAttr - 2;
  653.        FileHidden := true;
  654.     end;
  655.     if FileAttr > 0 then               { Read Only }
  656.     begin
  657.        FileAttr := FileAttr - 1;
  658.        FileRead := true;
  659.     end;
  660. end;
  661.  
  662. {----------------------------------------------------------------------------}
  663.       {  This routine gets the current default drive }
  664.       {  If the option is to create the print file on }
  665.       {  disk then the input drive for the program to read }
  666.       {  cannot be the default drive, because the file DIR.DIR }
  667.       {  will be created on the default drive. }
  668.  
  669. procedure GetCurrentDrive;
  670. begin
  671.   Regs.AX := $1900;
  672.   MSDos(Regs);
  673.   DefaultDrive := Char(HalfRegs.Al + 65) + ':';  { HalfRegs.Al has $00 for }
  674.   Error := Regs.Flags and $01;                   { drive A, $01 for B, etc. }
  675. end;
  676.  
  677. {----------------------------------------------------------------------------}
  678. {  the following routines were taken from a Borland Package in their database }
  679. {  toolbox, and have been modified by the author }
  680.  
  681. function ConstStr(C : Char; N : Integer) : Str80;
  682. var
  683.   S : string[80];
  684. begin
  685.   if N < 0 then
  686.     N := 0;
  687.   S[0] := Chr(N);
  688.   FillChar(S[1],N,C);
  689.   ConstStr := S;
  690. end;
  691.  
  692. (*  Beep sounds the terminal bell or beeper *)
  693.  
  694. procedure Beep;
  695. begin
  696.   Write(^G);
  697. end;
  698.  
  699. procedure InputStr(var S     : AnyStr;
  700.                        L,X,Y : Integer;
  701.                        Term  : CharSet;
  702.                    var TC    : Char    );
  703. const
  704.   UnderScore  =  '_';
  705. var
  706.   P : Integer;
  707.   Ch : Char;
  708.   Snd : Char;
  709. begin
  710.   GotoXY(X,Y); Write(S,ConstStr(UnderScore,L - Length(S)));
  711.   P := 0;
  712.   repeat
  713.     GotoXY(X + P,Y); Read(Kbd,Ch);
  714.     case Ch of
  715.       #27       : begin
  716.                     Read(Kbd,Snd);
  717.                     case Snd of
  718.                       #61  : begin
  719.                                S := PrevLine;
  720.                                P := Length(S);
  721.                                GotoXY(X,Y); Write(S,ConstStr(UnderScore,L - Length(S)));
  722.                               end;
  723.                       'K'  :  if P > 0 then P := P -1
  724.                                 else Beep;
  725.                       'M'  :  if P < length(S) then P := P + 1
  726.                                 else Beep;
  727.                       'G'  :  P := 0;
  728.                       'O'  :  P := length(S);
  729.                       'S'  :  if P < length(S) then
  730.                                 begin
  731.                                    Delete(S,P+1,1);
  732.                                    Write(Copy(S,P+1,L),UnderScore);
  733.                                 end
  734.                                 else Beep;
  735.                     else Beep;
  736.                     end;   { of case }
  737.                  end;
  738.       #32..#126 : if P < L then
  739.                   begin
  740.                     if Length(S) = L then
  741.                       Delete(S,L,1);
  742.                     P := P + 1;
  743.                     Insert(Ch,S,P);
  744.                     Write(Copy(S,P,L));
  745.                   end
  746.                   else Beep;
  747.       ^S        : if P > 0 then
  748.                     P := P - 1
  749.                   else Beep;
  750.       ^D        : if P < Length(S) then
  751.                     P := P + 1
  752.                   else Beep;
  753.       ^A        : P := 0;
  754.       ^F        : P := Length(S);
  755.       ^G        : if P < Length(S) then
  756.                   begin
  757.                     Delete(S,P + 1,1);
  758.                     Write(Copy(S,P + 1,L),UnderScore);
  759.                   end;
  760.       ^H,#127   : if P > 0 then
  761.                   begin
  762.                     Delete(S,P,1);
  763.                     Write(^H,Copy(S,P,L),UnderScore);
  764.                     P := P - 1;
  765.                   end
  766.                   else Beep;
  767.       ^Y        : begin
  768.                     Write(ConstStr(UnderScore,Length(S) - P));
  769.                     Delete(S,P + 1,L);
  770.                   end;
  771.     else
  772.       if not (Ch in Term) then Beep;
  773.     end;  {of case}
  774.   until Ch in Term;
  775.   P := Length(S);
  776.   PrevLine := S;
  777.   GotoXY(X + P,Y);
  778.   Write('' :L - P);
  779.   TC := Ch;
  780. end;
  781. {               End of the routines modified from the Borland's package      }
  782. {----------------------------------------------------------------------------}
  783.           { This routine prints a slip sheet that will go into the diskette }
  784.           { envelope.  The routine uses the lo and hi }
  785.           { subscripts and prints all file names in between. }
  786.  
  787. Procedure PrintLabel(PrintList : SortArray; lo, hi : integer);
  788. const
  789.    Term : CharSet = [^M,^Z];
  790. var
  791.    SRNStop    : integer;
  792.    SRNHold    : integer;
  793.    SRN2ndHalf : integer;
  794.    I          : integer;
  795.    TC         : char;
  796. begin
  797.      if PrintLines = 0 then
  798.      begin
  799.         GoToXY(5,22); Write('Type "F3" to return previous label');
  800.         GoToXY(1,19); Writeln('What external label do you want on the Cover?');
  801.         ExternalMessage := '';
  802.         repeat
  803.            InputStr(ExternalMessage,50,1,20,Term,TC);
  804.         until TC in Term;
  805.         for I := Length(ExternalMessage) + 1 to 50 do
  806.           ExternalMessage[I] := ' ';
  807.         ExternalMessage[0] := chr(50);
  808.         Writeln(FilVar,dashes);
  809.         Writeln(FilVar,blankline);
  810.         Writeln(FilVar,'| ',ExternalMessage,' Free: ',FreeAreaOnDisk:7:0,'   ',DateStr,'       |');
  811.         Column2 := '                                        ';
  812.         Write(FilVar,'|  Volume-ID: ',VolumeIDRead,'                 ');
  813.         Writeln(FilVar,'                           ',TimeStr,'       |');
  814.         PrintLines := 4;
  815.         SlipSheetLines := 4;
  816.         PrintColumn := 1;
  817.      end;
  818.      if HoldDir <> '01' then
  819.      begin
  820.         Val(HoldDir,HoldDirNum,status);
  821.         Column1 := '                                        ';
  822.         HoldDirName := DirTable[HoldDirNum];
  823.         Delete(HoldDirName,1,2);            { delete the first 2 character }
  824.         Column1 := HoldDirName;             { it's the drive and : }
  825.         HoldDirName := HoldDirName +'\';    { set up for *.ARC processing }
  826.         HoldDirNameSave := HoldDirName;     { set up for *.LBR processing }
  827.         Column1[length(Column1)+1] := ' ';
  828.         Column1[length(Column1)+2] := ' ';
  829.         Column1[0] := chr(40);
  830.         Column3 := '| Directory ' + Column1 + '                                   |';
  831.         Writeln(FilVar,blankline);
  832.         Writeln(FilVar,Column3);
  833.         Writeln(FilVar,blankline);
  834.         PrintLines := PrintLines + 3;
  835.         SlipSheetLines := SlipSheetLines + 3;
  836.      end
  837.      else
  838.         HoldDirName := '';
  839.      SRN2ndHalf := (hi -((hi - lo) div 2) + 1); { 2nd half starts at 1 past }
  840.      if odd((hi + 1) - lo) then                 { the mid point }
  841.      begin                                      { if the total entries is }
  842.         SRNStop := SRN2ndHalf - 1;              { odd then then I need to }
  843.         SRN2ndHalf := SRN2ndHalf - 1;           { start 1 higher than the }
  844.      end                                        { mid point }
  845.      else
  846.      begin
  847.         SRNStop := SRN2ndHalf - 2;
  848.         SRN2ndHalf := SRN2ndHalf - 2;
  849.      end;
  850.      for I := lo to SRNStop do                 { from bottom to mid point }
  851.      begin
  852.         SlipSheetLines := SlipSheetLines + 1;
  853.         if SlipSheetLines > 40 then
  854.         begin
  855.           Writeln(FilVar,FoldLine);
  856.           SlipSheetLines := 2;                 { its 2 because the its one }
  857.           PrintLines := PrintLines + 1;        { higher than has been printed }
  858.         end;
  859.         SRN2ndHalf := SRN2ndHalf + 1;
  860.         Column1 := '                                        ';
  861.         ColumnWork := PrintList[I];
  862.         Delete(ColumnWork,1,2);
  863.         ColumnWork[0] := chr(length(PrintList[I])-2);
  864.         Column1 := ColumnWork;                 { remove the chr(0) at end }
  865.         Column1[0] := Chr(40);       { Make it a length of 40 }
  866.         Column2 := '                                        ';
  867.         if SRN2ndHalf <= hi then              { If I have already hit the }
  868.         begin                                 { end of the right side }
  869.           ColumnWork := PrintList[SRN2ndHalf]; { don't go any further  }
  870.           Delete(ColumnWork,1,2);
  871.           ColumnWork[0] := chr(length(PrintList[SRN2ndHalf])-2);
  872.           Column2 := ColumnWork;                 { remove the chr(0) at end }
  873.           Column2[0] := Chr(40);       { Make it a length of 40 }
  874.         end;
  875.         Writeln(FilVar,'|    ',Column1,' ',Column2,' |');  { Write the line }
  876.         PrintLines := PrintLines + 1;
  877.      end;
  878. end;
  879.  
  880. {----------------------------------------------------------------------------}
  881. {  This routine prints the header for the ARC files on the cover }
  882.  
  883. Procedure PrintArcHeader;
  884. begin
  885.      Column1 := '                                        ';
  886.      Column1 := ArcName;
  887.      Delete(Column1,1,2);                { delete the first 2 character }
  888.      Column1[length(Column1)+1] := ' ';
  889.      Column1[length(Column1)+2] := ' ';
  890.      Column1[0] := chr(40);                          { it's the drive: }
  891.      Column3 := '| Arc File  ' + Column1 + '                                   |';
  892.      Writeln(FilVar,blankline);
  893.      Writeln(FilVar,Column3);
  894.      PrintLines := PrintLines + 2;
  895.      SlipSheetLines := SlipSheetLines + 2;
  896. end;
  897. {----------------------------------------------------------------------------}
  898. {  This routine prints the files that are included in the *.ARC file }
  899. {  The routine scans the sorted files list looking for `.ARC' if I find it }
  900. {  I then procede to print the file, size, and date for all entries in the }
  901. {  ARC file }
  902.  
  903. Procedure PrintArc(lo, hi : integer);
  904. var
  905.    SRNStop    : integer;
  906.    SRNHold    : integer;
  907.    SRN2ndHalf : integer;
  908.    I          : integer;
  909.    hdr        : heads;
  910. begin
  911.    MaxArcEntries := False;
  912.    for i := lo to hi do
  913.    begin
  914.       if Pos('.ARC',SortList[i]) <> 0 then
  915.       begin
  916.          ArcName := copy(SortList[i],3,(Pos('.ARC',SortList[i])+2));
  917.          ArcName := ReadDrive + HoldDirName + ArcName;
  918.          OpenArc;
  919.          if arcopen then
  920.          begin
  921.             ArcSrn := 0;
  922.             while readhdr(hdr) do
  923.             begin
  924.               if ArcSrn < Max_Arc_Table_Entries then
  925.                  ArcSrn := ArcSrn + 1
  926.               else
  927.               begin
  928.                  if MaxArcEntries then
  929.                  else
  930.                  begin
  931.                     GoToXY(1,20);
  932.                     Write('The Maximum number of entries have been reached for the Arc Core Table');
  933.                     MaxArcEntries := True;
  934.                  end;
  935.               end;
  936.               lstfile(hdr);
  937.               fseek(long_to_real(hdr.size));
  938.             end;
  939.             fclose;
  940.             PrintArcHeader;
  941.             HoldDirSave := HoldDir;
  942.             HoldDir := '01';
  943.             PrintLabel(ArcList,1,ArcSrn);
  944.             HoldDir := HoldDirSave;
  945.          end;
  946.       end;
  947.    end;
  948. end;
  949.  
  950. {----------------------------------------------------------------------------}
  951. {  This routine prints the cover heading for the *.LBR file }
  952.  
  953. Procedure PrintLbrHeader;
  954. begin
  955.      Column1 := '                                        ';
  956.      Column1 := ArcName;
  957.      Delete(Column1,1,2);                { delete the first 2 character }
  958.      Column1[length(Column1)+1] := ' ';
  959.      Column1[length(Column1)+2] := ' ';
  960.      Column1[0] := chr(40);                          { it's the drive: }
  961.      Column3 := '| Lbr File  ' + Column1 + '                                   |';
  962.      Writeln(FilVar,blankline);
  963.      Writeln(FilVar,Column3);
  964.      PrintLines := PrintLines + 2;
  965.      SlipSheetLines := SlipSheetLines + 2;
  966. end;
  967.  
  968. {----------------------------------------------------------------------------}
  969. {  This routine prints the file names in the *.LBR file }
  970. {  it scans the sorted table array for a file with '.LBR' if found }
  971. {  I print the data.  See the comments in the DISKLBR.INC file and under the }
  972. {  main comments in this program for *.LBR file differences. }
  973.  
  974. Procedure PrintLbr(lo, hi : integer);
  975. var
  976.    SRNStop    : integer;
  977.    SRNHold    : integer;
  978.    SRN2ndHalf : integer;
  979.    I          : integer;
  980.    hdr        : heads;
  981. begin
  982.    for i := lo to hi do
  983.    begin
  984.       MaxArcEntries := False;
  985.       if Pos('.LBR',SortList[i]) <> 0 then
  986.       begin
  987.          HoldDirName := HoldDirNameSave;
  988.          ArcName := copy(SortList[i],3,(Pos('.LBR',SortList[i])+2));
  989.          ArcName := ReadDrive + HoldDirName + ArcName;
  990.          OpenLbr;
  991.          if lbropen then
  992.          begin
  993.             ArcSrn := 0;
  994.             while readlbrhdr do
  995.             begin
  996.               if ArcSrn < Max_Arc_Table_Entries then
  997.                  ArcSrn := ArcSrn + 1
  998.               else
  999.               begin
  1000.                  if MaxArcEntries then
  1001.                  else
  1002.                  begin
  1003.                     GoToXY(1,20);
  1004.                     Write('The Maximum number of entries have been reached for the Arc Core Table');
  1005.                     MaxArcEntries := True;
  1006.                  end;
  1007.               end;
  1008.               lstlbrfile;
  1009.               LbrFilePosition := LbrFilePosition + 32;
  1010.             end;
  1011.             closelbr;
  1012.             PrintLbrHeader;
  1013.             HoldDirSave := HoldDir;
  1014.             HoldDir := '01';
  1015.             PrintLabel(ArcList,1,ArcSrn);
  1016.             HoldDir := HoldDirSave;
  1017.          end;
  1018.       end;
  1019.    end;
  1020. end;
  1021.  
  1022. {----------------------------------------------------------------------------}
  1023.           { This routine Finishes the slip sheet when a floppy is changed }
  1024.           { If there are more files than will fit on the slip sheet I just }
  1025.           { keep it going even though it may be longer than 5 inches,  I }
  1026.           { didn't want to create 2 sheets of paper that may get lost.  I }
  1027.           { would rather have just one long sheet. }
  1028.  
  1029. Procedure CompSlipSheet;
  1030. begin
  1031.    if PrintOption or FileOption then
  1032.    begin
  1033.       if PrintColumn = 2 then
  1034.       begin
  1035.          PrintColumn := 1;
  1036.          Column2 := '                                        ';
  1037.          Writeln(FilVar,'|  ',Column1,'  ',Column2,'  |');
  1038.          PrintLines := PrintLines + 1;
  1039.       end;
  1040.       repeat
  1041.          Writeln(FilVar,blankline);
  1042.          PrintLines := PrintLines + 1;
  1043.       until PrintLines > 39;
  1044.       Writeln(FilVar,dashes);
  1045.       if (PrintPages = 2) or (PrintLines > 43) then { if I've printed more than }
  1046.       begin                                         { 43 lines go to a new page }
  1047.          PrintPages := 1;
  1048.          Write(FilVar,Top_Of_Form);       { new page }
  1049.       end
  1050.       else
  1051.          PrintPages := 2;
  1052.       PrintLines := 0;
  1053.    end;
  1054. end;
  1055.  
  1056. {----------------------------------------------------------------------------}
  1057.          { This routine does a DOS call to determine the free space left }
  1058.          { on the drive.  In Regs.DX you use a numeric representation of }
  1059.          { the drive you are using. 0 (zero) = default, 1 = A:, 2 = B: etc }
  1060.          { In the beginning of the MAIN routine I set up the field to be }
  1061.          { used in this routine. }
  1062.  
  1063. Procedure HowMuchSpaceLeft;
  1064. begin
  1065.     Regs.AX := $3600;             { Function used to get free disk space }
  1066.     Regs.DX := NumericDriveHold;
  1067.     MSDos(Regs);
  1068.     FreeAreaOnDisk := Regs.AX;                { Sectors per cluster }
  1069.     RealWork := Regs.CX;                      { Bytes per sector    }
  1070.     FreeAreaOnDisk :=FreeAreaOnDisk * RealWork;
  1071.     TotalAreaOnDisk := FreeAreaOnDisk;
  1072.     RealWork := Regs.BX;                      { Number of available clusters }
  1073.     FreeAreaOnDisk :=FreeAreaOnDisk * RealWork;
  1074.     RealWork := Regs.DX;                      { Total number of clusters }
  1075.     TotalAReaOnDisk := TotalAreaOnDisk * RealWork;
  1076. end;
  1077.  
  1078. {----------------------------------------------------------------------------}
  1079.           { This routine clears lines 19 thru 22 }
  1080.  
  1081. Procedure Clear_19_22;
  1082. begin
  1083.    GoToXY(1,22); ClrEol;
  1084.    GoToXY(1,21); ClrEol;
  1085.    GoToxy(1,20); ClrEol;
  1086.    GoToXY(1,19); ClrEol;
  1087. end;
  1088.  
  1089. {----------------------------------------------------------------------------}
  1090. procedure FindFileToPrint;           { Yep that is what it is }
  1091.  
  1092. begin
  1093.      if SRN < Max_Table_Entries then
  1094.         SRN := SRN + 1
  1095.      else
  1096.      begin
  1097.         if MaxEntries then
  1098.         else
  1099.         begin
  1100.            GoToXY(1,20);
  1101.            Write('The Maximum number of entries have been reached for the Core Table');
  1102.            MaxEntries := True;
  1103.         end;
  1104.      end;
  1105.      FileNme := '             ';       { Blank it out }
  1106.      FileNme := NamR;                  { Get file name }
  1107.      FileNme[length(fileNme)] := ' ';  { blank out chr(0) at end }
  1108.      FileNme[0] := Chr(13);
  1109.      Str(E_Use,FileDir);               { Get Directory its in }
  1110.      if length(FileDir) = 1 then
  1111.         FileDir := '0' + FileDir;
  1112.      FindDate;                         { Make date readable  }
  1113.      FindTime;                         { Time also }
  1114.      FindSize;                         { File size }
  1115.      FileAttributes := '   ';
  1116.      if FileSystem then
  1117.         FileAttributes[1] := 's';      { system }
  1118.      if FileHidden then
  1119.         FileAttributes[2] := 'h';      { hidden }
  1120.      if FileRead then
  1121.         FileAttributes[3] := 'r';      { read only }
  1122.      Str(FileSiz:6:0,FileSizeString);
  1123.      SortList[SRN] := FileDir + FileNme + FileMO + '-' + FileDA + '-' +
  1124.         FileYR + '  ' + FileHR + ':' + FileMN + ' ' + FileSizeString +
  1125.         ' ' + FileAttributes;
  1126. end;
  1127.  
  1128. {----------------------------------------------------------------------------}
  1129. (*        This routine is the one that starts the ball rolling.
  1130.           It Reads the DTA data and extracts the file names or directory
  1131.           entries from it.  If it is a directory it updates the table
  1132.           that is maintained in 'read' order and when you get to all files
  1133.           in that directory it then goes up the table one entry to start
  1134.           reading that directory.
  1135. {----------------------------------------------------------------------------}
  1136. *)
  1137. procedure StartItGoing;
  1138. const
  1139.    Term : CharSet = [^M,^Z];
  1140. var
  1141.    TC         : char;
  1142. begin
  1143.   if not DirOptionContinued then    { Am I on my second directory }
  1144.   begin
  1145.      Write(FilVar,Condenced_Print); { Condenced line spacing }
  1146.      Write(FilVar,Line_Spacing);    { 1/8 inch line spacing }
  1147.      DirOptionContinued := True;
  1148.   end;
  1149.   NotDir := True;
  1150.   SRN := 0;
  1151.   MaxEntries := False;
  1152.   E := 1; E_Use := 0;
  1153.   Buffer := ReadDrive;
  1154.   Buffer1 := ''; Buffer2 := Buffer; DirTable[E] := Buffer;
  1155.   FillChar(DTA,SizeOf(DTA),0);         { Initialize the DTA buffer }
  1156.   FillChar(Mask,SizeOf(Mask),0);       { Initialize the mask }
  1157.   FillChar(NamR,SizeOf(NamR),0);       { Initialize the file name }
  1158.   SetUpDTA;
  1159. { following instruction added version 1.12 }
  1160.   ReadVolume;
  1161.   if (VolumeIDRead = '           ') and (VolumeIDWanted in ['y', 'Y'])
  1162.   then
  1163.      begin
  1164.         MkWin(23,13,57,16,2,14,1);
  1165.         Writeln('   What Volume ID do you want?');
  1166.         VolumeIDWrite := '';
  1167.         repeat
  1168.            InputStr(VolumeIDWrite,11,12,2,Term,TC);
  1169.         until TC in Term;
  1170.         RmWin;
  1171.         WriteVolume;
  1172.         ReadVolume;
  1173.      end;
  1174.   Error := 0;
  1175.   While E_Use < E do
  1176.   begin
  1177.        Set_Up_Dir_Chg;
  1178.        ReadFirst;                { This does the first read for a directory }
  1179.        if (Error = 0) then
  1180.        begin
  1181.             I := 1;                    { initialize 'I' to the first element }
  1182.             SetUpNamR;       { this gets the first name from the directory }
  1183.             if NamR[1] = '.' then NotDir := False;
  1184.             if NotDir and  (Error = 0) then
  1185.             begin
  1186.                 PrintDTA;              { This gets the file attributes }
  1187.                 NumberRecs := NumberRecs + 1;
  1188.                 if GoodFileName then
  1189.                    FindFileToPrint;  { Build the record }
  1190.             end;
  1191.        end;
  1192.        while (Error = 0) do begin
  1193.          NotDir := True;
  1194.          ReadNext;               { This reads other entries in directory but }
  1195.          if (Error = 0) then     { the first }
  1196.          begin
  1197.              I := 1;
  1198.              SetUpNamR;
  1199.              if NamR[1] = '.' then NotDir := False; { Is it a dot directory }
  1200.              if NotDir and (Error = 0) then         { No it is not }
  1201.              begin
  1202.                  PrintDTA;
  1203.                  NumberRecs := NumberRecs + 1;
  1204.                  if GoodFileName then
  1205.                     FindFileToPrint; { Build the record and go dupe it }
  1206.              end;
  1207.          end;
  1208.        end;
  1209.   end;
  1210.   Writeln;                             { All done reading the directories }
  1211. end;                                   { End of procedure }
  1212.  
  1213. {----------------------------------------------------------------------------}
  1214. {$IQUIKSORT.INC}
  1215. {----------------------------------------------------------------------------}
  1216. Procedure SetUpNumericDrive;
  1217. begin
  1218.         { The following routines set the fields for the initial values }
  1219.         { If you have a drive which goes higher than this you need to }
  1220.         { add it. }
  1221.  
  1222.   NumericDriveHold := (Ord(DriveWanted[1]) - Ord('A') + 1);
  1223. end;
  1224.  
  1225. {----------------------------------------------------------------------------}
  1226.     { This reads the directories, Sorts the data, and then Prints it }
  1227.  
  1228. Procedure LetsDoIt;
  1229. begin
  1230.     Clear_19_22;
  1231.     Write('Reading the Directories');
  1232.     StartItGoing;
  1233.     Sort_List(SortList,1,SRN);
  1234.     HowMuchSpaceLeft;        { Check for file space left on the disk here }
  1235.     Clear_19_22;
  1236.     SRNHold := 0;
  1237.     Column := SortList[1];               { Get Dir for First entry in table }
  1238.     HoldDir[1] := Column[1];                { Save it }
  1239.     HoldDir[2] := Column[2];                { Save it }
  1240.     HoldDir[0] := chr(2);
  1241.     HoldDirNameSave := '';               { Set up hold area to null }
  1242.     BegSub := 1;                         { Beginning sub = 1 }
  1243.     for I := 1 to SRN do                 { loop until all throught the table }
  1244.     begin
  1245.        Column := SortList[I];
  1246.        HoldDirComp := Column;
  1247.        if HoldDirComp <> HoldDir then       { When the dir entry changes }
  1248.        begin
  1249.           PrintLabel(SortList,BegSub,I-1);        { Print all entries in this dir }
  1250.           PrintArc(BegSub,I-1);          { Print any arc files }
  1251.           PrintLbr(BegSub,I-1);          { Print any Lbr files }
  1252.           BegSub := I;                   { set up for next directory     }
  1253.           HoldDir := HoldDirComp;        { set up for next compare }
  1254.        end;
  1255.     end;
  1256.     PrintLabel(SortList,BegSub,SRN);  { Print all lines that match the last }
  1257.                                       { entry in the table }
  1258.     PrintArc(BegSub,SRN);             { Print any arc files }
  1259.     PrintLbr(BegSub,SRN);             { Print and LBR files }
  1260.     CompSlipSheet;
  1261.     Clear_19_22;
  1262. end;
  1263.  
  1264. {----------------------------------------------------------------------------}
  1265.         { You cannot have the file DIR.DIR on the default drive }
  1266.         { Therefore I check if your request is for the default }
  1267.         { drive }
  1268.  
  1269. Procedure CheckValidDrive;
  1270. begin
  1271.    if FirstTimeDrive = false then
  1272.    begin
  1273.      GetCurrentDrive;
  1274.      DefaultDrive[0] := Chr(1);
  1275.      FirstTimeDrive := true;
  1276.    end;
  1277.    if DriveWanted <> DefaultDrive then
  1278.    begin
  1279.      DriveOK := True;
  1280.      ReadDrive := DriveWanted + ':';
  1281.    end
  1282.    else
  1283.      DriveOK := False;
  1284. end;
  1285.  
  1286. {----------------------------------------------------------------------------}
  1287.      { This wants to know where the floppy drive is }
  1288.  
  1289. Procedure AskForDrive;
  1290. begin
  1291.    GoToXY(1,18); ClrEol;
  1292.    Writeln('What Drive do you want? ');
  1293.    Write ('      Press * when complete. ');
  1294.    GoToXY(25,18);
  1295.    repeat
  1296.      read(Kbd,Option);
  1297.    until (Option in ['A'..'Z','a'..'z','*']);
  1298.    DriveWanted := Option;
  1299.    if DriveWanted <> '*' then
  1300.    begin
  1301.       GoToXY(25,18);
  1302.       DriveWanted := Upcase(DriveWanted);
  1303.       Write(DriveWanted);
  1304.       Clear_19_22;
  1305.       DriveWanted[0] := Chr(1);
  1306.       if fileoption then
  1307.       begin
  1308.          CheckValidDrive;
  1309.       end
  1310.       else
  1311.       begin
  1312.          DriveOK := true;
  1313.          ReadDrive := DriveWanted + ':';
  1314.       end;
  1315.       if not DriveOK then
  1316.       begin
  1317.         GoToXY(1,20);
  1318.         Writeln('You cannot create a print file on the disk you want a cover for!')
  1319.       end
  1320.       else
  1321.         SetUpNumericDrive;
  1322.    end;
  1323. end;
  1324.  
  1325.  
  1326. {----------------------------------------------------------------------------}
  1327. {----------------------------------------------------------------------------}
  1328. (*        This is called the Main routine but only because Pascal calls
  1329.           it that.  As you can see it sets up the screen heading and asks
  1330.           for the options that you want.  You must get past this routine
  1331.           succesfully before you can get to the rest of the program.
  1332.  
  1333.           Therefore it must be the most important.                          *)
  1334. {----------------------------------------------------------------------------}
  1335. {----------------------------------------------------------------------------}
  1336.  
  1337.  
  1338.  
  1339. begin                   {  Main program  }
  1340.  
  1341.   NumberRecs := 0;                     { Zero out Record Count }
  1342.   PrintLines := 0;
  1343.   Dashes :=     ' -------------------------------------------------------------------------------------- ';
  1344.   FoldLine :=   '|- - - - - - - - - - - - - - - - - - - Fold  Line - - - - - - - - - - - - - - - - - - -|';
  1345.                                        { There should be 88 of them }
  1346.   blankline := ('|                                                                                      |');
  1347.                                        { There should be 86 of them }
  1348.   FirstTimeDrive := false;
  1349.   DriveOK := false;
  1350.   PrintOption := true;                 { Looks like we want the slip sheets }
  1351.   FileOption := false;                 { and we don't want a file instead }
  1352.   PrintPages := 0;                     { We are on the first slip sheet }
  1353.   SlipSheetLines := 0;                 { Set up the slip sheet lines also }
  1354.   Assign(FilVar,'Lst:');               { We set up for printer first }
  1355.                                        {  then check for disk option }
  1356.   Time;                                { Get the time }
  1357.   Date;                                { Get the date }
  1358.   FirstTime := True;                   { First time here }
  1359.   DirOption := False;                  { We are not doing it only for 1 dir }
  1360.   DirOptionContinued := False;         { This is not the second or more }
  1361.                                        { directory, Only used on dir option }
  1362.   PrevLine := '';                      { blank out field }
  1363.   ClrScr;
  1364.  
  1365.      { Now it is time to set up the screen to tell you who did this wonderful }
  1366.      { thing and to allow you to give the options that will customize the }
  1367.      { program to only do what you want.  Not what I want! }
  1368.  
  1369.                       { Lets fill the screen with data }
  1370.  
  1371.   GoToXY(7,1);
  1372.   Write('Diskette Cover Program  (DisKover) Version 1.17');
  1373.   GoToXY(55,1);
  1374.   Write(Datestr, '   ', timestr);
  1375.   GoToXY(10,3);
  1376.   Write('Written and Copyright (C) by');
  1377.   GoToXY(20,5);
  1378.   Write('Karson W. Morrison      -      Marty Morrison');
  1379.   GoToXY(29,6);
  1380.   Write('Caleb Computing Center'); { This is who did it }
  1381.   GoToXY(20,7);
  1382.   Write('Rd 1, Box 531,      Ringoes New Jersey, 08551');
  1383.   GoToXY(20,8);
  1384.   Write('January 23, 1986                Numbers 13:30'); { And When }
  1385.   GoToXY(10,10);
  1386.   Write('OPTIONS:');
  1387.   GoToXY(11,11);
  1388.   Write('Create Diskette Cover for Floppies (Printer): (1)');
  1389.   GoToXY(11,12);
  1390.   Write('Create Diskette Cover Print File  (DIR.DIR) : (2)');
  1391.   GoToXY(14,18);
  1392.   Write('Option: ');
  1393.   repeat
  1394.      read(Kbd,Option);
  1395.      GoToXY(22,18);
  1396.      Write(Upcase(Option));
  1397.      GoToXY(22,18);
  1398.  
  1399.             { If the Directory Option is requested then the Option is }
  1400.             { toggled on or off.  The program default is ON. }
  1401.  
  1402.   until Option in  [ '1', '2'];
  1403.   Writeln;
  1404.  
  1405.  
  1406.          { The following routines turn of or off the messages for the option }
  1407.          { requested }
  1408.  
  1409.   if Option = '1' then
  1410.     begin
  1411.       GoToXY(61,11);
  1412.       Write('ON ');
  1413.       GoToXY(22,18);
  1414.     end;
  1415.  
  1416.   if Option = '2' then
  1417.     begin
  1418.       PrintOption := false;               { if you don't want paper }
  1419.       FileOption := true;                 { then I put it on disk   }
  1420.       Assign(FilVar,'DIR.DIR');
  1421.       GoToXY(61,12);
  1422.       Write('ON ');
  1423.       GoToXY(22,18);
  1424.     end;
  1425.  
  1426.   Rewrite(FilVar);                        { Open the file for output }
  1427.  
  1428.   MkWin(15,13,65,17,2,14,1);
  1429.   Writeln(' Do you want to create Volume-IDs where missing?');
  1430.   Write('                     (Y/N)?');
  1431.   repeat
  1432.      Read(Kbd,VolumeIDWanted);
  1433.   until VolumeIdWanted in ['Y', 'N', 'n', 'y'];
  1434.   RmWin;
  1435.  
  1436.   repeat
  1437.     AskForDrive;
  1438.     if (DriveOK) and (DriveWanted <> '*') then
  1439.           LetsDoIt;                       { Lets do it many times }
  1440.   until DriveWanted = '*';                { until you say no more }
  1441.  
  1442.   if PrintLines <> 0 then
  1443.   begin
  1444.      CompSlipSheet;
  1445.      Write(FilVar,Top_Of_Form);           { new page }
  1446.      Write(FilVar,Reset_Printer);         { reset printer }
  1447.   end
  1448.   else
  1449.   begin
  1450.      Write(FilVar,Top_Of_Form);           { new page }
  1451.      Write(FilVar,Reset_Printer);         { reset printer }
  1452.   end;
  1453.  
  1454.   Close(FilVar);
  1455.  
  1456.   Writeln; ClrEol;
  1457. end.
  1458. (*        Well we are now here with the last end just ahead of us.
  1459.           It sure has been fun.
  1460.           As Roy Rogers used to sing "Happy Trails To You"
  1461.  
  1462.           Karson Morrison - Marty Morrison
  1463.               Caleb Computing Center
  1464.               " Yes we can "    Numbers 13:30
  1465. *)
  1466.