DiskRead 读取占用的文件。



unit DiskRead;

interface

uses
  Windows, SysUtils, Forms, Dialogs, Math;

const
  FILE_READ_ATTRIBUTES = $80;
  FSCTL_GET_RETRIEVAL_POINTERS = 589939;

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 DiskFileCopy(lpSrcName: PChar; lpDstName: PChar): 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 DiskFileCopy(lpSrcName: PChar; lpDstName: PChar): 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;
  Progress: DWORD;
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

          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.