關於匯編的INT13 bios中斷在delphi中怎麼實現???(100分)

[red][/red] 哪位富翁知道： 關於匯編的 INT13 bios 中斷在delphi中怎麼實現???
或者有什麼更好辦法：防止一台電腦多次安裝一個試用軟件?? 當然是盡可能...

关注

[red]不要隻關注：那位富翁發表一下意議啊！分數不是問題！！
幫主快救命啊！！！！[/red]

是调用还是实现int13的接管?

to:热血
我的問題是指調用，如果可以的話最好也要接管的。

调用的话要写driver
因为bios调用三级程序不能直接调用
接管比较麻烦

To：热血
写driver老弟沒做過。
你能給出一個示例嗎？我的郵箱是：ljy_17@163.com
我先謝過了.

怎麼沒有人回答？？？
班主：富翁哪去了？？？？

在windows下int13被屏蔽掉了。
如果想读写扇区，需取得3个级别（level1,level2,level3)
的设备锁定。

to:zhukewen
3个级别（level1,level2,level3)的设备锁定。
怎麼實現,能給出源代嗎？謝了。
我的郵箱是：ljy_17@163.com

写Vxd对于我太难了。

[red]碩大的大富翁就沒一個人知道？？？[/red]
help me!!!!!!!!

在driver int13可以直接调用
driver编写比较复杂
跟一般的编程不一样
所以给你一两个例子
你也看不明白
最后找几本书看看

用汇编嘛，delphi中可以嵌入汇编指令。不就可以了！[]分！！！

举个例子：
function LongMul(X, Y: Integer): Longint;
asm
MOV EAX,X
IMUL Y
end;
不要放在begin
...end之间！[]

另一个方法，第一次安装可在一个系统文件（如system.ini）内打一个标志
（也可自己建立一个神秘的文件，让人看不懂），然后判断，若存在，就表
示以前安装过！
这方法笨了点，不过有用！[8D]

To弟子:
delphi中不能真接調用
asm
.....
Int13;
end;

這樣會出錯！
你所說的在系統中建文件，很容易被人查到。（用文件監視器）
不過還是要謝謝你！

都N年前的代码了,但是win9x下不能读写物理硬盘,我正在仿cih完成这个工作。
有空请到我主页http://wenjinshan.yeah.net
{$A-}
unit Dskio;
interface
uses Windows, Messages, Classes, SysUtils, Forms, D_IOCTL;
const
{FAT values explanations}
FAT_Available = 0;
FAT_Reserved_Min = $FFFFFFF0;
FAT_Reserved_Max = $FFFFFFF6;
FAT_BAD = $FFFFFFF7;
FAT_EOF_Min = $FFFFFFF8;
FAT_EOF_Max = $FFFFFFFF;
{FAT values masks for different file systems}
FAT_MASK_12 = $FFF;
FAT_MASK_16 = $FFFF;
FAT_MASK_32 = $FFFFFFF;
{Attribute field bits meanings}
ATTR_ARCHIVE = $20;
ATTR_DIRECTORY = $10;
ATTR_VOLUME = $08;
ATTR_SYSTEM = $04;
ATTR_HIDDEN = $02;
ATTR_READONLY = $01;
type
{File system used type on selected volume}
TFileSystem = (fsNone, fsFAT12, fsFAT16, fsFAT32);
{Universal directory entry - valid on all file systems}
PDIR_Entry = ^TDIR_Entry;
TDIR_Entry = record
Attributes: Byte;
// File attributes
StartCluster: Longint;
// File starting cluster
CreateTime: Longint;
// File creation time
CreateDate: Longint;
// File creation date
FileSize: Longint;
// File size
LastAccessDate: Longint;
// File last access date
Name: String[255];
//do
S 8.3 filename asdo
S reports
LongName: String[255];
// Windows 95 long filename
// if '' then
no long filename available
Erased: Boolean;
// True for erased file entry
end;

TDiskIO = class
private
FHandle: THandle;
FVolume: Longint;
FPhysicalVolume: Longint;
FLogicalSectors: Longint;
FPhysicalSectors: Longint;
FHeads: Longint;
FCylinders: Longint;
FBytesPerSector: Longint;
FSectorsPerCluster: Longint;
FFATSector: Pointer;
FFATCount: Longint;
FRootDirSector: Longint;
FRootDirCluster: Longint;
FFileSystem: TFileSystem;
FSectorsPerFAT: Longint;
FRootDirEntries: Longint;
FCluster2Sector: Longint;
FFATSize: Longint;
FFAT: Pointer;
FEndingCluster: Longint;
FSerial: Longint;
FLabel: String;
procedure IOCTL(Command: Longint;
var Regs: T32Regs);
function ObtainVolumeLock(Level: Byte;
Lock: TLockType): Boolean;
procedure ReleaseVolumeLock(Lock: TLockType);
function VolumeLock(Lock: TLockType): Boolean;
procedure VolumeUnlock(Lock: TLockType);
function GetDrive: Char;
procedure SetDrive(Value: Char);
procedure CheckFileSystem;
function WriteLogicalSectorEx(StartSector, nSectors: Longint;
var Buffer;
nSize: Longint): Boolean;
function ReadLogicalSectorEx(StartSector, nSectors: Longint;
var Buffer;
nSize: Longint): Boolean;
function GetFATCluster(FATIndex: Longint): Longint;
function GetFATEntry(CopyOfFAT: Longint;
Cluster: Longint): Longint;
procedure SetFATEntry(CopyOfFAT: Longint;
Cluster: Longint;
Value: Longint);
function VolumeCheck(var Flags: Longint): Boolean;
function GetMediaID(MID: PMID): Boolean;
function ReadRootDIR(var DIR: PDIR_Entry;
var Entries: Longint): Boolean;
function ReadOtherDir(Cluster: Longint;
var DIR: PDIR_Entry;
var Entries: Longint): Boolean;
public
constructor Create;
virtual;
destructor Destroy;
override;
function ValidCluster(Cluster: Longint): Boolean;
// Check cluster for bounds validation
function ReadLogicalSector(StartSector, nSectors: Longint;
var Buffer;
nSize: Longint): Boolean;
// Reads nSectors from disk into Buffer of size nSize startin at StartSector number
function WriteLogicalSector(StartSector, nSectors: Longint;
var Buffer;
nSize: Longint): Boolean;
// Writes nSectors to disk from Buffer of size nSize startin at StartSector number
procedure FlushFAT;
// Flushes internal memory FAT image to disk
procedure DriveReread;
// Rescans drive (usually used after changes made)
function ReadCluster(Cluster: Longint;
var Buffer;
BufferSize: Longint): Boolean;
// Reads cluster number Cluster into Buffer of size BufferSize
function WriteCluster(Cluster: Longint;
var Buffer;
BufferSize: Longint): Boolean;
// Writes cluster number Cluster to disk from Buffer of size BufferSize
function ReadClusterChain(StartCluster: Longint;
var Buffer: Pointer;
var BufferSize: Longint): Boolean;
// Reads total cluster chain starting from StartCluster into Buffer returning size of buffer BufferSize
function WriteClusterChain(StartCluster: Longint;
Buffer: Pointer;
BufferSize: Longint): Boolean;
// Writes total cluster chain starting from StartCluster from Buffer of size BufferSize
function SeekForChainStart(Cluster: Longint): Longint;
// Seeks for starting chain cluster number, Cluster represents any mid cluster of a chain
function DIRPath(Path: String;
var DIR: PDIR_Entry;
var Entries: Longint): Boolean;
// Returns all directory entries of a path Path including deleted entries into
// DIR as a pointer to TDIR_Entry array returning amount of Entries found
function ExtractDIREntry(Path: String;
var DIR: TDIR_Entry): Boolean;
// Gets DIR entry of a Path (or file as Path) specified
property Drive: Char read GetDrive write SetDrive;
// Assign drive letter for class
property LogicalSectors: Longint read FLogicalSectors;
// Amount of Logical sectors on selected drive
property PhysicalSectors: Longint read FPhysicalSectors;
// Amount of Physical sectors on selected drive
property Heads: Longint read FHeads;
// Amount of heads on selected drive
property Cylinders: Longint read FCylinders;
// Amount of Cylinders on selected drive
property BytesPerSector: Longint read FBytesPerSector;
// Amount of Bytes per sector on selected drive
property PhysicalDrive: Longint read FPhysicalVolume;
// Physical drive number
property SectorsPerCluster: Longint read FSectorsPerCluster;
// Amount of sectors per cluster on selected drive
property SectorsPerFAT: Longint read FSectorsPerFAT;
// Amount of sectors per FAT on selected drive
property FATSector[FATIndex: Longint]: Longint read GetFATCluster;
// Returns first sector number of a FAT copy FATIndex
property FATCount: Longint read FFATCount;
// Amount of FAT copies
property RootDirCluster: Longint read FRootDirCluster;
// First cluster number of a Root dir (has meaning only for FAT32)
property RootDirSector: Longint read FRootDirSector;
// First sector number of a Root dir
property RootDirEntries: Longint read FRootDirEntries;
// Amount of a Root dir entries for a drive (non FAT32 only)
property Cluster2Sector: Longint read FCluster2Sector;
// Gives exact Sector number of Cluster number 2 (data start for non FAT32 drives)
property EndingCluster: Longint read FEndingCluster;
// Maximum FAT number for a drive
property FATEntry[CopyOfFAT, Cluster: Longint]: Longint read GetFATEntry write SetFATEntry;
// Gets or sets FAT Entry for cluster Cluster and for FAT copy CopyOfFAT
property Serial: Longint read FSerial;
// Gets volume serial number
property VolumeLabel: String read FLabel;
// Shows volume label
property FileSystem: TFileSystem read FFileSystem;
// What kind of FAT system is used for a drive
end;

procedure ParseDOSDate(Date: Word;
var Day, Month, Year: Word);
// Use this function to get Day, Month and Year of a Date fields in Dir_Entry
procedure ParseDOSTime(Time: Word;
var Hour, Minute, Second: Word);
// Use this function to get Hour, Minute and Second of a Time fields in Dir_Entry
implementation
procedure ParseDOSTime(Time: Word;
var Hour, Minute, Second: Word);
begin
Second := (Time and $001f)*2;
Minute := (Time and $07e0) shr 5;
Hour := (Time and $f800) shr 11;
end;

procedure ParseDOSDate(Date: Word;
var Day, Month, Year: Word);
begin
Day := Date and $001f;
Month := (Date and $01e0) shr 5;
Year := (Date and $fe00) shr 9;
end;

function TDiskIO.GetFATCluster(FATIndex: Longint): Longint;
begin
Result := 0;
if FFATCount=0 then
Exit;
if FATIndex<1 then
FATIndex := 1;
if FATIndex>FFATCount then
FATIndex := FFATCount;
Result := Longint(Pointer(Longint(FFATSector)+(FATIndex-1)*4)^);
end;

procedure TDiskIO.IOCTL(Command: Longint;
var Regs: T32Regs);
var R: T32Regs;
cb: DWord;
begin
if FHandle = 0 then
Exit;
R := Regs;
DeviceIOControl(FHandle, Command,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
Regs := R;
end;

function TDiskIO.ObtainVolumeLock(Level: Byte;
Lock: TLockType): Boolean;
var R: T32Regs;
cb: DWord;
W: Longint;
V: Byte;
begin
W := Level;
W := W shl 8;
if Lock = lPhysical then
begin
V := FPhysicalVolume;
R.EAX := $440D;
R.EBX := W or V;
R.ECX := $084B;
if Level = 1 then
R.EDX := 1 else
R.EDX := 0;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
Result := (R.Flags and 1)=0;
end else
begin
R.EAX := $440D;
R.EBX := W or (FVolume and $FF);
R.ECX := $084A;
R.EDX := 0;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
Result := (R.Flags and 1)=0;
end;
end;

procedure TDiskIO.ReleaseVolumeLock(Lock: TLockType);
var R: T32Regs;
cb: DWord;
V: Byte;
begin
if Lock = lPhysical then
begin
V := FPhysicalVolume;
R.EAX := $440D;
R.EBX := V;
R.ECX := $086B;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
end else
begin
R.EAX := $440D;
R.EBX := FVolume and $FF;
R.ECX := $086A;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
end;
end;

function TDiskIO.VolumeLock(Lock: TLockType): Boolean;
begin
Result := False;
if FHandle = 0 then
Exit;
if FVolume = 0 then
Exit;
if Lock = lPhysical then
if FPhysicalVolume = -1 then
Exit;
Result := ObtainVolumeLock(1, Lock);
if not Result then
Exit;
Result := ObtainVolumeLock(2, Lock);
if not Result then
begin
ReleaseVolumeLock(Lock);
Exit;
end;
Result := ObtainVolumeLock(3, Lock);
if not Result then
begin
ReleaseVolumeLock(Lock);
ReleaseVolumeLock(Lock);
Exit;
end;
end;

procedure TDiskIO.VolumeUnlock(Lock: TLockType);
begin
if FHandle = 0 then
Exit;
if FVolume = 0 then
Exit;
if Lock = lPhysical then
if FPhysicalVolume = -1 then
Exit;
ReleaseVolumeLock(Lock);
ReleaseVolumeLock(Lock);
ReleaseVolumeLock(Lock);
end;

constructor TDiskIO.Create;
begin
FVolume := 0;
FPhysicalVolume := -1;
FLogicalSectors := 0;
FPhysicalSectors := 0;
FHeads := 0;
FCylinders := 0;
FBytesPerSector := 0;
FSectorsPerCluster := 0;
FSectorsPerFAT := 0;
FFATSector := NIL;
FFATSize := 0;
FFAT := NIL;
FFATCount := 0;
FRootDirEntries := 0;
FEndingCluster := 0;
FRootDirCluster := 0;
FRootDirSector := 0;
FSerial := 0;
FLabel := '';
FCluster2Sector := 0;
FFileSystem := fsNone;
FHandle := CreateFile('//./VWIN32', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
NIL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
if FHandle = INVALID_HANDLE_VALUE then
FHandle := 0;
end;

destructor TDiskIO.Destroy;
begin
if FHandle <> 0 then
CloseHandle(FHandle);
if FFATSector <> NIL then
FreeMem(FFATSector);
if FFAT <> NIL then
FreeMem(FFAT);
inherited Destroy;
end;

function TDiskIO.GetDrive: Char;
begin
Result := #0;
if FVolume = 0 then
Exit;
Result := Char(Byte(FVolume)+$40);
end;

function TDiskIO.VolumeCheck(var Flags: Longint): Boolean;
var R: T32Regs;
cb: DWord;
begin
Result := False;
if FHandle = 0 then
Exit;
if FVolume = 0 then
Exit;
R.EAX := $4409;
R.EBX := FVolume;
R.Flags := 1;
if not DeviceIoControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL) then
Exit;
if (R.Flags and 1) <> 0 then
Exit;
Flags := Word(R.EDX);
Result := True;
end;

function TDiskIO.GetMediaID(MID: PMID): Boolean;
var R: T32Regs;
cb: DWord;
begin
Result := False;
if FHandle = 0 then
Exit;
if FVolume = 0 then
Exit;
R.EAX := $440d;
// IOCTL for block device
R.EBX := FVolume;
// one-based drive number
R.ECX := $0866;
// Get Media ID
R.EDX := Longint(Mid);
R.Flags := 1;
// preset the carry flag
if not DeviceIoControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL) then
Exit;
if (R.Flags and 1) <> 0 then
Exit;
Result := True;
end;

const DRIVE_IS_SUBST = $8000;
procedure TDiskIO.DriveReread;
var P: Pointer;
R: T32Regs;
cb: DWord;
W: TWin95;
begin
if FHandle = 0 then
Exit;
if FVolume = 0 then
Exit;
W := CheckWindows95;
if W = NoWin95 then
Exit;
FSectorsPerCluster := 0;
FSectorsPerFAT := 0;
FFATSize := 0;
if FFAT <> NIL then
FreeMem(FFAT);
FFAT := NIL;
if FFATSector <> NIL then
FreeMem(FFATSector);
FFATSector := NIL;
FFATCount := 0;
FRootDirCluster := 0;
FSerial := 0;
FLabel := '';
FRootDirSector := 0;
FSectorsPerFAT := 0;
FRootDirEntries := 0;
FEndingCluster := 0;
FCluster2Sector := 0;
FFileSystem := fsNone;
if W = OSR2 then
begin
GetMem(P, SizeOf(TExt_DeviceParams));
R.EBX := FVolume;
R.ECX := $4860;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
R.EBX := FVolume;
R.ECX := $860;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
FVolume := 0;
FPhysicalVolume := -1;
FLogicalSectors := 0;
FPhysicalSectors := 0;
FHeads := 0;
FCylinders := 0;
FBytesPerSector := 0;
FreeMem(P, SizeOf(TExt_DeviceParams));
Exit;
end;
end;
FLogicalSectors := PExt_DeviceParams(P)^.dpBPB.bpbBigTotalSectors;
FBytesPerSector := PExt_DeviceParams(P)^.dpBPB.bpbSectorSize;
FHeads := PExt_DeviceParams(P)^.dpBPB.bpbHeads;
FCylinders := PExt_DeviceParams(P)^.dpNumberOfCylinders;
FPhysicalSectors := PExt_DeviceParams(P)^.dpBPB.bpbSectorsPerTrack;
FreeMem(P, SizeOf(TExt_DeviceParams));
CheckFileSystem;
GetMem(P, SizeOf(TDriveMapInfo));
R.EBX := FVolume;
R.ECX := $486F;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
R.EBX := FVolume;
R.ECX := $86F;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
FPhysicalVolume := -1;
FPhysicalSectors := 0;
FHeads := 0;
FCylinders := 0;
FreeMem(P, SizeOf(TDriveMapInfo));
Exit;
end;
end;
FPhysicalVolume := PDriveMapInfo(P)^.dmiInt13Unit;
FreeMem(P, SizeOf(TDriveMapInfo));
end else
begin
GetMem(P, SizeOf(TDeviceParams));
R.EBX := FVolume;
R.ECX := $860;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
FVolume := 0;
FPhysicalVolume := -1;
FLogicalSectors := 0;
FPhysicalSectors := 0;
FHeads := 0;
FCylinders := 0;
FBytesPerSector := 0;
FreeMem(P, SizeOf(TDeviceParams));
Exit;
end;
if PDeviceParams(P)^.dpBPB.bpbTotalSectors = 0 then
FLogicalSectors := PDeviceParams(P)^.dpBPB.bpbBigTotalSectors else
FLogicalSectors := PDeviceParams(P)^.dpBPB.bpbTotalSectors;
FBytesPerSector := PDeviceParams(P)^.dpBPB.bpbSectorSize;
FHeads := PDeviceParams(P)^.dpBPB.bpbHeads;
FCylinders := PDeviceParams(P)^.dpNumberOfCylinders;
FPhysicalSectors := PDeviceParams(P)^.dpBPB.bpbSectorsPerTrack;
FreeMem(P, SizeOf(TDeviceParams));
CheckFileSystem;
GetMem(P, SizeOf(TDriveMapInfo));
R.EBX := FVolume;
R.ECX := $86F;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
FPhysicalVolume := -1;
FPhysicalSectors := 0;
FHeads := 0;
FCylinders := 0;
FreeMem(P, SizeOf(TDriveMapInfo));
Exit;
end;
FPhysicalVolume := PDriveMapInfo(P)^.dmiInt13Unit;
FreeMem(P, SizeOf(TDriveMapInfo));
end;
end;

procedure TDiskIO.SetDrive(Value: Char);
var S: String;
P: Pointer;
R: T32Regs;
cb: DWord;
W: TWin95;
V: Longint;
Flags: Longint;
MID: TMID;
AMID: TPASMID;
begin
if FHandle = 0 then
Exit;
S := Value;
S := UpperCase(S);
W := CheckWindows95;
if W = NoWin95 then
Exit;
V := FVolume;
FVolume := Byte(S[1])-$40;
if V=FVolume then
Exit;
if not VolumeCheck(Flags) then
begin
FVolume := V;
Exit;
end;
if (Flags and DRIVE_IS_SUBST) <> 0 then
begin
FVolume := V;
Exit;
end;
if not GetMediaID(@MID) then
begin
FVolume := V;
Exit;
end;
TMID2TPASMID(MID, AMID);
if (AMID.midFileSysType = 'CDROM') or (AMID.midFileSysType = 'CD001') or
(AMID.midFileSysType = 'CDAUDIO') then
begin
FVolume := V;
Exit;
end;
FSectorsPerCluster := 0;
FSectorsPerFAT := 0;
FFATSize := 0;
if FFAT <> NIL then
FreeMem(FFAT);
FFAT := NIL;
if FFATSector <> NIL then
FreeMem(FFATSector);
FFATSector := NIL;
FFATCount := 0;
FRootDirCluster := 0;
FSerial := 0;
FLabel := '';
FRootDirSector := 0;
FSectorsPerFAT := 0;
FRootDirEntries := 0;
FEndingCluster := 0;
FCluster2Sector := 0;
FFileSystem := fsNone;
if W = OSR2 then
begin
GetMem(P, SizeOf(TExt_DeviceParams));
R.EBX := FVolume;
R.ECX := $4860;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
R.EBX := FVolume;
R.ECX := $860;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
FVolume := 0;
FPhysicalVolume := -1;
FLogicalSectors := 0;
FPhysicalSectors := 0;
FHeads := 0;
FCylinders := 0;
FBytesPerSector := 0;
FreeMem(P, SizeOf(TExt_DeviceParams));
Exit;
end;
end;
FLogicalSectors := PExt_DeviceParams(P)^.dpBPB.bpbBigTotalSectors;
FBytesPerSector := PExt_DeviceParams(P)^.dpBPB.bpbSectorSize;
FHeads := PExt_DeviceParams(P)^.dpBPB.bpbHeads;
FCylinders := PExt_DeviceParams(P)^.dpNumberOfCylinders;
FPhysicalSectors := PExt_DeviceParams(P)^.dpBPB.bpbSectorsPerTrack;
FreeMem(P, SizeOf(TExt_DeviceParams));
CheckFileSystem;
GetMem(P, SizeOf(TDriveMapInfo));
R.EBX := FVolume;
R.ECX := $486F;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
R.EBX := FVolume;
R.ECX := $86F;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
FPhysicalVolume := -1;
FPhysicalSectors := 0;
FHeads := 0;
FCylinders := 0;
FreeMem(P, SizeOf(TDriveMapInfo));
Exit;
end;
end;
FPhysicalVolume := PDriveMapInfo(P)^.dmiInt13Unit;
FreeMem(P, SizeOf(TDriveMapInfo));
end else
begin
GetMem(P, SizeOf(TDeviceParams));
R.EBX := FVolume;
R.ECX := $860;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
FVolume := 0;
FPhysicalVolume := -1;
FLogicalSectors := 0;
FPhysicalSectors := 0;
FHeads := 0;
FCylinders := 0;
FBytesPerSector := 0;
FreeMem(P, SizeOf(TDeviceParams));
Exit;
end;
if PDeviceParams(P)^.dpBPB.bpbTotalSectors = 0 then
FLogicalSectors := PDeviceParams(P)^.dpBPB.bpbBigTotalSectors else
FLogicalSectors := PDeviceParams(P)^.dpBPB.bpbTotalSectors;
FBytesPerSector := PDeviceParams(P)^.dpBPB.bpbSectorSize;
FHeads := PDeviceParams(P)^.dpBPB.bpbHeads;
FCylinders := PDeviceParams(P)^.dpNumberOfCylinders;
FPhysicalSectors := PDeviceParams(P)^.dpBPB.bpbSectorsPerTrack;
FreeMem(P, SizeOf(TDeviceParams));
CheckFileSystem;
GetMem(P, SizeOf(TDriveMapInfo));
R.EBX := FVolume;
R.ECX := $86F;
R.EDX := Longint(P);
R.EAX := $440D;
DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
@R, SizeOf(R), @R, SizeOf(R), cb, NIL);
if (R.Flags and 1)<>0 then
begin
FPhysicalVolume := -1;
FPhysicalSectors := 0;
FHeads := 0;
FCylinders := 0;
FreeMem(P, SizeOf(TDriveMapInfo));
Exit;
end;
FPhysicalVolume := PDriveMapInfo(P)^.dmiInt13Unit;
FreeMem(P, SizeOf(TDriveMapInfo));
end;
end;

type
PTransfer = ^TTransfer;
TTransfer = record
StartSector: Longint;
SectorCount: Word;
Buffer: Longint;
end;

var Transfer: TTransfer;
F: TMemoryStream;
function TDiskIO.ReadLogicalSectorEx(StartSector, nSectors: Longint;
var Buffer;
nSize: Longint): Boolean;
var R: T32Regs;
L, L1: Longint;
MaxSize: Longint;
P: Longint;
begin
Result := False;
if StartSector>=FLogicalSectors-1 then
StartSector := FLogicalSectors-1;
if StartSector+nSectors>FLogicalSectors then
nSectors := FLogicalSectors-StartSector;
MaxSize := FBytesPerSector*100;
F := TMemoryStream.Create;
F.SetSize(nSectors*FBytesPerSector);
L := F.Size;
P := Longint(F.Memory);
L1 := StartSector;
if VolumeLock(lLogical) then
begin
Result := True;
while L>MaxSizedo
begin
Transfer.StartSector := L1;
Transfer.SectorCount := 100;
Transfer.Buffer := P;
R.ESI := 0;
R.EDX := FVolume;
R.ECX := $FFFFFFFF;
R.EBX := Longint(@Transfer);
R.EAX := $7305;
L1 := L1+100;
L := L-MaxSize;
P := P+MaxSize;
IOCTL(VWIN32_DIOC_DOS_DRIVEINFO, R);
Result := Result and (not Odd(R.Flags));
end;
Transfer.StartSector := L1;
Transfer.SectorCount := L div FBytesPerSector;
Transfer.Buffer := P;
R.ESI := 0;
R.EDX := FVolume;
R.ECX := $FFFFFFFF;
R.EBX := Longint(@Transfer);
R.EAX := $7305;
IOCTL(VWIN32_DIOC_DOS_DRIVEINFO, R);
Result := Result and (not Odd(R.Flags));
VolumeUnlock(lLogical);
end;
F.Seek(0, 0);
if nSize > F.Size then
F.Read(Buffer, F.Size)
else
F.Read(Buffer, nSize);
F.Free;
end;

function TDiskIO.ReadLogicalSector(StartSector, nSectors: Longint;
var Buffer;
nSize: Longint): Boolean;
var R: T32Regs;
L, L1: Longint;
MaxSize: Longint;
P: Longint;
W: TWin95;
begin
FillChar(Buffer, nSize, 0);
Result := False;
if (FHandle = 0) or (FVolume = 0) then
Exit;
W := CheckWindows95;
if W = NoWin95 then
Exit;
if W = OSR2 then
begin
Result := ReadLogicalSectorEx(StartSector, nSectors, Buffer, nSize);
if Result then
Exit;
end;
if StartSector>=FLogicalSectors-1 then
StartSector := FLogicalSectors-1;
if StartSector+nSectors>FLogicalSectors then
nSectors := FLogicalSectors-StartSector;
MaxSize := FBytesPerSector*100;
F := TMemoryStream.Create;
F.SetSize(nSectors*FBytesPerSector);
L := F.Size;
P := Longint(F.Memory);
L1 := StartSector;
if VolumeLock(lLogical) then
begin
Result := True;
while L>MaxSizedo
begin
Transfer.StartSector := L1;
Transfer.SectorCount := 100;
Transfer.Buffer := P;
R.EAX := FVolume-1;
R.ECX := $FFFFFFFF;
R.EBX := Longint(@Transfer);
L1 := L1+100;
L := L-MaxSize;
P := P+MaxSize;
IOCTL(VWIN32_DIOC_DOS_INT25, R);
Result := Result and (not Odd(R.Flags));
end;
Transfer.StartSector := L1;
Transfer.SectorCount := L div FBytesPerSector;
Transfer.Buffer := P;
R.EAX := FVolume-1;
R.ECX := $FFFFFFFF;
R.EBX := Longint(@Transfer);
IOCTL(VWIN32_DIOC_DOS_INT25, R);
Result := Result and (not Odd(R.Flags));
VolumeUnlock(lLogical);
end;
F.Seek(0, 0);
if nSize > F.Size then
F.Read(Buffer, F.Size)
else
F.Read(Buffer, nSize);
F.Free;
end;

function TDiskIO.WriteLogicalSectorEx(StartSector, nSectors: Longint;
var Buffer;
nSize: Longint): Boolean;
var R: T32Regs;
L, L1: Longint;
MaxSize: Longint;
P: Longint;
begin
Result := False;
if StartSector>=FLogicalSectors-1 then
StartSector := FLogicalSectors-1;
if StartSector+nSectors>FLogicalSectors then
nSectors := FLogicalSectors-StartSector;
MaxSize := FBytesPerSector*100;
F := TMemoryStream.Create;
F.SetSize(nSectors*FBytesPerSector);
F.Seek(0, 0);
F.Write(Buffer, F.Size);
L := F.Size;
P := Longint(F.Memory);
L1 := StartSector;
if VolumeLock(lLogical) then
begin
Result := True;
while L>MaxSizedo
begin
Transfer.StartSector := L1;
Transfer.SectorCount := 100;
Transfer.Buffer := P;
R.ESI := $6001;
R.EDX := FVolume;
R.ECX := $FFFFFFFF;
R.EBX := Longint(@Transfer);
R.EAX := $7305;
L1 := L1+100;
L := L-MaxSize;
P := P+MaxSize;
IOCTL(VWIN32_DIOC_DOS_DRIVEINFO, R);
Result := Result and (not Odd(R.Flags));
end;
Transfer.StartSector := L1;
Transfer.SectorCount := L div FBytesPerSector;
Transfer.Buffer := P;
R.ESI := 1;
R.EDX := FVolume;
R.ECX := $FFFFFFFF;
R.EBX := Longint(@Transfer);
R.EAX := $7305;
IOCTL(VWIN32_DIOC_DOS_DRIVEINFO, R);
Result := Result and (not Odd(R.Flags));
VolumeUnlock(lLogical);
end;
F.Seek(0, 0);
if nSize > F.Size then
F.Read(Buffer, F.Size)
else
F.Read(Buffer, nSize);
F.Free;
end;

function TDiskIO.WriteLogicalSector(StartSector, nSectors: Longint;
var Buffer;
nSize: Longint): Boolean;
var R: T32Regs;
L, L1: Longint;
MaxSize: Longint;
P: Longint;
W: TWin95;
begin
Result := False;
if (FHandle = 0) or (FVolume = 0) then
Exit;
W := CheckWindows95;
if W = NoWin95 then
Exit;
if W = OSR2 then
begin
Result := WriteLogicalSectorEx(StartSector, nSectors, Buffer, nSize);
if Result then
Exit;
end;
if StartSector>=FLogicalSectors-1 then
StartSector := FLogicalSectors-1;
if StartSector+nSectors>FLogicalSectors then
nSectors := FLogicalSectors-StartSector;
MaxSize := FBytesPerSector*100;
F := TMemoryStream.Create;
F.SetSize(nSectors*FBytesPerSector);
F.Seek(0, 0);
F.Write(Buffer, F.Size);
L := F.Size;
P := Longint(F.Memory);
L1 := StartSector;
if VolumeLock(lLogical) then
begin
Result := True;
while L>MaxSizedo
begin
Transfer.StartSector := L1;
Transfer.SectorCount := 100;
Transfer.Buffer := P;
R.EAX := FVolume-1;
R.ECX := $FFFFFFFF;
R.EBX := Longint(@Transfer);
L1 := L1+100;
L := L-MaxSize;
P := P+MaxSize;
IOCTL(VWIN32_DIOC_DOS_INT26, R);
Result := Result and (not Odd(R.Flags));
end;
Transfer.StartSector := L1;
Transfer.SectorCount := L div FBytesPerSector;
Transfer.Buffer := P;
R.EAX := FVolume-1;
R.ECX := $FFFFFFFF;
R.EBX := Longint(@Transfer);
IOCTL(VWIN32_DIOC_DOS_INT26, R);
Result := Result and (not Odd(R.Flags));
VolumeUnlock(lLogical);
end;
F.Free;
end;

procedure TDiskIO.CheckFileSystem;
var P, P1, P2: Pointer;
I, J: Longint;
szFSType: String;
B1, B2: Byte;
W: Word;
L: Longint;
begin
GetMem(P, FBytesPerSector);
if not ReadLogicalSector(0, 1, P^, FBytesPerSector) then
begin
FreeMem(P);
Exit;
end;
if PBOOTSect(P)^.bsFATsecs = 0 then
FFileSystem := fsFAT32;
if FFileSystem = fsFAT32 then
begin
FSerial := PBootSect32(P)^.bsVolumeID;
SetLength(FLabel, 11);
for I := 1 to 11do
FLabel := PBootSect32(P)^.bsVolumeLabel;
try
while (Length(FLabel)<>0) and (FLabel[Length(FLabel)]=' ')do
Delete(FLabel, Length(FLabel), 1);
except
on Exceptiondo
;
end;
FSectorsPerCluster := PBootSect32(P)^.bpb.A_BF_BPB_SectorsPerCluster;
FFATCount := PBootSect32(P)^.bpb.A_BF_BPB_NumberOfFATs;
GetMem(FFATSector, FFATCount*4);
I := PBootSect32(P)^.bpb.A_BF_BPB_ReservedSectors;
Longint(FFATSector^) := I;
FSectorsPerFAT := PBootSect32(P)^.bpb.A_BF_BPB_BigSectorsPerFatHi;
FSectorsPerFAT := (FSectorsPerFAT shl 16)+PBootSect32(P)^.bpb.A_BF_BPB_BigSectorsPerFat;
P1 := FFATSector;
Inc(Longint(P1), 4);
if FFATCount>1 then
for J := 2 to FFATCountdo
begin
I := I+FSectorsPerFAT;
Longint(P1^) := I;
Inc(Longint(P1), 4);
end;
FRootDirCluster := PBootSect32(P)^.bpb.A_BF_BPB_RootDirStrtClusHi;
FRootDirCluster := (FRootDirCluster shl 16)+PBootSect32(P)^.bpb.A_BF_BPB_RootDirStrtClus;
FRootDirSector := PBootSect32(P)^.bpb.A_BF_BPB_ReservedSectors+FFATCount*FSectorsPerFAT;
FRootDirSector := FRootDirSector+(FRootDirCluster-2)*FSectorsPerCluster;
FCluster2Sector := FRootDirSector;
end else
begin
FSerial := PBootSect(P)^.bsVolumeID;
SetLength(FLabel, 11);
for I := 1 to 11do
FLabel := PBootSect(P)^.bsVolumeLabel;
try
while (Length(FLabel)<>0) and (FLabel[Length(FLabel)]=' ')do
Delete(FLabel, Length(FLabel), 1);
except
on Exceptiondo
;
end;
SetLength(szFSType, 8);
FillChar(szFSType[1], 8, 0);
Move(PBootSect(P)^.bsFileSysType, szFSType[1], 8);
try
while (Length(szFSType) <> 0) and (szFSType[Length(szFSType)] = ' ')do
Delete(szFSType, Length(szFSType), 1);
except
on Exceptiondo
;
end;
if strcomp(PChar(szFSType), 'FAT12') = 0 then
FFileSystem := fsFAT12 else
if strcomp(PChar(szFSType), 'FAT16') = 0 then
FFileSystem := fsFAT16;
FSectorsPerCluster := PBootSect(P)^.bsSecPerClust;
FFATCount := PBootSect(P)^.bsFATs;
GetMem(FFATSector, FFATCount*4);
FSectorsPerFAT := PBootSect(P)^.bsFATsecs;
I := PBootSect(P)^.bsResSectors;
Longint(FFATSector^) := I;
P1 := FFATSector;
Inc(Longint(P1), 4);
if FFATCount>1 then
for J := 2 to FFATCountdo
begin
I := I+FSectorsPerFAT;
Longint(P1^) := I;
Inc(Longint(P1), 4);
end;
FRootDirEntries := PBootSect(P)^.bsRootDirEnts;
FRootDirSector := PBootSect(P)^.bsResSectors+FSectorsPerFAT*FFATCount;
FRootDirCluster := 1;
FCluster2Sector := FRootDirSector+((FRootDirEntries*32+FBytesPerSector-1) div FBytesPerSector);
end;
FLabel := UpperCase(FLabel);

FEndingCluster := ((FLogicalSectors-FCluster2Sector) div FSectorsPerCluster)+1;
FreeMem(P);
if FFileSystem = fsNone then
Exit;
{Read FAT}
GetMem(P, FSectorsPerFAT*FFATCount*FBytesPerSector);
if not ReadLogicalSector(FATSector[1], FSectorsPerFAT*FFATCount, P^, FBytesPerSector*FSectorsPerFAT*FFATCount) then
begin
FreeMem(P);
Exit;
end;
FFATSize := FEndingCluster-1;
GetMem(FFAT, FFATSize*FFATCount*4);
FillChar(FFAT^, FFATSize*FFATCount*4, 0);
P2 := FFAT;
if FFileSystem = fsFAT12 then
begin
for J := 0 to FFATCount-1do
begin
P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+3);
for I := 1 to FFATSize div 2do
begin
B1 := Byte(P1^);
Inc(Longint(P1));
B2 := Byte(P1^) and $0F;
W := B2;
W := (W shl 8) or B1;
L := W;
Longint(P2^) := L and FAT_MASK_12;
Inc(Longint(P2), 4);
B1 := Byte(P1^) and $F0;
Inc(Longint(P1));
B2 := Byte(P1^);
Inc(Longint(P1));
W := B2;
W := (W shl 4) or (B1 shr 4);
L := W;
Longint(P2^) := L and FAT_MASK_12;
Inc(Longint(P2), 4);
end;
if Odd(FFATSize) then
begin
B1 := Byte(P1^);
Inc(Longint(P1));
B2 := Byte(P1^) and $0F;
W := B2;
W := (W shl 8) or B1;
L := W;
Longint(P2^) := L and FAT_MASK_12;
end;
end;
end else
if FFileSystem = fsFAT16 then
begin
for J := 0 to FFATCount-1do
begin
P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+4);
for I := 1 to FFATSizedo
begin
L := Word(P1^);
Inc(Longint(P1), 2);
Longint(P2^) := L and FAT_MASK_16;
Inc(Longint(P2), 4);
end;
end;
end else
begin
for J := 0 to FFATCount-1do
begin
P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+8);
for I := 1 to FFATSizedo
begin
L := Longint(P1^);
Inc(Longint(P1), 4);
Longint(P2^) := L and FAT_MASK_32;
Inc(Longint(P2), 4);
end;
end;
end;
FreeMem(P);
end;

function TDiskIO.GetFATEntry(CopyOfFAT: Longint;
Cluster: Longint): Longint;
begin
Result := -1;
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
if CopyOfFAT < 1 then
CopyOfFAT := 1;
if CopyOfFAT > FFATCount then
CopyOfFAT := FFATCount;
if Cluster < 2 then
Cluster := 2;
if Cluster > FEndingCluster then
Cluster := FEndingCluster;
Cluster := Cluster-2;
CopyOfFAT := CopyOfFAT-1;
Result := Longint(Pointer(Longint(FFAT)+CopyOfFAT*FFATSize*4+Cluster*4)^);
if FFileSystem = fsFAT12 then
Result := Result and FAT_MASK_12 else
if FFileSystem = fsFAT16 then
Result := Result and FAT_MASK_16 else
Result := Result and FAT_MASK_32;
end;

procedure TDiskIO.SetFATEntry(CopyOfFAT: Longint;
Cluster: Longint;
Value: Longint);
begin
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
if CopyOfFAT < 1 then
CopyOfFAT := 1;
if CopyOfFAT > FFATCount then
CopyOfFAT := FFATCount;
if Cluster < 2 then
Cluster := 2;
if Cluster > FEndingCluster then
Cluster := FEndingCluster;
Cluster := Cluster-2;
CopyOfFAT := CopyOfFAT-1;
if FFileSystem = fsFAT12 then
Value := Value and FAT_MASK_12 else
if FFileSystem = fsFAT16 then
Value := Value and FAT_MASK_16 else
Value := Value and FAT_MASK_32;
Longint(Pointer(Longint(FFAT)+CopyOfFAT*FFATSize*4+Cluster*4)^) := Value;
end;

procedure TDiskIO.FlushFAT;
var P, P1, P2: Pointer;
I, J: Longint;
W: Word;
L, L1, L2: Longint;
B1, B2, B3, B4: Byte;
begin
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
GetMem(P, FSectorsPerFAT*FFATCount*FBytesPerSector);
FillChar(P^, FSectorsPerFAT*FFATCount*FBytesPerSector, 0);
P2 := FFAT;
if FFileSystem = fsFAT12 then
begin
for J := 0 to FFATCount-1do
begin
P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+3);
Byte(Pointer(Longint(P1)-3)^) := $F8;
Byte(Pointer(Longint(P1)-2)^) := $FF;
Byte(Pointer(Longint(P1)-1)^) := $FF;
for I := 1 to FFATSize div 2do
begin
L1 := Longint(P2^)and FAT_MASK_12;
Inc(Longint(P2), 4);
L2 := Longint(P2^)and FAT_MASK_12;
Inc(Longint(P2), 4);
B1 := Byte(L1);
B2 := Byte(L1 shr 8) and $F;
B3 := Byte(L2 and $F) shl 4;
B4 := Byte(L2 shr 4);
B2 := B2 or B3;
Byte(P1^) := B1;
Inc(Longint(P1));
Byte(P1^) := B2;
Inc(Longint(P1));
Byte(P1^) := B4;
Inc(Longint(P1));
end;
if Odd(FFATSize) then
begin
L := Longint(P2^)and FAT_MASK_12;
Inc(Longint(P2), 4);
B1 := Byte(L);
B2 := Byte(L shr 8) and $F;
Byte(P1^) := B1;
Inc(Longint(P1));
Byte(P1^) := B2;
Inc(Longint(P1));
end;
end;
end else
if FFileSystem = fsFAT16 then
begin
for J := 0 to FFATCount-1do
begin
P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+4);
Word(Pointer(Longint(P1)-4)^) := $FFF8;
Word(Pointer(Longint(P1)-2)^) := $FFFF;
for I := 1 to FFATSizedo
begin
L1 := Longint(P2^)and FAT_MASK_16;
Inc(Longint(P2), 4);
W := Word(L1);
Word(P1^) := W;
Inc(Longint(P1), 2);
end;
end;
end else
begin
for J := 0 to FFATCount-1do
begin
P1 := Pointer(Longint(P)+J*FSectorsPerFAT*FBytesPerSector+8);
Longint(Pointer(Longint(P1)-8)^) := $FFFFFF8;
Longint(Pointer(Longint(P1)-4)^) := $FFFFFFFF;
for I := 1 to FFATSizedo
begin
L := Longint(P2^)and FAT_MASK_32;
Inc(Longint(P2), 4);
Longint(P1^) := L;
Inc(Longint(P1), 4);
end;
end;
end;
WriteLogicalSector(FATSector[1], FSectorsPerFAT*FFATCount, P^, FBytesPerSector*FSectorsPerFAT*FFATCount);
FreeMem(P);
end;

function TDiskIO.ReadCluster(Cluster: Longint;
var Buffer;
BufferSize: Longint): Boolean;
var P: Pointer;
I: Longint;
begin
Result := False;
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
if Cluster < 2 then
Cluster := 2;
if Cluster > FEndingCluster then
Cluster := FEndingCluster;
Cluster := Cluster-2;
GetMem(P, FBytesPerSector*FSectorsPerCluster);
I := FCluster2Sector+FSectorsPerCluster*Cluster;
Result := ReadLogicalSector(I, FSectorsPerCluster, P^, FBytesPerSector*FSectorsPerCluster);
if Result then
Move(P^, Buffer, BufferSize);
FreeMem(P);
end;

function TDiskIO.WriteCluster(Cluster: Longint;
var Buffer;
BufferSize: Longint): Boolean;
var P: Pointer;
I: Longint;
begin
Result := False;
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
if Cluster < 2 then
Cluster := 2;
if Cluster > FEndingCluster then
Cluster := FEndingCluster;
Cluster := Cluster-2;
GetMem(P, FBytesPerSector*FSectorsPerCluster);
FillChar(P^, FBytesPerSector*FSectorsPerCluster, 0);
if BufferSize > FBytesPerSector*FSectorsPerCluster then
BufferSize := FBytesPerSector*FSectorsPerCluster;
Move(Buffer, P^, BufferSize);
I := FCluster2Sector+FSectorsPerCluster*Cluster;
Result := WriteLogicalSector(I, FSectorsPerCluster, P^, FBytesPerSector*FSectorsPerCluster);
FreeMem(P);
end;

function TDiskIO.ValidCluster(Cluster: Longint): Boolean;
begin
Result := (Cluster>=2) and (Cluster<=FEndingCluster);
end;

function TDiskIO.WriteClusterChain(StartCluster: Longint;
Buffer: Pointer;
BufferSize: Longint): Boolean;
var ClusterSize: Longint;
I: Longint;
begin
Result := False;
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
if StartCluster < 2 then
StartCluster := 2;
if StartCluster > FEndingCluster then
StartCluster := FEndingCluster;
ClusterSize := FBytesPerSector*FSectorsPerCluster;
I := StartCluster;
while ValidCluster(I)do
begin
if BufferSize<ClusterSize then
begin
Result := WriteCluster(I, Buffer^, BufferSize);
Break;
end else
Result := WriteCluster(I, Buffer^, ClusterSize);
if not Result then
Break;
Longint(Buffer) := Longint(Buffer)+ClusterSize;
BufferSize := BufferSize-ClusterSize;
I := FATEntry[1, I];
end;
end;

function TDiskIO.ReadClusterChain(StartCluster: Longint;
var Buffer: Pointer;
var BufferSize: Longint): Boolean;
var I, J: Longint;
P: Pointer;
F: TMemoryStream;
B: Boolean;
begin
Result := False;
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
if StartCluster < 2 then
StartCluster := 2;
if StartCluster > FEndingCluster then
StartCluster := FEndingCluster;
I := StartCluster;
J := FBytesPerSector*FSectorsPerCluster;
GetMem(P, J);
F := TMemoryStream.Create;
repeat
if not ValidCluster(I) then
Break;
B := ReadCluster(I, P^, J);
if not B then
begin
Result := False;
Break;
end;
Result := True;
F.Write(P^, J);
I := FATEntry[1, I];
until False;
FreeMem(P);
Buffer := NIL;
BufferSize := 0;
if Result then
begin
BufferSize := F.Size;
GetMem(Buffer, BufferSize);
F.Seek(0, 0);
F.Read(Buffer^, BufferSize);
end;
F.Free;
end;

function TDiskIO.SeekForChainStart(Cluster: Longint): Longint;
var I, J: Longint;
B: Boolean;
begin
Result := -1;
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
if Cluster < 2 then
Cluster := 2;
if Cluster > FEndingCluster then
Cluster := FEndingCluster;
J := -1;
repeat
B := False;
for I := 2 to FEndingClusterdo
if FATEntry[1, I] = Cluster then
begin
J := I;
Cluster := I;
B := True;
Break;
end;
until not B;
Result := J;
end;

function TDiskIO.ReadRootDIR(var DIR: PDIR_Entry;
var Entries: Longint): Boolean;
var P: Pointer;
P1: PDIREntry;
PL: PLONGDIRENTRY;
Size: Longint;
ADIR: TMemoryStream;
I, J: Longint;
Dir_Entry: TDIR_Entry;
Stored: Boolean;
S: String;
SZ: Array[0..10] of WideChar;
begin
Result := False;
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
if FFileSystem = fsFAT32 then
Result := ReadClusterChain(2, P, Size) else
begin
Size := ((FRootDirEntries*32+FBytesPerSector-1) div FBytesPerSector)*FBytesPerSector;
GetMem(P, Size);
Result := ReadLogicalSector(FRootDirSector, Size div FBytesPerSector, P^, Size);
if not Result then
FreeMem(P);
end;
if not Result then
Exit;
Size := Size div 32;
ADIR := TMemoryStream.Create;
P1 := P;
Stored := True;
for I := 1 to Sizedo
begin
if Stored then
begin
Stored := False;
FillChar(DIR_Entry, SizeOf(DIR_Entry), 0);
end;
if Byte(Pointer(P1)^) = $e5 then
DIR_Entry.Erased := True else
DIR_Entry.Erased := False;
if (Byte(Pointer(Longint(P1)+$0b)^) = $f) and
(Byte(Pointer(Longint(P1)+$0c)^) = 0) then
begin
PL := PLONGDIRENTRY(P1);
if (PL^.leName[1] <> WideChar(0)) and (PL^.leName[1] <> WideChar($FFFF)) then
begin
FillChar(SZ, SizeOf(SZ), 0);
for J := 1 to 5do
SZ[J-1] := PL^.leName[J];
S := WideCharToString(SZ);
end else
S := '';
if (PL^.leName2[1] <> WideChar(0)) and (PL^.leName2[1] <> WideChar($FFFF)) then
begin
FillChar(SZ, SizeOf(SZ), 0);
for J := 1 to 6do
SZ[J-1] := PL^.leName2[J];
S := S+WideCharToString(SZ);
end;
if (PL^.leName3[1] <> WideChar(0)) and (PL^.leName3[1] <> WideChar($FFFF)) then
begin
FillChar(SZ, SizeOf(SZ), 0);
for J := 1 to 2do
SZ[J-1] := PL^.leName3[J];
S := S+WideCharToString(SZ);
end;
if DIR_Entry.LongName = '' then
DIR_Entry.LongName := S else
Insert(S, DIR_Entry.LongName, 1);
Inc(Longint(P1), SizeOf(TDIRENTRY));
Continue;
end;
if (Byte(Pointer(Longint(P1)+$0b)^) = $f) and
(Byte(Pointer(Longint(P1)+$0c)^) <> 0) then
begin
Stored := True;
Inc(Longint(P1), SizeOf(TDIRENTRY));
Continue;
end;
S := '';
for J := 1 to 8do
S := S+P1^.deName[J];
try
while (Length(S)<>0) and ((S[Length(S)]=' ') or (S[Length(S)]=#0))do
Delete(S, Length(S), 1);
except
on Exceptiondo
;
end;
DIR_Entry.Name := UpperCase(S);
if (DIR_Entry.Name <> '') and (DIR_Entry.Name <> '.') and
(DIR_Entry.Name <> '..') and ((P1^.deAttributes and $08) = 0) then
DIR_Entry.Name := DIR_Entry.Name+'.';
S := '';
for J := 1 to 3do
S := S+P1^.deExtension[J];
try
while (Length(S)<>0) and ((S[Length(S)]=' ') or (S[Length(S)]=#0))do
Delete(S, Length(S), 1);
except
on Exceptiondo
;
end;
if (DIR_Entry.Name <> '') and (DIR_Entry.Name <> '.') and
(DIR_Entry.Name <> '..') then
begin
S := UpperCase(S);
if S <> '' then
DIR_Entry.Name := DIR_Entry.Name+UpperCase(S) else
Delete(DIR_Entry.Name, Length(DIR_Entry.Name), 1);
end;
DIR_Entry.Attributes := P1^.deAttributes;
if FFileSystem = fsFAT32 then
begin
DIR_Entry.StartCluster := P1^.deEAhandle;
DIR_Entry.StartCluster := DIR_Entry.StartCluster shl 16;
DIR_Entry.StartCluster := DIR_Entry.StartCluster+P1^.deStartCluster;
end else
DIR_Entry.StartCluster := P1^.deStartCluster;
DIR_Entry.CreateTime := P1^.deCreateTime;
DIR_Entry.CreateDate := P1^.deCreateDate;
DIR_Entry.FileSize := P1^.deFileSize;
DIR_Entry.LastAccessDate := P1^.deLastAccessDate;
ADIR.Write(DIR_Entry, SizeOf(DIR_Entry));
Stored := True;
Inc(Longint(P1), SizeOf(TDIRENTRY));
end;
FreeMem(P);
Entries := ADIR.Size div SizeOf(DIR_Entry);
GetMem(DIR, ADIR.Size);
ADIR.Seek(0, 0);
ADIR.Read(DIR^, ADIR.Size);
ADIR.Free;
Result := True;
end;

function TDiskIO.ReadOtherDIR(Cluster: Longint;
var DIR: PDIR_Entry;
var Entries: Longint): Boolean;
var P: Pointer;
P1: PDIREntry;
PL: PLONGDIRENTRY;
Size: Longint;
ADIR: TMemoryStream;
I, J: Longint;
Dir_Entry: TDIR_Entry;
Stored: Boolean;
S: String;
SZ: Array[0..10] of WideChar;
begin
Result := False;
if FFileSystem = fsNone then
Exit;
if FFAT = NIL then
Exit;
if FFATSize = 0 then
Exit;
Result := ReadClusterChain(Cluster, P, Size);
if not Result then
Exit;
Size := Size div 32;
ADIR := TMemoryStream.Create;
P1 := P;
Stored := True;
for I := 1 to Sizedo
begin
if Stored then
begin
Stored := False;
FillChar(DIR_Entry, SizeOf(DIR_Entry), 0);
end;
if Byte(Pointer(P1)^) = $e5 then
DIR_Entry.Erased := True else
DIR_Entry.Erased := False;
if (Byte(Pointer(Longint(P1)+$0b)^) = $f) and
(Byte(Pointer(Longint(P1)+$0c)^) = 0) then
begin
PL := PLONGDIRENTRY(P1);
if (PL^.leName[1] <> WideChar(0)) and (PL^.leName[1] <> WideChar($FFFF)) then
begin
FillChar(SZ, SizeOf(SZ), 0);
for J := 1 to 5do
SZ[J-1] := PL^.leName[J];
S := WideCharToString(SZ);
end else
S := '';
if (PL^.leName2[1] <> WideChar(0)) and (PL^.leName2[1] <> WideChar($FFFF)) then
begin
FillChar(SZ, SizeOf(SZ), 0);
for J := 1 to 6do
SZ[J-1] := PL^.leName2[J];
S := S+WideCharToString(SZ);
end;
if (PL^.leName3[1] <> WideChar(0)) and (PL^.leName3[1] <> WideChar($FFFF)) then
begin
FillChar(SZ, SizeOf(SZ), 0);
for J := 1 to 2do
SZ[J-1] := PL^.leName3[J];
S := S+WideCharToString(SZ);
end;
if DIR_Entry.LongName = '' then
DIR_Entry.LongName := S else
Insert(S, DIR_Entry.LongName, 1);
Inc(Longint(P1), SizeOf(TDIRENTRY));
Continue;
end;
if (Byte(Pointer(Longint(P1)+$0b)^) = $f) and
(Byte(Pointer(Longint(P1)+$0c)^) <> 0) then
begin
Stored := True;
Inc(Longint(P1), SizeOf(TDIRENTRY));
Continue;
end;
S := '';
for J := 1 to 8do
S := S+P1^.deName[J];
try
while (Length(S)<>0) and ((S[Length(S)]=' ') or (S[Length(S)]=#0))do
Delete(S, Length(S), 1);
except
on Exceptiondo
;
end;
DIR_Entry.Name := UpperCase(S);
if (DIR_Entry.Name <> '') and (DIR_Entry.Name <> '.') and
(DIR_Entry.Name <> '..') and ((P1^.deAttributes and $08) = 0) then
DIR_Entry.Name := DIR_Entry.Name+'.';
S := '';
for J := 1 to 3do
S := S+P1^.deExtension[J];
try
while (Length(S)<>0) and ((S[Length(S)]=' ') or (S[Length(S)]=#0))do
Delete(S, Length(S), 1);
except
on Exceptiondo
;
end;
if (DIR_Entry.Name <> '') and (DIR_Entry.Name <> '.') and
(DIR_Entry.Name <> '..') then
begin
S := UpperCase(S);
if S <> '' then
DIR_Entry.Name := DIR_Entry.Name+UpperCase(S) else
Delete(DIR_Entry.Name, Length(DIR_Entry.Name), 1);
end;
DIR_Entry.Attributes := P1^.deAttributes;
if FFileSystem = fsFAT32 then
begin
DIR_Entry.StartCluster := P1^.deEAhandle;
DIR_Entry.StartCluster := DIR_Entry.StartCluster shl 16;
DIR_Entry.StartCluster := DIR_Entry.StartCluster+P1^.deStartCluster;
end else
DIR_Entry.StartCluster := P1^.deStartCluster;
DIR_Entry.CreateTime := P1^.deCreateTime;
DIR_Entry.CreateDate := P1^.deCreateDate;
DIR_Entry.FileSize := P1^.deFileSize;
DIR_Entry.LastAccessDate := P1^.deLastAccessDate;
ADIR.Write(DIR_Entry, SizeOf(DIR_Entry));
Stored := True;
Inc(Longint(P1), SizeOf(TDIRENTRY));
end;
FreeMem(P);
Entries := ADIR.Size div SizeOf(DIR_Entry);
GetMem(DIR, ADIR.Size);
ADIR.Seek(0, 0);
ADIR.Read(DIR^, ADIR.Size);
ADIR.Free;
Result := True;
end;

function GetShortName(Name: String): String;
var S: String;
I: Longint;
begin
SetLength(S, 10000);
I := GetShortPathName(PChar(Name), @S[1], 10000);
SetLength(S, I);
Result := S;
end;

procedure ParseFileName(FileName: String;
Parsed: TStrings);
var STemp: String;
S: String;
begin
Parsed.Clear;
if FileName = '' then
Exit;
STemp := ExpandFileName(FileName);
STemp := UpperCase(GetShortName(STemp));
if STemp = '' then
Exit;
S := STemp[1];
Parsed.Add(S);
Delete(STemp, 1, 3);
repeat
if Length(STemp) = 0 then
Break;
S := '';
try
while (Length(STemp)<>0) and (STemp[1]<>'/')do
begin
S := S+STemp[1];
Delete(STemp, 1, 1);
end;
except
on Exceptiondo
begin
if Length(S)<>0 then
Parsed.Add(S);
Break;
end;
end;
Parsed.Add(S);
if Length(STemp) = 0 then
Break;
Delete(STemp, 1, 1);
until False;
end;

function TDiskIO.DIRPath(Path: String;
var DIR: PDIR_Entry;
var Entries: Longint): Boolean;
var St: TStrings;
S: String;
I: Longint;
J: Longint;
D, D1: PDIR_Entry;
DD: TDIR_Entry;
L: Longint;
B: Boolean;
begin
Result := False;
St := TStringList.Create;
ParseFileName(Path, St);
if St.Count = 0 then
begin
St.Free;
Exit;
end;
Drive := St.Strings[0][1];
if FFileSystem = fsNone then
begin
St.Free;
Exit;
end;
if FFAT = NIL then
begin
St.Free;
Exit;
end;
if FFATSize = 0 then
begin
St.Free;
Exit;
end;
if not ReadRootDIR(D, L) then
begin
St.Free;
Exit;
end;
if St.Count = 1 then
begin
DIR := D;
Entries := L;
Result := True;
St.Free;
Exit;
end;
for J := 1 to St.Count-1do
begin
B := False;
D1 := D;
S := St.Strings[J];
for I := 1 to Ldo
if D1^.Name = S then
begin
B := True;
Break;
end else
Inc(Longint(D1), SizeOf(TDIR_Entry));
if not B then
begin
St.Free;
FreeMem(D);
Exit;
end;
DD := D1^;
FreeMem(D);
if DD.FileSize <> 0 then
begin
Result := True;
Entries := 1;
GetMem(DIR, SizeOf(TDIR_Entry));
DIR^ := DD;
St.Free;
Exit;
end;
if not ReadOtherDIR(DD.StartCluster, D, L) then
begin
St.Free;
Exit;
end;
end;
Result := True;
St.Free;
Entries := L;
DIR := D;
end;

function TDiskIO.ExtractDIREntry(Path: String;
var DIR: TDIR_Entry): Boolean;
var St: TStrings;
S: String;
I: Longint;
J: Longint;
D, D1: PDIR_Entry;
DD: TDIR_Entry;
L: Longint;
B: Boolean;
begin
Result := False;
St := TStringList.Create;
ParseFileName(Path, St);
if St.Count < 2 then
begin
St.Free;
Exit;
end;
Drive := St.Strings[0][1];
if FFileSystem = fsNone then
begin
St.Free;
Exit;
end;
if FFAT = NIL then
begin
St.Free;
Exit;
end;
if FFATSize = 0 then
begin
St.Free;
Exit;
end;
if not ReadRootDIR(D, L) then
begin
St.Free;
Exit;
end;
for J := 1 to St.Count-1do
begin
B := False;
D1 := D;
S := St.Strings[J];
for I := 1 to Ldo
if D1^.Name = S then
begin
B := True;
Break;
end else
Inc(Longint(D1), SizeOf(TDIR_Entry));
if not B then
begin
St.Free;
FreeMem(D);
Exit;
end;
DD := D1^;
FreeMem(D);
if J = St.Count-1 then
begin
Result := True;
DIR := DD;
St.Free;
Exit;
end;
if not ReadOtherDIR(DD.StartCluster, D, L) then
begin
St.Free;
Exit;
end;
end;
end;

end.

TO：wenjinshan
你的代碼可以實現int13的功能嗎？為什麼D_IOCTL找不到!

自己做打包安裝程序就可實現,何必這麼麻煩.