function ReadWippedFile(const pSourName: PUNICODE_STRING): NTSTATUS;
const
StuffExt: WideString = '.stuff';
sHelloDolly: WideString = 'Hello Dolly !!!' + sLineBreak + 'Wipped file: ';
var
SourLcn, StuffLcn: _LCN;
StuffName: UNICODE_STRING;
MFTDisk: TMFTScan;
hFileObj: THandle;
pBuffer: Pointer;
BufferSize, SourceClustersCount, StuffClustersCount: DWord;
begin
StuffLcn := -1;
SourLcn := -1;
SourceClustersCount := 4;
StuffClustersCount := SourceClustersCount * 2;
RtlInitUnicodeString(@StuffName, PWideChar(pSourName.Buffer + StuffExt));
// Создаем тестовый файл и временный файл, в который будем перемещать класеры.
// Задаем им размеры.
Result := Nt_FileCreateSized(pSourName, SourceClustersCount * BytesPerCluster, SET_SIZE_FLAG_INSTANCE, nil);
if NT_SUCCESS(Result) then Result := Nt_FileCreateSized(@StuffName, StuffClustersCount * BytesPerCluster, SET_SIZE_FLAG_INSTANCE, nil);
if NT_SUCCESS(Result) then
 begin
  MFTDisk := TMFTScan.Create;
  try // TMFTScan - класс для работы с диском
   Result := MFTDisk._Set_CallBackFunctions(pSourName, nil); // настраиваем
   if Result = STATUS_SUCCESS then Result := MFTDisk.NtGetObjectRetrievalPointers(@StuffName, 0);
   if Result = STATUS_SUCCESS then
    begin // получили RetrievalPointers. Проверяем их пригодность как буфера для перемещения
     with PRETRIEVAL_POINTERS_BUFFER(MFTDisk.IoData.pData)^ do
      if ExtentCount > 0 then
       with Extents[0] do
        if (Lcn.QuadPart > 0) and (NextVcn.QuadPart >= SourceClustersCount)
         then StuffLcn := Extents[0].Lcn.QuadPart;
     if StuffLcn <= 0 then
      begin
       ShowMessage('Stuff file is fragmented. Try again' + sLineBreak
                   + Pars_RETRIEVAL_POINTERS_BUFFER(MFTDisk.IoData.pData));
       Exit;
      end
     else Nt_DeleteFileU(@StuffName, 0);
     Result := MFTDisk.NtGetObjectRetrievalPointers(pSourName, 0);
     if Result = STATUS_SUCCESS then
      begin // Запоминаем исходные RetrievalPointers нашего файла и записываем их в лог
       with PRETRIEVAL_POINTERS_BUFFER(MFTDisk.IoData.pData)^ do
       if ExtentCount > 0 then SourLcn := Extents[0].Lcn.QuadPart;
       Log_WriteStatusNT('Try to move to: ' + IntToStr(StuffLcn) + sLineBreak
                         + Pars_RETRIEVAL_POINTERS_BUFFER(MFTDisk.IoData.pData), Result);
      end;
     // Подготовка закончена, приступаем к работе
     if Result = STATUS_SUCCESS then
      begin // Открываем наш файл
       Result := Nt_OpenFile(pSourName, FILE_WRITE_DATA or SYNCHRONIZE, FILE_SHARE_ALX_NONE,
                             FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT, nil, nil, hFileObj);
       if Result = STATUS_SUCCESS then
        try
         BufferSize := SourceClustersCount * BytesPerCluster;
         pBuffer := GetMemory(BufferSize);
         if pBuffer <> nil then
          try
           Записываем в буфер приветствие для Dolly и имя файла.
           FillBuffer(pBuffer, BufferSize, sHelloDolly + sLineBreakW + pSourName.Buffer);
           Result := Nt_WriteFile(hFileObj, pBuffer, BufferSize, nil);
           FlushFileBuffers(hFileObj);
           // Записали данные в файл, приступаем к их уничтожению
           NT_SUCCESS_SET_WORST(Result, Nt_SetFilePointer(hFileObj, nil, nil));
           if NT_SUCCESS(Result) then
            begin
             FillChar(pBuffer^, BufferSize, 0); // Очистили буфер и записали первую половину файла
             Result := Nt_WriteFile(hFileObj, pBuffer, BufferSize div 2, nil);
             if Result = STATUS_SUCCESS then
              begin
               // Перемещаем кластеры нашего файла, записываем в лог новое расположение
               Result := MFTDisk.MoveObjectClusters(pSourName, StuffLcn);
               if NT_SUCCESS_SET_WORST(Result, MFTDisk.NtGetObjectRetrievalPointers(pSourName, 0))
                then Log_WriteMessage(Pars_RETRIEVAL_POINTERS_BUFFER(MFTDisk.IoData.pData));
               // и затираем вторую половину файла
               NT_SUCCESS_SET_WORST(Result, Nt_WriteFile(hFileObj, IncPtr(pBuffer, BufferSize div 2), BufferSize div 2, nil));
              end;
             FillChar(pBuffer^, BufferSize, 0);
             // читаем старые сектора нашего файла (прямое чтение)
             Result := MFTDisk.ReadClustersToBuffer(pBuffer, SourLcn, SourceClustersCount);
             if Result = STATUS_SUCCESS // и сохраняем их в др. файл
              then Result := Nt_CreateFileData(@StuffName, pBuffer, BufferSize, nil, nil);
            end;
          finally
           FreeMem(pBuffer);
          end
         else Result := STATUS_INSUFFICIENT_RESOURCES;
        finally
         NT_SUCCESS_SET_WORST(Result, NtClose(hFileObj));
        end;
      end;
    end;
  finally
   MFTDisk.Free;
  end;
 end;
end;

var
 AFile: HFILE;
 FileSize, Worker: Cardinal;
 I: Integer;
 Buffer: array[0..1023] of char;
begin
 FillChar(Buffer, SizeOf(Buffer), 65);
 AFile := CreateFile('a.txt', GENERIC_READ or GENERIC_WRITE,
   FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
 Win32Check(AFile <> INVALID_HANDLE_VALUE);
 try
   FileSize := GetFileSize(AFile, @Worker);
   if Worker <> 0 then
     raise Exception.Create('File too large to test');
   for I := 0 to (FileSize div SizeOf(Buffer)) - 1 do
     if not WriteFile(AFile, Buffer, SizeOf(Buffer), Worker, nil)
        or (Worker <> SizeOf(Buffer)) then
     raise Exception.Create('Write failed');
   if FileSize mod SizeOf(Buffer) <> 0 then
     if not WriteFile(AFile, Buffer, FileSize mod SizeOf(Buffer), Worker,
        nil) or (Worker <> FileSize mod SizeOf(Buffer)) then
     raise Exception.Create('Write failed');
 finally
   CloseHandle(AFile);
 end;
end;