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