Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!usc!snorkelwacker.mit.edu!ira.uka.de!smurf!artcom0!hb.maus.de!ms.maus.de!Kai_Henningsen
From: Kai_Henningsen@ms.maus.de (Kai Henningsen)
Newsgroups: comp.lang.pascal
Subject: Re: how can I readout my FAT?
Message-ID: <14184@ms.maus.de>
Date: 27 Apr 91 11:58:00 GMT
Distribution: world,comp
Organization: Maus Mailbox Netz - UUCP-Gateway Bremen
Lines: 198


... and now for the program proper ...
program DirDate;
uses Dos, DosAbsUt, m7utillo;
type
  FATbuf= array[0..65520] of byte;
  FATarray= array[0..16380] of ^FATbuf;
  DIRent = record
             Fn: array[1..8] of char;
             Fe: array[1..3] of char;
             Attr: byte;
             Res: array[$0c..$15] of byte;
             Timestamp: longint;
             Start: word;
             Size: longint;
           end;
  Direct= array[0..2046] of DIRent;
var
  BootSec: ^BootRec;
  p: string;
  dr: byte;
  err: word;
  ss: word;
  Clust: word;
  DskSz: longint;
  FAT0, ROOT0, DATA0: longint;
  FATbytes: longint;
  FATsecs: longint;
  shortFAT: boolean;
  FAT: ^FATarray;
  i: longint;
  dps, dpc: word;
  Indent: word;

  function FATentry(n: word): word;
  type
    wp = ^word;
  var
    b, bm, bd: longint;
    w: word;
  begin
    if shortFAT then b:=n*longint(3) div 2
    else b:=n*longint(2);
    bm:=b mod ss;
    bd:=b div ss;
    if bm+1<ss then w:=wp(@FAT^[bd]^[bm])^
    else w:=FAT^[bd]^[bm] or swap(FAT^[bd+1]^[0]);
    if shortFAT then begin
      if odd(n) then w:=w shr 4
      else w:=w and $FFF;
      if w>=$ff8 then w:=w or $f000;
    end;
    FATentry:=w;
  end;

  procedure WriteName(n,e: string);
  begin
    trim(n);
    trim(e);
    if e='' then write(n,'':12-length(n))
    else write(n,'.',e,'':11-length(n)-length(e));
  end;

  procedure WriteDate(ts: longint);
  var
    dt : DateTime; { For Pack/UnpackTime}
  function LeadingZero(w : Word) : String;
  var
    s : String;
  begin
    Str(w:0,s);
    if Length(s) = 1 then
      s := '0' + s;
    LeadingZero := s;
  end;
  begin
    UnpackTime(ts,dt);
    with dt do
      begin
        Write(day:2,'.',month:2,'.',year,' ',
             LeadingZero(hour),':',LeadingZero(min),':',LeadingZero(sec));
      end;
  end;

  function TraverseSubdir(Start: word): longint;
  forward;

  function Process(var D: DIRent; var dt0: longint): boolean;
  var
    dt: longint;
  begin
    Process:=false;
    with D do begin
      case Fn[1] of
        #0: Process:=true;
        #$E5: ;
        else begin
          write('':indent*2);
          writename(Fn,Fe);
          write('   ');
          writedate(Timestamp);
          writeln;
          if Fn[1]<>'.' then begin
            if (attr and directory)=directory then begin
              dt:=TraverseSubdir(Start);
{              if Timestamp<dt then}
                Timestamp:=dt;
              write('':indent*2);
              writename(Fn,Fe);
              write('   ');
              writedate(Timestamp);
              writeln;
            end;
            if Timestamp>dt0 then dt0:=Timestamp;
          end
          else Timestamp:=0;
        end;
      end;
    end;
  end;

  procedure TraverseRoot;
  var
    CurDir: ^Direct;
    i: word;
    cur: word;
    var dt: longint;
  begin
    dt:=0;
    Indent:=0;
    getmem(CurDir, ss);
    i:=0;
    cur:=$ffff;
    while (i<BootSec^.RootSz) do begin
      if (i div dps)<>cur then begin
        if cur<>$ffff then begin
          err:=AbsWrite(dr, 1, ROOT0+cur, CurDir^);
          if err<>0 then runerror(err);
        end;
        cur:=i div dps;
        err:=AbsRead(dr, 1, ROOT0+cur, CurDir^);
        if err<>0 then runerror(err);
      end;
      if Process(CurDir^[i mod dps], dt) then i:=$ffff
      else inc(i);
    end;
    err:=AbsWrite(dr, 1, ROOT0+cur, CurDir^);
    if err<>0 then runerror(err);
    freemem(CurDir, ss);
  end;

  function TraverseSubdir(Start: word): longint;
  var
    CurDir: ^Direct;
    i: word;
    cur: word;
    dt: longint;
    Last: word;
  begin
    dt:=0;
    inc(Indent);
    getmem(CurDir, Clust*ss);
    i:=0;
    cur:=$ffff;
    Last:=0;
    while (i<$FFFF) do begin
      if (i div dpc)<>cur then begin
        if cur<>$ffff then begin
          err:=AbsWrite(dr, Clust, DATA0+longint(Last)*Clust, CurDir^);
          if err<>0 then runerror(err);
        end;
        cur:=i div dpc;
        if (Start>=$FFF8) or (Start<2) then begin
          fillchar(CurDir^, Clust*ss, 0);
          Last:=0;
        end
        else begin
          err:=AbsRead(dr, Clust, DATA0+longint(Start)*Clust, CurDir^);
          if err<>0 then runerror(err);
          Last:=Start;
          Start:=FATentry(Start);
        end;
      end;
      if Process(CurDir^[i mod dpc], dt) then i:=$ffff
      else inc(i);
    end;
    if Last<>0 then begin
      err:=AbsWrite(dr, Clust, DATA0+longint(Last)*Clust, CurDir^);
      if err<>0 then runerror(err);
    end;
    freemem(CurDir, Clust*ss);
    dec(Indent);
    TraverseSubdir:=dt;
  end;

... rest follows ...

MfG Kai