diskfs.pas

国外著名恢复软件Drive_Rescue 公布的早期源码 版本是1.8 delphi6环境开发的。

      //if slotno > 0 then MessageBox(0, 'slot error', pchar('diskfs error (cluster:'+inttostr(cluster)
      //  +', recno:'+inttostr(recno)+')'), mb_ok);

      if 1=1 {slotno = 0} then
      begin
        //res:=GetNextRecord(cluster, recno, entry);
        if res then
        begin
          { generate checksum... }
          sum:=0;
          for i:=0 to 10 do
            sum:=((sum AND 1) SHL 7) OR ((sum AND $fe) SHR 1) + entry^.DIR_Name[i];

          { convert Unicode to Ansi/Multibyte... }
          if 1=1 {sum = chksum} then
          begin
            //WideCharToMultiByte(CP_ACP, 0, @uname[p], len, @multibytebuf[0],
            //  sizeof(multibytebuf), nil, nil);
            longname:=Unicode2ASCII(@uname[p], len);
            //longname:=StrPas(@multibytebuf[0]);
          end else
          begin { checksum error }
            //MessageBox(0, 'chksum error', pchar('diskfs error (cluster:'+inttostr(cluster)
            //  +', recno:'+inttostr(recno)+')'), mb_ok);
            res:=false
          end;
        end;
      end else res:=false; { invalid slot }
    end else res:=false; { invalid slot }
  end;
  if not res then
  begin
    {cluster:=oldcluster;
    recno:=oldrecno;}
  end;
  GetLongName:=res;
end;


{ sucht n鋍hsten Dateieintrag (incl. lange Dateinamen) }
function TFATdrive.FindNextEntry(var cluster: longword; var recsec: longword; var recno: word;
  var entry: Tdirentry; var name: string; findDeleted: boolean): boolean;
var
  res: boolean;
begin
  with entry do
  begin
    repeat
      res:=GetNextRecord(cluster, recsec, recno, @entry);
      if DIR_Name[0]=0 then  { keine weiteren Eintr鋑e mehr }
        res:=false
    until (NOT res) OR ((DIR_NAME[0] <> $e5) AND (NOT findDeleted)) OR (findDeleted);

    if res then
    begin
      { Eintrag gefunden... }
      if (DIR_ATTR=$0f) then  { langer Dateieintrag? }
      begin
        res:=GetLongName(cluster, recsec, recno, @entry, name);
        if NOT res then // illegal long filename... so take short one...
        begin
          res:=true;
          name:=FFATanalyser.CnvName(@DIR_Name);
        end;
      end else name:=FFATanalyser.CnvName(@DIR_Name);
    end;
  end;
  FindNextEntry:=res;
end;



{ ------------------------------------------------------------------------ }
{ --------------- file accessing routines  ------------------------------- }
{ ------------------------------------------------------------------------ }

function TFATdrive.resetByCluster(cluster, size: longword; var handle: TFATFileInfo): boolean;
var
  res: boolean;
  h: byte;
begin
  res:=true;
  try
    with handle do
    begin
      FI_Cluster:=cluster;
      FI_FirstClus:=FI_Cluster;
      FI_recpos:=0;
      FI_size:=size;
    end;
  except
    else res:=false;
  end;
  result:=res;
end;




// read bytes from file (from current position)
// input: file handle <handle>, number of bytes to read <count>, FAT number <FATno>: 0=noFAT, 1=first FAT, 2=second FAT,...  
// output: buffer data <buf>, bytes read <bytesread> (TRUE if success)
function TFATdrive.blockread(var handle: TFATFileInfo; count: longword; buf: pointer;  FATno: byte;
  var bytesread: longword): boolean;
var
  startsec, sec: longword;
  secofs: word;
  rest: longword;
  blockrest: word;
  res: boolean;
  csec: byte;
  transferlen: word;
  nextclus: longword;
begin
 try
  res:=false;
  with handle do
  begin
    if (FI_recpos < FI_size) then
    begin
      rest:=count; bytesread:=0;
      if FI_recpos + rest > FI_size then { ggf. zu lesende Bytes durch Dateigr鲞e korrigieren }
        rest:=FI_size - FI_recpos;

      startsec:=FI_recpos div 512;
      secofs:=FI_recpos MOD 512;
      csec:=startsec MOD bootsec.BPB_SecPerClus;        { Startsektor im Cluster ermitteln... }
      blockrest:=512-secofs;                    { restliche Bytes in Sektor berechnen... }

      repeat
        transferlen:=blockrest;
        if rest < blockrest then transferlen:=rest; { ggf. zu lesende Bytes nach unten korrigieren }

        sec:=Cluster2Sec(FI_Cluster) + csec;
        if sec <> FDataSec then
        begin
          FDataSec:=sec;
          res:=ReadSec(FDataSec, 1, @FDataSecBuf[0], true);
        end;

        move(FDataSecBuf[secofs], buf^, transferlen);
        secofs:=0;                             { copy from start next time }
        inc(FI_recpos, transferlen);
        inc(bytesread, transferlen);
        inc(longword(buf), transferlen);        { Zielpointer erh鰄en }
        if (transferlen=blockrest) then        { last byte of sector? (n鋍hster Sektor ?) }
        begin
          inc(csec);
          if csec = bootsec.BPB_SecPerClus then        { Ende des Sektors => n鋍hster Cluster }
          begin
            csec:=0;
            if FATno > 0 then
            begin
              // use FAT...
              if not IsEOF(FI_cluster) then      { im n鋍hsten Cluster weiterlesen... }
              begin
                nextclus:=GetFAT(FI_cluster, FATno-1);
                if (nextclus > 2) AND (nextclus <=CountOfClusters)
                  then FI_cluster:=nextclus;
              end;
            end else
            begin
              // do not use FAT - read clusters sequentially...
              if (FI_cluster <=CountOfClusters) then inc(FI_cluster);
            end;
          end;
        end;
        blockrest:=512;                        { full block next time }
        dec(rest, transferlen);
      until (rest=0) OR (NOT res);

      res:=true;
    end else
    begin
      //messagebox(0, pchar('FI_size:'+inttostr(FI_size)), 'info', mb_OK);
      if (FI_recpos = FI_size) then  { Spezialfall f黵 Dateil鋘ge 0 und Zeiger auf Dateiende }
        res:=true;
      bytesread:=0;
    end;
  end;
  result:=res;
 except
   else result:=false;
 end;
end;


// returns cluster of a given record position of a file by seeking from
// the start to the specified record position (or until end of file)
// input: start cluster <N>, record position <recpos>, FAT number <FATno>: 0=no FAT, 1=fst FAT, 2=2nd FAT, ...
// ouput: cluster of record position <N> (<FALSE> if invalid)
function TFATdrive.GetRecPosCluster(var N: longword; recpos: longword; FATno: byte): boolean;
var
  clus, count: longword;
  res: boolean;
begin
  res:=false;
  clus:=N;
  count:=recpos div BytePerClus; // amount of clusters
  while (count > 0) AND (FfatAnalyser.ClusterType(FATtype, clus) <> clusEOF) do
  begin
    if FATno = 0 then clus:=clus+1
      else clus:=GetFAT(clus, FATno-1);
    dec(count);
  end;
  if (count = 0) then // not EOF => success?
  begin
    N:=clus;
    res:=true;
  end;
  result:=res;
end;


// file seek
// input: absolute seek position <N> (zero based), FAT number <FATno>: 0=no FAT, 1=fst FAT, 2=2nd FAT, ...
// ouput: <TRUE> if success
function TFATdrive.seek(var handle: TFATFileInfo; N: longword; FATno: byte): boolean;
var
  r: boolean;
  clus: longword;
begin
  r:=false;
  with handle do
  begin
    if FI_FirstClus <> 0 then
    begin
      if n < FI_size then
      begin
        clus:=FI_FirstClus;
        if GetRecPosCluster(clus, N, FATno) then
        begin
          FI_cluster:=clus;
          FI_recpos:=n;
          r:=true;
        end;
      end;
    end;
  end;
  result:=r;
end;

function TFATdrive.filepos(handle: TFATFileInfo): longword;
begin
  with handle do
    filepos:=FI_firstclus
end;

function TFATdrive.filesize(handle: TFATFileInfo): longword;
begin
  with handle do
    filesize:=FI_size;
end;

procedure TFATdrive.close(var handle: TFATFileInfo);
begin
  //dispose(handle);
end;

{ ----------------------------------------------------------------------------}

function clusmapGetBit(p: pointer; bitpos: longint): byte;
var
  byteno: longint;
  pmap: ^byte;
begin
  byteno:=bitpos SHR 3;
  pmap:=p;
  inc(longint(pmap), byteno);
  clusmapGetBit:=(pmap^ SHR (bitpos AND 7)) AND 1;
end;


procedure clusmapSetBit(p: pointer; bitpos:longint);
var
  byteno: longint;
  pmap: ^byte;
begin
  byteno:=bitpos SHR 3;
  pmap:=p;
  inc(longint(pmap), byteno);
  pmap^:=pmap^ OR (1 SHL (bitpos AND 7));
end;


procedure TFATdrive.FindLostData(dlg: TStatusDialog);
var
  code: integer;
  startclus, endclus: longword;
  scanclus, dirclus, fileclus, clus, filecluscount: longword;
  scansec: longword;
  pclusmap: ^pointer;
  cluscount: longword;
  res: boolean;
  dirfound, rootfound: boolean;
  ditem: TFATDirectory;
  fitem: TFATfile;
  sext, slast_ext: string;
  lastfileclus: longword;
  i: integer;
  datatype: byte;
  newfile: boolean;
  lostdircount, lostfilecount: integer;


  procedure CheckLostList(clus, sec: longword);
  var
    j: integer;
    ditem: TFATDirectory;
  begin
    for j:=0 to RootDirLost.children.count-1 do
    begin
      // if "clus" is in the lost list, throw it out of the lost list (because it will be found recursively)
      if assigned(RootDirLost.children.items[j]) then
      begin
         ditem:=RootDirLost.children.items[j];
         if ((ditem.cluster > 0) AND (ditem.cluster = clus)) OR ((ditem.cluster=0) AND (ditem.sector=sec)) then
         begin
          ditem.free;
          RootDirLost.children[j]:=NIL;
         end;
      end;
    end;
    //move all non-nil items to the front of the Items array and reduce the Count property to the number of items actually used.
    RootDirLost.children.Pack;
    // To free up the memory for the unused entries
    RootDirLost.children.Capacity:=RootDirLost.children.Count;
  end;


  procedure scandir(clus, sec: longword; checklist: boolean);
  var
    recno: word;
    fclus, oldclus, fsec: longword;
    entry: Tdirentry;
    lfname: string;
    res: boolean;
  begin
    fclus:=clus; fsec:=sec;
    if dlg.UserCancel then exit;
    if dlg.TimeForUserUpdate then
    begin
      if fclus <> 0 then dlg.UpdateStatus('', Format('Scanning cluster %D (sub-directory)',[fclus]), '', '', '')
        else dlg.UpdateStatus('', Format('Scanning sector %D (sub-directory)',[fsec]), '', '', '');
      MainForm.ProcessMessages;
    end;

    // first mark it as scanned...
    clusmapSetBit(pclusmap, fclus);
    recno:=0; oldclus:=fclus;

    // if this actually scanned one is in the lost list, throw it out of the lost list (because it will be found recursively)
    if checklist then CheckLostList(fclus, fsec);

    repeat
      res:=FindNextEntry(fclus, fsec, recno, entry, lfname, true);

      if fclus <> 0 then // do not use cluster bitmap if using sector paramter!
      begin
        if (fclus < startclus) OR (fclus > endclus) then break; // valid user cluster range specified?
        if oldclus <> fclus then  // cluster changed?
        begin
          // mark new cluster as scanned...
          clusmapSetBit(pclusmap, fclus);
          dlg.ProgressStepIt;
          oldclus:=fclus;
        end;
      end;

      if (res) then
      begin
        if (entry.DIR_attr AND attrSubDir <>0) then
        begin
          if (lfname <> '.') AND (lfname <> '..') then // directory found?
          begin
            // scan directory recursively...
            dirclus:=entry.DIR_FstClusLO OR (longint(entry.DIR_FstClusHI) SHL 16);
            if (dirclus >= startclus) AND (dirclus <=endclus)
              AND (FfatAnalyser.IsDirC(self, dirclus, 0))
              AND (clusmapGetBit(pclusmap, dirclus) = 0) then  // valid user cluster range specified?
              begin
                scandir(dirclus, 0, TRUE);
                dlg.ProgressStepIt;
              end;
          end;
        end else if (entry.DIR_attr AND (attrSubDir+attrVolume) =0) then
        begin
          // file found... mask file clusters as scanned...
          fileclus:=entry.DIR_FstClusLO OR (longint(entry.DIR_FstClusHI) SHL 16);
          CheckLostList(fileclus, 0);
          if useFAT > 0 then
          begin
            // FAT valid...
            repeat
              // mark file cluster as scanned...
              if (fileclus >= startclus) AND (fileclus <= endclus)
                AND (clusmapGetBit(pclusmap, fileclus) = 0) then  // valid user cluster range specified?
              begin
                clusmapSetBit(pclusmap, fileclus);
                dlg.ProgressStepIt;
              end;
              fileclus:=GetFAT(fileclus, useFAT-1);
            until (FfatAnalyser.ClusterType(FATtype, fileclus) IN [clusEOF, clusFree]);
          end else
          begin
            if (fileclus >= startclus) AND (fileclus <= endclus)
              AND (clusmapGetBit(pclusmap, f