اينم سورس فرمت كردن با دلفي

type
TDiocRegisters = record
EBX, EDX, ECX, EAX, EDI, ESI, Flags: DWORD;
end;
TVWin32CtlCode = (ccNone, ccVWin32IntIoctl, ccVWin32Int26,
ccVWin32Int25, ccVWin32Int13);
TBiosParamBlock = packed record
BytesPerSector: Word;
SectorsPerCluster: Byte;
ReservedSectors: Word;
NumFats: Byte;
NumRootEntries: Word;
NumSectors: Word;
MediaID: Byte;
SectorsPerFat: Word;
SectorsPerTrack: Word;
NumHeads: Word;
HiddenSectors: Word;
Dummy1: Word;
TotalSectors: LongInt;
Dummy2: array[0..5] of Byte;
end;
TDeviceParamBlock = packed record
Special: Byte;
DeviceType: Byte;
DeviceAttr: Word;
NumCylinders: Word;
MediaType: Byte;
BiosParamBlock: TBiosParamBlock;
end;
TFormatParamBlock = packed record
Reserved: Byte;
Head: Word;
Cylinder: Word;
end;
function VWin32(CtlCode: TVWin32CtlCode; var Regs: TDiocRegisters): Boolean;
var
hDevice: THandle;
Count: DWORD;
begin
hDevice := CreateFile('\\.\VWIN32', 0, 0, nil, 0,
FILE_FLAG_DELETE_ON_CLOSE, 0);
Result := DeviceIoControl(hDevice, Ord(CtlCode), @Regs, SizeOf(Regs), @Regs, SizeOf(Regs), Count, nil);
CloseHandle(hDevice);
end;
function GetDeviceParamBlock(Drive: Char;
var ParamBlock: TDeviceParamBlock): Word;
var
Regs: TDiocRegisters;
begin
with Regs do
begin
EAX := $440D;
EBX := Ord(UpCase(Drive)) - Ord('@');
ECX := $0860;
EDX := LongInt(@ParamBlock);
VWin32(ccVWin32IntIoctl, Regs);
if (Flags and 1) <> 0 then
Result := LoWord(EAX)
else
Result := 0;
end;
end;
function SetDeviceParamBlock(Drive: Char;
var ParamBlock: TDeviceParamBlock): Word;
var
Regs: TDiocRegisters;
begin
with Regs do
begin
EAX := $440D;
EBX := Ord(UpCase(Drive)) - Ord('@');
ECX := $0840;
EDX := LongInt(@ParamBlock);
VWin32(ccVWin32IntIoctl, Regs);
if (Flags and 1) <> 0 then
Result := LoWord(EAX)
else
Result := 0;
end;
end;
function FormatTrack(Drive: Char;
var ParamBlock: TFormatParamBlock): Word;
var
Regs: TDiocRegisters;
begin
with Regs do
begin
EAX := $440D;
EBX := Ord(UpCase(Drive)) - Ord('@');
ECX := $0842;
EDX := LongInt(@ParamBlock);
VWin32(ccVWin32IntIoctl, Regs);
if (Flags and 1) <> 0 then
Result := LoWord(EAX)
else
Result := 0;
end;
end;