unit RawRead;
interface
uses
Windows, Math, Forms, Dialogs, SysUtils;
const
FILE_READ_ATTRIBUTES = $80;
FSCTL_GET_RETRIEVAL_POINTERS = 589939; //(($00000009) shr 16) or ((28) shr 14) or ((3) shr 2) or (0);
type
ULONGLONG = ULONG;
PULONGLONG = ^ULONGLONG;
TClusters = array of LONGLONG;
STARTING_VCN_INPUT_BUFFER = record
StartingVcn: LARGE_INTEGER;
end;
PSTARTING_VCN_INPUT_BUFFER = ^STARTING_VCN_INPUT_BUFFER;
Extents = record
NextVcn: LARGE_INTEGER;
Lcn: LARGE_INTEGER;
end;
RETRIEVAL_POINTERS_BUFFER = record
ExtentCount: DWORD;
StartingVcn: LARGE_INTEGER;
Extents: array[0..0] of Extents;
end;
PRETRIEVAL_POINTERS_BUFFER = ^RETRIEVAL_POINTERS_BUFFER;
Function FileCopyEx(lpSrcName: PChar; lpDstName: PChar; var Progress: DWORD): Boolean;
implementation
function GetFileClusters(lpFileName: PChar; ClusterSize: Int64; ClCount: PInt64; var FileSize: Int64): TClusters;
var
hFile: THandle;
OutSize: ULONG;
Bytes, Cls, CnCount, r: ULONG;
Clusters: TClusters;
PrevVCN, lcn: LARGE_INTEGER;
InBuf: STARTING_VCN_INPUT_BUFFER;
OutBuf: PRETRIEVAL_POINTERS_BUFFER;
begin
Clusters := nil;
hFile := CreateFile(lpFileName, FILE_READ_ATTRIBUTES,
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
nil, OPEN_EXISTING, 0, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
FileSize := GetFileSize(hFile, nil);
OutSize := SizeOf(RETRIEVAL_POINTERS_BUFFER) + (FileSize div ClusterSize) * SizeOf(OutBuf^.Extents);
GetMem(OutBuf, OutSize);
InBuf.StartingVcn.QuadPart := 0;
if (DeviceIoControl(hFile, FSCTL_GET_RETRIEVAL_POINTERS, @InBuf,
SizeOf(InBuf), OutBuf, OutSize, Bytes, nil)) then
begin
ClCount^ := (FileSize + ClusterSize - 1) div ClusterSize;
SetLength(Clusters, ClCount^);
PrevVCN := OutBuf^.StartingVcn;
Cls := 0;
r := 0;
while (r < OutBuf^.ExtentCount) do
begin
Lcn := OutBuf^.Extents[r].Lcn;
CnCount := ULONG(OutBuf^.Extents[r].NextVcn.QuadPart - PrevVCN.QuadPart);
while (CnCount > 0) do
begin
Clusters[Cls] := Lcn.QuadPart;
Dec(CnCount);
Inc(Cls);
Inc(Lcn.QuadPart);
end;
PrevVCN := OutBuf^.Extents[r].NextVcn;
Inc(r);
end;
end;
FreeMem(OutBuf);
CloseHandle(hFile);
end;
Result := Clusters;
end;
Function FileCopyEx(lpSrcName: PChar; lpDstName: PChar; var Progress: DWORD): Boolean;
var
FileSize, ClusterSize, BlockSize, FullSize, CopyedSize: Int64;
Clusters: TClusters;
r, ClCount: ULONG;
Bytes: ULONG;
hDrive, hFile: THandle;
SecPerCl, BtPerSec, FreeClusters, NumOfClusters: DWORD;
Buff: PByte;
Offset: LARGE_INTEGER;
Name: array[0..6] of Char;
begin
Result := False;
Progress := 0;
Name[0] := lpSrcName[0];
Name[1] := ':';
Name[2] := Char(0);
FreeClusters := 0;
NumOfClusters := 0;
GetDiskFreeSpace(Name, SecPerCl, BtPerSec, FreeClusters, NumOfClusters);
ClusterSize := SecPerCl * BtPerSec;
Clusters := GetFileClusters(lpSrcName, ClusterSize, @ClCount, FileSize);
FullSize := FileSize;
if (Clusters <> nil) then
begin
Name[0] := '\';
Name[1] := '\';
Name[2] := '.';
Name[3] := '\';
Name[4] := lpSrcName[0];
Name[5] := ':';
Name[6] := Char(0);
hDrive := CreateFile(Name, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if (hDrive <> INVALID_HANDLE_VALUE) then
begin
hFile := CreateFile(lpDstName, GENERIC_WRITE, 0, nil, CREATE_NEW, 0, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
GetMem(Buff, ClusterSize);
r := 0;
CopyedSize := 0;
while (r < ClCount) do
begin
Application.ProcessMessages;
Offset.QuadPart := ClusterSize * Clusters[r];
SetFilePointer(hDrive, Offset.LowPart, @Offset.HighPart, FILE_BEGIN);
ReadFile(hDrive, Buff^, ClusterSize, Bytes, nil);
BlockSize := Min(FileSize, ClusterSize);
WriteFile(hFile, Buff^, BlockSize, Bytes, nil);
CopyedSize := CopyedSize + BlockSize;
FileSize := FileSize - BlockSize;
if FullSize <> 0 then
Progress := Round (CopyedSize*100 / FullSize)
else
Progress := 100 ;
Inc(r);
end;
FreeMem(Buff);
CloseHandle(hFile);
Progress := 100 ;
Result := True;
end;
CloseHandle(hDrive);
end;
Clusters := nil;
end;
end;
end.
评论