www.pudn.com > DriveRescuev1.8.zip > devices.pas
{: Devices, Drives, Files & Directories }
unit devices;
interface
uses classes, comctrls, statusdlg;
const
{: partition types }
pid_None = $00; { not used }
pid_FAT12 = $01; { 12-bit FAT primary partition or logical drive. The number of sectors in the volume is fewer than 32680 }
pid_FAT16 = $04; { 16-bit FAT primary partition or logical drive. The number of sectors is between 32680 and 65535 }
pid_Extended = $05; { Extended partition }
pid_BigDOS = $06; { BIGDOS FAT primary partition or logical drive }
pid_NTFS = $07; { NTFS primary partition or logical drive }
pid_FAT32_LBA = $0B; { Primary Fat32 partition, using interrupt 13 (INT 13) extensions }
pid_FAT32_EXT_LBA = $0C; { Extended Fat32 partition, using INT 13 extensions }
pid_FAT16_LBA = $0E; { Primary Fat16 partition, using INT 13 extensions }
pid_Extended_LBA = $0F; { Extended partition, using INT 13 extensions }
type
{: structure of one partition entry }
PartEntry = packed record
PE_status : byte;
PE_StartSectHead : byte;
PE_StartSectSecCyl : word;
PE_OSID : byte;
PE_EndSecHead : byte;
PE_EndSectSecCyl : word;
PE_SectOfs : longword;
PE_SectCnt : longword;
end;
PPartSec = ^PartSec;
{: structure of partition sector }
PartSec = packed record
BootCode : array[0..$1bd] of byte;
PartTable: array[1..4] of PartEntry;
BootID: word;
end;
const
{ Driver }
DRIVER_TYPE_PHYS = 0; // physical device (using PDISKIO driver)
DRIVER_TYPE_LOG = 1; // logical device (using LDISKIO driver)
{ Device Type }
DEVICE_TYPE_UNKNOWN = 0;
DEVICE_TYPE_FLOPPY = 1;
DEVICE_TYPE_REMOVABLE = 2;
DEVICE_TYPE_FIXED = 3;
DEVICE_TYPE_REMOTE = 4;
DEVICE_TYPE_CDROM = 5;
DEVICE_TYPE_RAMDISK = 6;
{ Info Flags }
DEVICE_FLAG_PARTITION_TABLE = 1; // device has partition table
{ Attributes }
DEVICE_ATTR_REMOVABLE = 1; // device is removable
{: TCustomDirectory/TCustomFile Flags }
item_deleted = 1;
item_lost = 2;
// file (undelete) recovery conditions
rec_cond_good = 1;
rec_cond_poor = 2;
{: TCustomDrive condition flags }
drv_cond_virtual = 1; // is it lost?
drv_cond_BootSecRebuild = 2; // boot sector rebuild?
drv_cond_quickFormatted = 4; // has it been quick-formatted?
type
//: Device List
TDeviceList = class;
//: Device object
TDevice = class
protected
FUseCache : boolean;
procedure TestCache;
public
name : string; // device name
driver : byte; { driver: physical (INT13 driver) or logical (MS-DOS/Windows drive) }
DevType : byte; { device type: floppy, removable, fixed, remote, CDROM, RAMDISK... }
Attr : word; { device attributes }
TotalSec : longword; { number of sectors }
BytesPerSec: word; { bytes per sector }
InfoFlags : word;
drv : byte; { drive number: INT13 drive number (0=FDD0, 1=FDD1, ... 80h=HDD0, 81h=HDD1, ...)
or : MS-DOS/Windows drive letter (1=A:, 2=B: 3=C:, 4=D: ...) }
cachesec : longword; { number of sectors to cache (=0 if no caching at all) }
constructor Create; virtual;
destructor Destroy; override;
function ReadSec(LBA: longint; blocks: word; buf: pointer; ErrorDlg: boolean): boolean;
function WriteSec(LBA: longint; blocks: word; buf: pointer; verify, ErrorDlg: boolean): boolean;
function FindLostDrives(devList: TDeviceList; StartSec, EndSec: longword): boolean;
procedure DetectCacheLineSize;
procedure UseCache(enable: boolean);
procedure InvalidateCache;
end;
//: Device List
TDeviceList = class
public
devices: TList;
constructor Create; virtual;
destructor Destroy; override;
function count: integer;
procedure clear;
function GetDevice(i: integer): TDevice;
procedure DetectDevices(dlg: TStatusDialog);
function GetDeviceText(devno: integer; sizetext: boolean): string;
function IndexOf(dev: TDevice): integer;
end;
TCustomDirectory = class;
//: abstract Drive object
TCustomDrive = class
public
dev : TDevice; // device
name : string; // the drive's name (e.g. volume name)
condition : byte; // condition flags (see above)
PosBootSec : longword; // Position of boot sector (normally start of partition)
PartOfs : longword; // Offset to this drive on the device
PartSectors : longword; // Total count of sectors
RootDir : TCustomDirectory; // root directory
RootDirDeleted : TCustomDirectory; // root directory (contains deleted files/directories)
RootDirLost : TCustomDirectory; // root directory (contains lost files/directories)
RootDirSearched : TCustomDirectory; // root directory (contains searched files/directories)
constructor Create; virtual; abstract;
destructor Destroy; override; abstract;
function ReadSec(LBA: longint; blocks: word; buf: pointer; ErrorDlg: boolean): boolean; virtual; abstract;
function MountDrive(quiet: boolean): boolean; virtual; abstract;
procedure FindLostData(dlg: TStatusDialog); virtual; abstract;
procedure AddDriveToTree(TreeView: TTreeView); virtual; abstract;
procedure AddListViewColumns(ListView: TListView); virtual; abstract;
function FindFiles: boolean; virtual; abstract;
procedure SaveListViewItems(ListView: TListView); virtual; abstract;
end;
//: Drive List
TDriveList = class
public
drives: TList;
constructor Create; virtual;
destructor Destroy; override;
function count: integer;
procedure clear;
function GetDrive(i: integer): TCustomDrive;
procedure AddVirtualDrive(dev: TDevice; posBootSec, physsec, seccount: longword; quiet: boolean);
procedure DetectDrives(dev: TDevice);
procedure DetectPartitions(dev: TDevice; physsec, firstExtended: longword);
end;
PCustomFile = ^TCustomFile;
//: abstract File object
TCustomFile = class
public
name: string;
size: longword;
drive: TCustomDrive;
flags: byte; // item flags => item_XXX
condition: byte; // recovery condition => rec_cond_XXX
parent: TCustomDirectory;
procedure duplicate(dest: TCustomFile); virtual;
function Rename(aname: string): boolean; virtual; abstract;
function GetPath(RelativeToDir: TCustomDirectory): string; virtual; abstract;
procedure ChangeListViewItem(listitem: TListItem); virtual; abstract;
end;
//: function prototype that is called for each directory/file item by the ForEachChild method
TProcessDirProc = function(item: TObject; UserParams: integer): boolean; stdcall;
PCustomDirectory = ^TCustomDirectory;
//: abstract Directory object
TCustomDirectory = class
public
name: string;
drive: TCustomDrive;
expanded: boolean;
flags: byte; // item flags => item_XXX
condition: byte; // recovery condition => rec_cond_XXX
Children: TList; // children directories (list of directory/file objects)
parent: TCustomDirectory;
constructor Create; virtual;
destructor destroy; override;
procedure duplicate(dest: TCustomDirectory); virtual;
procedure DeleteChildren; virtual;
function GetPath(RelativeToDir: TCustomDirectory): string; virtual; abstract;
function Rename(aname: string): boolean; virtual; abstract;
procedure AddDirToTree(TreeView: TTreeView; node: TTreeNode; deleted: boolean); virtual; abstract;
procedure ChangeListViewItem(listitem: TListItem); virtual; abstract;
procedure AddChildrenToListView(listview: TListView; deleted: boolean); virtual; abstract;
function CompareChildren(item1, item2: TListItem; useIdx: integer): integer; virtual; abstract;
function ChildIsSubDir: boolean; virtual; abstract;
end;
var
optCacheEnabled: boolean;
implementation
uses main, pdiskio, ldiskio, sysutils, windows, diskfs, helpers;
const
CACHELINES = 4;
CACHELINEBUFSZ = 2048*1024;
type
TCacheLine = record
dev : TDevice; // cached device
LRU : byte; // last recently used (0=no hits, 15=always hits)
SecStart: longword; // cached sectors start
SecEnd : longword; // cached sectors end
buf: array[0..CACHELINEBUFSZ-1] of byte;
end;
var
Cache: array[0..CACHELINES-1] of TCacheLine;
ExitSave: Pointer;
//-----------------------------------------------------------------------------
// TDevice
//-----------------------------------------------------------------------------
constructor TDevice.create;
begin
FUseCache:=FALSE;
cachesec:=0;
end;
destructor TDevice.Destroy;
begin
InvalidateCache;
end;
procedure TDevice.InvalidateCache;
var
i: integer;
begin
for i:=0 to CACHELINES-1 do
if cache[i].dev = self then
begin
cache[i].dev:=NIL;
cache[i].LRU:=0;
end;
end;
{: detects optimal cache line size for the device }
procedure TDevice.DetectCacheLineSize;
var
sectors: longword;
sec: longword;
starttime: longword;
res: boolean;
dummybuf: pointer;
begin
res:=FALSE;
if TotalSec > 2047 then
begin
try
getmem(dummybuf, 2048);
UseCache(FALSE);
sec:=0;
res:=ReadSec(0, 1, dummybuf, FALSE); // first access to spin-up drive...
if res then
begin
starttime:=GetTickCount;
// test sector reading speed for time of 10ms...
while ((GetTickCount < starttime + 100) AND (res)) do
begin
res:=ReadSec(sec, 1, dummybuf, FALSE);
inc(sec);
end;
if res then
begin
// compute cache line sectors per second
if sec > 1 then cachesec:=sec * 10
else cachesec:=1;
if cachesec * BytesPerSec > CACHELINEBUFSZ then
cachesec:=CACHELINEBUFSZ div BytesPerSec;
end;
end;
finally
freemem(dummybuf, 2048);
end;
end;
if NOT res then cachesec:=0; // don't cache device...
end;
{: Reads sector from device }
function TDevice.ReadSec(LBA: longint; blocks: word; buf: pointer; ErrorDlg: boolean): boolean;
var
res: boolean;
readblocks: longword;
LRUline: byte;
LRUvalue: byte;
i: integer;
{: Tries to read sector from cache - returns FALSE if not (fully) cached }
function ReadSecCached(var LBA: longint; var blocks: word; var buf: pointer): boolean;
var
cacheblocks: longword;
load: boolean;
hit: boolean;
i: integer;
test: byte;
begin
load:=TRUE;
hit:=FALSE;
for i:=0 to CACHELINES-1 do // if and where is the sector cached ?
begin
if (NOT hit) AND (Cache[i].dev = self) AND (LBA >= Cache[i].SecStart) AND (LBA <= Cache[i].SecEnd) then
begin
hit:=TRUE; // cache hit!
if Cache[i].LRU < 15 then inc (Cache[i].LRU);
load:=FALSE;
cacheblocks:=blocks;
if LBA + blocks-1 > Cache[i].SecEnd then
begin
// not ALL blocks are cached...
cacheblocks:=Cache[i].SecEnd - LBA +1;
load:=TRUE;
end;
(*hexdump(Cache[i].buf[ (LBA - Cache[i].SecStart) *BytesPerSec], 512);
messagebox(0, 'readsecached', 'info', mb_ok);*)
move(Cache[i].buf[ (LBA - Cache[i].SecStart) *BytesPerSec], buf^, cacheblocks * BytesPerSec);
if load then
begin
// adjust paramters for rest blocks...
LBA:=LBA+cacheblocks;
blocks:=blocks-cacheblocks;
inc(longint(buf), cacheblocks * BytesPerSec);
end;
end else if Cache[i].LRU > 0 then dec(Cache[i].LRU);
end;
result:=(NOT load);
end;
begin
res:=FALSE;
if (optCacheEnabled) AND (FUseCache) AND (cachesec > 0) then // cache enabled and use it?
begin
res:=ReadSecCached(LBA, blocks, buf);
if NOT res then
begin
// do read-ahead caching...
// first determine LRU cache line...
LRUline:=0; LRUvalue:=15;
for i:=0 to CACHELINES-1 do
if Cache[i].LRU < LRUvalue then
begin
LRUline:=i; LRUvalue:=Cache[i].LRU;
end;
//debug(inttostr(LRUline), DebugHigh);
readblocks:=cachesec; //CACHELINEBUFSZ div BytesPerSec;
if LBA + readblocks > TotalSec then readblocks:=TotalSec-LBA;
if driver = DRIVER_TYPE_PHYS then
begin
res:=ReadPhysicalSectors(drv, LBA, readblocks, @cache[LRUline].buf[0], ErrorDlg);
end
else if driver = DRIVER_TYPE_LOG then
begin
res:=ReadLogicalSectors(drv, LBA, readblocks, @cache[LRUline].buf[0]);
end;
if res then
begin
cache[LRUline].dev:=self;
cache[LRUline].LRU:=15;
cache[LRUline].SecStart:=LBA;
cache[LRUline].SecEnd:=LBA + readblocks-1;
ReadSecCached(LBA, blocks, buf);
end;
end
end;
if NOT res then // read without cache if caching disabled or read error during cache read...
begin
if driver = DRIVER_TYPE_PHYS then
begin
res:=ReadPhysicalSectors(drv, LBA, blocks, buf, ErrorDlg);
end else if driver = DRIVER_TYPE_LOG then
begin
res:=ReadLogicalSectors(drv, LBA, blocks, buf);
end;
end;
result:=res;
end;
procedure TDevice.UseCache(enable: boolean);
begin
FUseCache:=enable;
end;
{: Writes sector to device }
function TDevice.WriteSec(LBA: longint; blocks: word; buf: pointer; verify, ErrorDlg: boolean): boolean;
var
res: boolean;
begin
if driver = DRIVER_TYPE_PHYS then
begin
res:=WritePhysicalSectors(drv, LBA, blocks, buf, verify, ErrorDlg);
end else if driver = DRIVER_TYPE_LOG then
begin
res:=WriteLogicalSectors(drv, LBA, blocks, buf);
end;
result:=res;
end;
{:Test cache algorithms }
procedure TDevice.TestCache;
var
bufon: array[0..2047] of byte;
bufoff: array[0..2047] of byte;
sec: longword;
res: boolean;
diff: longword;
i: integer;
begin
(* debug('testing readsec...', debughigh);
UseCache(FALSE);
ReadSec(0, 2048, @bufoff[0], true);
for i:=0 to 2047 do
begin
ReadSec(i, 1, @bufon[0], true);
if res then
begin
diff:=BytesEqual(@bufoff[i*512], @bufon, 512);
if diff > 0 then debug(format('not equal: %d bytes, sec: %d', [diff, i]), debughigh);
end;
end;
debug('...ready', debughigh);
exit;*)
randomize;
debug('testing cache...', debughigh);
for i:=0 to 1000 do
begin
sec:=i; //random(TotalSec);
UseCache(TRUE);
res:=ReadSec(sec, 1, @bufon, true);
if res then
begin
UseCache(FALSE);
res:=ReadSec(sec, 1, @bufoff, true);
if res then
begin
diff:=BytesEqual(@bufon, @bufoff, BytesPerSec);
if diff > 0 then debug(format('not equal: %d bytes, sec: %d', [diff, sec]), debughigh);
end else debug(format('error reading sector (cache on): %d', [sec]), debughigh);
end else debug(format('error reading sector (cache on): %d', [sec]), debughigh);
if i mod 100=0 then debug('...', debughigh);
end;
UseCache(FALSE);
debug('...ready', debughigh);
end;
function TDevice.FindLostDrives(devlist: TDeviceList; StartSec, EndSec: longword): boolean;
var
buf: pointer;
bufextra: pointer;
physsec: longword;
res: boolean;
bsfound: boolean;
lostcount: integer;
flostfound: boolean;
FATanalyser: TFATanalyser;
i: integer;
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.