home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TUR6_102.ZIP / DISKLBR.INC < prev    next >
Encoding:
Text File  |  1986-01-01  |  8.7 KB  |  272 lines
  1. (*  This routine reads the directory info on lbr files.  I had three lbr
  2.     programs and one used no date or time.  The second used date and time
  3.     as it would print 1-1-80 and 14:30:24.  The third program LUPower or
  4.     LU used a modified julian date format for the storage of the date.
  5.     The base year was 1-1-1978 which cannot be entered into the PC therefore
  6.     the earliest date was FA02 or reversed 02FA or 731 in modified julian
  7.     format or 731 days since the base date.  What it means is 365 days in 1978
  8.     365 days in 1979 and 1 day in 1980.  I have entered routines to handle
  9.     years until 2008.
  10.  
  11.     This module has been written and Copyright (C) by Karson W. Morrison
  12.                                                       Caleb Computing Center
  13.             Written January 1, 1986                   RD 1,  Box 531,
  14.                                                       Ringoes, NJ. 08551
  15.  
  16. *)
  17.  
  18.  
  19. var
  20.     lbropen             : boolean;
  21.     LbrFilePosition     : integer;
  22.     HeaderLength        : byte;          { Number of directory records }
  23.     DirectoryPosition   : integer;       { Directory record I'm on }
  24.     Header_Found        : char;
  25.     LbrFileDateStr      : string[2];
  26.     LbrFileTimeStr      : string[2];
  27.     LbrFileDate         : integer;
  28.     LbrFileTime         : integer;
  29.  
  30. function FileName_St : strtype;
  31.   var s : strtype;
  32.    a, i : integer;
  33.   begin
  34.     s := '';
  35.     for I := 1 to 11 do
  36.     begin
  37.        s := s + buf[ LbrFilePosition + I ];
  38.        if I = 8 then
  39.           s := s + '.';
  40.     end;
  41.     FileName_St := s;
  42.   end;
  43.  
  44.  
  45. procedure Read_Block_Lbr;
  46.   begin
  47.       if EOF(fil) then endfile := TRUE
  48.       else BlockRead(fil, buf, 1);
  49.       LbrFilePosition := 1;
  50.       DirectoryPosition := DirectoryPosition + 1;
  51.   end;
  52.  
  53.  
  54. function flbropen(var name : strtype) : boolean;
  55. { only binary I/O supported; }
  56.   begin
  57.     {$I-}
  58.     assign(fil, name);
  59.     {$I+}
  60.     if ioresult <> 0 then begin
  61.       flbropen := FALSE;
  62.       exit;
  63.     end;
  64.  
  65.     {$I-}
  66.     reset(fil);
  67.     {$I+}
  68.     if ioresult <> 0 then begin
  69.       flbropen := FALSE;
  70.     exit
  71.     end;
  72.     endfile  := FALSE;
  73.     DirectoryPosition := 0;
  74.     Read_Block_Lbr;
  75.     HeaderLength := integer(buf[15]);
  76.     LbrFilePosition := 33;
  77.     flbropen := TRUE;
  78.   end;
  79.  
  80. procedure closelbr;
  81.   begin
  82.       close(fil);
  83.   end;
  84.  
  85. function ReadLbrHdr : boolean;
  86. { FALSE = eof found; TRUE = header found }
  87.   begin
  88.      header_found := '0';
  89.      repeat
  90.      if LbrFilePosition > 128 then
  91.      begin
  92.         if DirectoryPosition = HeaderLength then
  93.         begin
  94.            ReadLbrHdr := FALSE;
  95.            exit;
  96.         end
  97.         else
  98.            Read_Block_Lbr;
  99.      end
  100.      else
  101.      begin
  102.      if ((buf[ LbrFilePosition + 1 ] = ' ') and
  103.          (buf[ LbrFilePosition + 9 ] = ' '))
  104.        or
  105.         ((buf[ LbrFilePosition + 1 ] = #$00) and
  106.          (buf[ LbrFilePosition + 9 ] = #$00)) then
  107.         begin
  108.            LbrFilePosition := LbrFilePosition + 32
  109.         end
  110.         else
  111.            header_found := '1';
  112.      end;
  113.    until header_found = '1';
  114.    if feof then
  115.       readlbrhdr := FALSE
  116.    else
  117.    begin
  118.       if header_found = '1' then
  119.          readlbrhdr := TRUE
  120.       else
  121.          readlbrhdr := False;
  122.    end;
  123. end;
  124.  
  125. procedure openlbr;
  126.   begin
  127.     if not flbropen(arcname) then
  128.       lbropen := FALSE
  129.     else
  130.       lbropen := TRUE;
  131.   end;
  132.  
  133. procedure FixTime;
  134. begin
  135.    FileHr := '  ';
  136.    FileMN := '  ';
  137.    Str((LbrFileTime shr 11):2,FileHr);
  138.    FileWork := LbrFileTime shl 5;
  139.    Str((FileWork shr 10):2,FileMN);
  140.    if FileHR[1] = ' ' then
  141.       FileHR[1] := '0';
  142.    if FileMN[1] = ' ' then
  143.       FileMN[1] := '0';
  144. end;
  145.  
  146.  
  147. procedure lstlbrfile;
  148.   var
  149.       b, yr, mo, dy : integer;
  150.       s, yrstr, mostr, dystr : string[2];
  151.       fn         : strtype;
  152.       rlen       : real;
  153.       aorp       : char;
  154.       sthold     : string[7];
  155.  
  156. procedure FixDate;
  157. Const
  158.   Days : Array [1..12] of integer = (0, 31, 59, 90, 120, 151, 181, 212,
  159.                                       243, 273, 304, 334);
  160.                                   { number of days at the end of each month }
  161.   Years : Array [1..30] of integer = (0,   365,   730,   1096,   1461,   1826,
  162.                                           2191,  2557,   2922,   3287,   3652,
  163.                                           4018,  4383,   4748,   5113,   5479,
  164.                                           5844,  6209,   6574,   6940,   7305,
  165.                                           7670,  8035,   8400,   8765,   9130,
  166.                                           9495,  9861,  10226,  10591);
  167.                                  { number of days at the end of each year }
  168.                                  { using 1-1-78 as the base year 1980 is leap
  169.                                    year and each 4 after except year 2000 }
  170. var
  171.   leap      : integer;
  172.   I         : integer;
  173.   Match     : boolean;
  174.   yrhold    : integer;
  175.  
  176. begin
  177.   Match := False;
  178.   For I := 30 downto 1 do                    { start at end of table and work }
  179.      if LbrFileDate > Years[I] then          { toward the front }
  180.      begin
  181.        if Match then                         { if I have already match don't }
  182.        else                                  { reset the year etc. }
  183.        begin
  184.          Match := TRUE;
  185.          YR := I + 77;         { base year is 1-1-1978 }
  186.          DY := LbrFileDate - Years[I];
  187.        end;
  188.      end;
  189. Match := False;
  190.   For I := 12 Downto 1 do                   { start at end of table and work }
  191.     if DY > Days[I] then                    { toward the front }
  192.     begin
  193.       if Match then
  194.       else                                  { if I match already don't reset }
  195.       begin                                 { reset the month fields etc. }
  196.         Match := True;
  197.         MO := I;
  198.         DY := DY - Days[I];
  199.       end;
  200.     end;
  201.     str(yr:2,yrstr);                       { make the data a string }
  202.     str(mo:2,mostr);
  203.     str(dy:2,dystr);
  204.     if dystr[1] = ' ' then dystr[1] := '0';
  205.     if mostr[1] = ' ' then mostr[1] := '0';
  206. end;
  207.  
  208.   procedure twodig(n : integer);
  209.     begin
  210.       str(n:2, s);
  211.       if s[1] = ' ' then s[1] := '0';
  212.       if s[2] = ' ' then s[2] := '0';
  213.     end;
  214.  
  215.  
  216.   begin
  217.     fn := fileName_St;
  218.     rlen := integer(buf[ LbrFilePosition + 14 ]) * 128;
  219.     if (buf[ LbrFilePosition + 18] = #$00) and         { I don't have date or }
  220.        (buf[ LbrFilePosition + 21] = #$00) then        { time in the record }
  221.     begin
  222.        MOstr := '00'; DYstr := '00'; YRstr := '00';    { zero out the fields }
  223.        FileHR := '00'; FileMN := '00';
  224.     end
  225.     else
  226.     begin
  227.        if (buf[ LbrFilePosition + 18] = '-') and       { the date and time are }
  228.           (buf[ LbrFilePosition + 21] = '-') then      { already formatted }
  229.        begin
  230.           MOstr[1]  := buf[LbrFilePosition + 16];       { just move the data }
  231.           MOstr[2]  := buf[LbrFilePosition + 17];       { into the fields }
  232.           DYstr[1]  := buf[LbrFilePosition + 19];
  233.           DYstr[2]  := buf[LbrFilePosition + 20];
  234.           YRstr[1]  := buf[LbrFilePosition + 22];
  235.           YRstr[2]  := buf[LbrFilePosition + 23];
  236.           FileHR[1] := buf[LbrFilePosition + 24];
  237.           FileHR[2] := buf[LbrFilePosition + 25];
  238.           FileMN[1] := buf[LbrFilePosition + 27];
  239.           FileMN[2] := buf[LbrFilePosition + 28];
  240.           MOstr[0]  := Chr(2);
  241.           DYstr[0]  := Chr(2);
  242.           YRstr[0]  := Chr(2);
  243.           FileHR[0] := Chr(2);
  244.           FileMN[0] := Chr(2);
  245.        end
  246.        else
  247.        begin
  248.           LbrFileDateStr[1] := buf[ LbrFilePosition + 18 ];
  249.           LbrFileDateStr[2] := buf[ LbrFilePosition + 19 ];
  250.           LbrFileTimeStr[1] := buf[ LbrFilePosition + 22 ];
  251.           LbrFileTimeStr[2] := buf[ LbrFilePosition + 23 ];
  252.           LbrFileDateStr[0] := Chr(2);
  253.           LbrFileTimeStr[0] := Chr(2);
  254.           LbrFileDate := integer(LbrFileDateStr[1]);
  255.           LbrFileDate := LbrFileDate + (integer(LbrFileDateStr[2]) * 256);
  256.           LbrFileTime := integer(LbrFileTimeStr[1]);
  257.           LbrFileTime := LbrFileTime + (integer(LbrFileTimeStr[2]) * 256);
  258.           FixTime;
  259.           FixDate;
  260.        end;
  261.     end;
  262.     ArcList[ArcSrn] := ReadDrive + fn;  { its not really an arc I'm just }
  263.                                         { reusing the table array }
  264.     for b := length(fn) to 12 do ArcList[ArcSrn] := ArcList[ArcSrn] + ' ';
  265.     ArcList[ArcSrn] := ArcList[ArcSrn] + MOstr + '-';
  266.     ArcList[ArcSrn] := ArcList[ArcSrn] + DYstr + '-';
  267.     ArcList[ArcSrn] := ArcList[ArcSrn] + YRstr + '  ';
  268.     ArcList[ArcSrn] := ArcList[ArcSrn] + FileHR + ':' + FileMN;
  269.     Str(rlen:7:0,sthold);
  270.     ArcList[ArcSrn] := ArcList[ArcSrn] + sthold + '     ';
  271.   end;
  272.