devices.pas

一个磁盘文件被删除后恢复的源程序！ 内嵌汇编代码~！

begin
  try
    getmem(buf, bytesPerSec);
    getmem(bufextra, bytesPerSec);
    FATanalyser:=TFATanalyser.create;
    UseCache(TRUE);

    StatusDialog.SetStatus('Find logical drives - Please wait...', '', '', '', '', true, true);
    StatusDialog.ProgressMax:=endsec-startsec+1;
    StatusDialog.ProgressStep:=1;
    StatusDialog.ProgressUpdateInterval:=500;

    StatusDialog.Show;

    physsec:=startsec; bsfound:=false;

    lostcount:=0;
    FATanalyser.AnalyseSecStart(self);
    repeat
       if StatusDialog.TimeForUserUpdate then
       begin
         StatusDialog.UpdateStatus('Find logical drives - Please wait...',
                format('Physical sector %d of %d', [physsec, endsec]), '',
                format('Lost drives found: %d', [lostcount]), '');
         MainForm.ProcessMessages;
       end;

      res:=ReadSec(physsec, 1, buf, true);
      if res then
      begin
        if FATanalyser.IsBootSecB(buf) then
        begin
          // Boot sector found...

          // is this drive already available?
          i:=0; flostfound:=true;
          while (i < MainForm.drvlist.count) do
          begin
            if (MainForm.drvlist.GetDrive(i).condition AND drv_cond_BootSecRebuild=0)
              AND (MainForm.drvlist.GetDrive(i).PartOfs = physsec) then flostfound:=false;
            inc(i);
          end;
          if flostfound then
          begin
            // this drive is lost...
            MainForm.DrvList.AddVirtualDrive(self, physsec, physsec, 0, TRUE);
            inc(lostcount);
          end;
        end;

        // call file systems analyser functions...
        if FATanalyser.AnalyseSec(self, physsec, buf, bytesPerSec) then
          inc(lostcount);

        inc(physsec);
      end;
      if StatusDialog.userCancel then break;
      StatusDialog.ProgressStepIt;

    until (NOT res) OR (physsec > endsec);
    FATanalyser.AnalyseSecStop;    

    StatusDialog.Hide;

  finally
    freemem(buf, bytesPerSec);
    freemem(bufextra, bytesPerSec);
    FATanalyser.free;
    UseCache(FALSE);

  end;
end;





//-----------------------------------------------------------------------------
//  TDeviceList
//-----------------------------------------------------------------------------

constructor TDeviceList.Create;
begin
   devices := TList.Create;
end;

destructor TDeviceList.Destroy;
var
   i : Integer;
begin
  clear;
  Devices.Free;
end;

procedure TDeviceList.clear;
var
  i: integer;
begin
   for i := 0 to Devices.Count - 1 do
   begin
      TDevice(Devices[i]).Free;
   end;
   devices.Clear;
end;

function TDeviceList.Count : Integer;
begin
   Result := Devices.Count;
end;

function TDeviceList.IndexOf(dev: TDevice): integer;
var
  i: integer;
begin
  result:=-1;
  for i:=0 to devices.count-1 do
    if devices[i]=dev then
    begin
      result:=i; break;
    end;
end;

function TDeviceList.GetDevice(i : Integer) : TDevice;
begin
   Result := TDevice(Devices.Items[i]);
end;

//: returns string with device text
function TDeviceList.GetDeviceText(devno: integer; sizetext: boolean): string;
var
  dev: TDevice;
  sPhys: string;
  size: real;

begin
  dev:=GetDevice(devno);
  if (dev.driver = DRIVER_TYPE_PHYS) then
  begin
    case dev.DevType of
      DEVICE_TYPE_FLOPPY:    sPhys:='floppy disk #' + inttostr(devno+1);
      DEVICE_TYPE_REMOVABLE: sPhys:='removable disk #' + inttostr(devno+1);
      DEVICE_TYPE_FIXED:     sPhys:='fixed disk #'+ inttostr(devno+1);
      DEVICE_TYPE_CDROM:     sPhys:='CD-ROM #' + inttostr(devno+1);
      else                   sPhys:='unknown disk #'+ inttostr(devno+1);
    end;
  end
  else if (dev.driver = DRIVER_TYPE_LOG) then
  begin
    sPhys:='Windows drive '+chr(ord('A')+dev.Drv-1)+':';
  end;
  if sizetext then
  begin
    size:=dev.TotalSec / 2048;
    if size < 1000 then
      sPhys:=sPhys + '   ('+Format('%f MB)',[size])
    else
      sPhys:=sPhys + '   ('+Format('%f GB)',[size / 1024]);
  end;
  result:=sPhys;
end;



{: detect INT13 devices and MS-DOS/Windows drives... }
procedure TDeviceList.DetectDevices(dlg: TStatusDialog);
var
  physdrive: byte;
  driveparams: TPhysDriveParams;
  secpclus, bytepsec, freeclus, totalclus: longword;
  volname: array[0..255] of char;
  maxlen: longword;
  fsflags: longword;
  fsname: array[0..255] of char;
  dosdrive: byte;
  root: string;
  dp: TLogDriveParams;
  dev: TDevice;
  i: integer;
begin
  debug('detect devices...', debugLow);

  // first detect INT13 drives...
  for physdrive:=0 to 255 do  // INT13 drive number 0 to 0xff
  begin
    if assigned(dlg) then StatusDialog.UpdateStatus('Scanning drives',
      format('Checking BIOS drive %d', [physdrive]), 'Please wait...', '', '');
    MainForm.ProcessMessages;
    if GetPhysDriveParams(physdrive, @driveparams) then
    begin
      // Add a device...
      dev := TDevice.Create;
      Devices.add(dev);
      dev.InfoFlags:=0;
      Dev.driver:=DRIVER_TYPE_PHYS;
      dev.drv:=physdrive;
      dev.TotalSec:=driveparams.TotalPhysSec;
      dev.BytesPerSec:=driveparams.BytesPerSector;
      if  NOT (driveparams.MediaType = PMEDIA_TYPE_FLOPPY) then
        dev.InfoFlags:=dev.InfoFlags + DEVICE_FLAG_PARTITION_TABLE;
      case driveparams.MediaType of
        PMEDIA_TYPE_UNKNOWN:   dev.DevType:=DEVICE_TYPE_UNKNOWN;
        PMEDIA_TYPE_FLOPPY:    dev.DevType:=DEVICE_TYPE_FLOPPY;
        PMEDIA_TYPE_REMOVABLE: dev.DevType:=DEVICE_TYPE_REMOVABLE;
        PMEDIA_TYPE_FIXED:     dev.DevType:=DEVICE_TYPE_FIXED;
      end;
      if (driveparams.MediaAttr AND PMEDIA_ATTR_REMOVABLE <> 0) then
        dev.Attr:=dev.Attr OR DEVICE_ATTR_REMOVABLE;
      dev.DetectCacheLineSize;
    end;
  end;

  // now detect Windows drives....
  for dosdrive:=1 to 26 do // logical drive letter A: to Z:
  begin
    if GetLogDriveParams(dosdrive, @dp) then
    begin
      root:=chr(ord('A')+dosdrive-1)+':\';
      if assigned(dlg) then StatusDialog.UpdateStatus('Scanning drives',
        format('Checking Windows drive %s', [root]), 'Please wait...', '', '');
      MainForm.ProcessMessages;        
      if GetVolumeInformation(pchar(root), @volname, sizeof(VolName), nil, maxlen, fsflags, @fsname, sizeof(fsname)) then
      begin
        if pos('FAT', uppercase(strpas(fsname))) <> 0 then
        begin
          // Add a device...
          dev := TDevice.Create;
          Devices.add(dev);
          dev.InfoFlags:=0;
          dev.driver:=DRIVER_TYPE_LOG;
          dev.drv:=dosdrive;
          case GetDriveType(pchar(root)) of
            DRIVE_REMOVABLE:   dev.DevType:=DEVICE_TYPE_REMOVABLE;
            DRIVE_FIXED:       dev.DevType:=DEVICE_TYPE_FIXED;
            DRIVE_REMOTE:      dev.DevType:=DEVICE_TYPE_REMOTE;
            DRIVE_CDROM:       dev.DevType:=DEVICE_TYPE_CDROM;
            DRIVE_RAMDISK:     dev.DevType:=DEVICE_TYPE_RAMDISK;
          end;
          dev.TotalSec:=dp.TotalPhysSec;
          dev.BytesPerSec:=dp.BytesPerSector;
          if (dp.MediaAttr AND PMEDIA_ATTR_REMOVABLE <> 0) then
            dev.Attr:=dev.Attr OR DEVICE_ATTR_REMOVABLE;
          dev.DetectCacheLineSize;
        end;
      end;
    end;
  end;

  for i:=0 to devices.count-1 do
  begin
    GetDevice(i).name:=GetDeviceText(i, true);
  end;

end;



//-----------------------------------------------------------------------------
//  TCustomDrive
//-----------------------------------------------------------------------------




//-----------------------------------------------------------------------------
//  TDriveList
//-----------------------------------------------------------------------------

constructor TDriveList.Create;
begin
  drives := TList.Create;
end;

destructor TDriveList.Destroy;
var
   i : Integer;
begin
  clear;
  Drives.Free;
end;

procedure TDriveList.clear;
var
  i: integer;
begin
   for i := 0 to Drives.Count - 1 do
   begin
      TCustomDrive(Drives[i]).Free;
   end;
   drives.Clear;
end;

function TDriveList.count: integer;
begin
  result:=drives.count;
end;

function TDriveList.GetDrive(i : Integer) : TCustomDrive;
begin
   Result := TCustomDrive(Drives.Items[i]);
end;

{ add a drive }
procedure TDriveList.AddVirtualDrive(dev: TDevice; posBootSec,
  physsec, seccount: longword; quiet: boolean);
var
  drv: TFATdrive;
begin
  drv := TfatDrive.Create;
  Drives.add(drv);

  Drv.condition := drv_cond_virtual;
  Drv.Dev:=dev;
  Drv.PosBootSec:=posBootSec;
  Drv.PartOfs:=physsec;
  Drv.PartSectors:=seccount;
  drv.MountDrive(quiet);
  drv.name:=drv.name + ' (lost)';
end;


procedure TDriveList.DetectPartitions(dev: TDevice; physsec, firstExtended: longword);
var
  psec: partsec;
  entry: byte;
  physdrv: byte;
  drv: TFATDrive;
begin
  if dev.ReadSec( physsec, 1, @psec, false) then
  begin
    entry:=1;
    while (entry <= 4) do
    begin
      with psec.parttable[entry] do
        if PE_OSID in [1,4,6,$e,$b] then { FAT12 / FAT16 / DOS4 / FAT32  ? }
        begin
          // Add a drive...
          drv := TFATDrive.Create;
          Drives.add(drv);
          Drv.condition:=0;
          Drv.dev:=dev;
          Drv.PosBootSec:=physsec + PE_SectOfs;
          Drv.PartOfs:=physsec + PE_SectOfs;
          Drv.PartSectors:=PE_SectCnt;
          drv.MountDrive(FALSE);
        end;
        inc(entry);
    end;

    entry:=1;
    { scan extended partitions }
    while (entry <= 4) do
    begin
      with psec.parttable[entry] do
      if PE_OSID in [5,$f,$c] then { ExtDOS / ExtWin95 / ExtOSR2  ? }
      begin
        if firstExtended = 0 then
          // this is the first extended...
          DetectPartitions(dev, PE_SectOfs, PE_SectOfs)
        else
          DetectPartitions(dev, firstExtended + PE_SectOfs, firstExtended);
      end;
      inc(entry);
    end;
  end;
end;


procedure TDriveList.DetectDrives(dev: TDevice);
var
  psec: partsec;
  entry: byte;
  drv: TFATDrive;
  res: boolean;
begin
  debug(format('detect drives on device %s...',[Dev.name]), debugLow);

  if dev.Attr = DEVICE_ATTR_REMOVABLE then
    res:=dev.ReadSec(0, 1, @psec, false)
  else
    res:=dev.ReadSec(0, 1, @psec, true);
  if res then
  begin
    if (dev.InfoFlags AND DEVICE_FLAG_PARTITION_TABLE=0) then
    begin
      { (legacy) removable media / logical DOS drive... }
      drv:=TFATDrive.create;
      Drives.add(drv);
      drv.condition:=0;
      drv.dev:=Dev;
      drv.PosBootSec:=0;
      drv.PartOfs:=0;
      drv.PartSectors:=Dev.TotalSec;
      drv.MountDrive(FALSE);
    end
    else begin
      { fixed disk ... }
      { scan primary partitions }
      detectPartitions(Dev, 0, 0);
    end;
  end
end;

//-----------------------------------------------------------------------------
//  TCustomFile
//-----------------------------------------------------------------------------

procedure TCustomFile.duplicate(dest: TCustomFile);
begin
  dest.name:=name;
  dest.drive:=drive;
  dest.flags:=flags;
  dest.condition:=condition;
  dest.parent:=parent;
end;

//-----------------------------------------------------------------------------
//  TCustomDirectory
//-----------------------------------------------------------------------------

constructor TCustomDirectory.Create;
begin
  //Children:=TList.create;
end;

destructor TCustomDirectory.destroy;
begin
  DeleteChildren;
  Children.free;
  Children:=NIL;
end;

procedure TCustomDirectory.duplicate(dest: TCustomDirectory);
begin
  dest.name:=name;
  dest.drive:=drive;
  dest.expanded:=expanded;
  dest.flags:=flags;
  dest.condition:=condition;
  dest.Children:=children;
  dest.parent:=parent;
end;

procedure TCustomDirectory.DeleteChildren;
var
  i: integer;
begin
  if assigned(children) then
  begin
    for i:= 0 to children.count -1 do
    begin
      if (TObject(children.Items[i]) is TCustomDirectory) then
      begin
        TCustomDirectory(children.items[i]).free;
      end
      else if (TObject(children.Items[i]) is TCustomFile) then
        TCustomFile(children.items[i]).free;
    end;
    children.clear;
  end;
end;

procedure MyExit;
begin
  ExitProc := ExitSave;            { first restore old vector }
end;


var
  i: integer;


begin
  ExitSave := ExitProc;
  ExitProc := @MyExit;

  for i:=0 to CACHELINES-1 do
  begin
    Cache[i].dev:=NIL;
    Cache[i].LRU:=0;
  end;
  optCacheEnabled:=FALSE;
end.