NTFSファイル圧縮機能を利用する(2)

NTFSで使用することができるファイル圧縮機能をプログラムから利用する方法の第二弾です。
ファイル/フォルダの圧縮属性をセット/リセットするにはCreateFileでファイル/フォルダをオープンし、DeviceIoControlでFSCTL_SET_COMPRESSIONを指定します。

uses
  Windows, SysUtils;

type
  { Compress operation }
  TCompressOperation = (coCompress, coDecompress);

const
  FSCTL_SET_COMPRESSION      = $0009C040;
  COMPRESSION_FORMAT_NONE    = $00000000;
  COMPRESSION_FORMAT_DEFAULT = $00000001;

procedure InternalCompressFile(const Filename: String;
                               Operation: TCompressOperation;
                               Attr: DWORD); forward;
function  NeedChangeCompression(Operation: TCompressOperation;
                                Attr: DWORD): Boolean; forward;

{$WARN SYMBOL_PLATFORM OFF}

procedure CompressFile(const Filename: String; Operation: TCompressOperation);
var
  Attr: DWORD;
begin

  if VolumeCanCompress(Filename) = False then
  begin
    { This volume is not support compression }
    Exit;
  end;

  { Get file attributes }
  Attr := GetFileAttributes(PChar(Filename));
  if Attr = $FFFFFFFF then
  begin
    RaiseLastOSError;
  end;

  if NeedChangeCompression(Operation,Attr) = True then
  begin
    { Compress or decompress }
    InternalCompressFile(Filename,Operation,Attr);
  end;

end;

procedure InternalCompressFile(const Filename: String;
                               Operation: TCompressOperation;
                               Attr: DWORD);
const
  CompressionFormat: array [TCompressOperation] of DWORD =
                       (COMPRESSION_FORMAT_DEFAULT,  // Compress by default format
                        COMPRESSION_FORMAT_NONE);    // Decompress
var
  Handle: THandle;
  InBuffer: DWORD;
  BytesReturned: DWORD;
  Access: DWORD;
  Flags: DWORD;
begin

  { Flags for CreateFile }
  Access := GENERIC_READ or GENERIC_WRITE;
  if (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0 then
  begin
    Flags  := FILE_ATTRIBUTE_NORMAL;
  end
  else
  begin
    Flags  := FILE_FLAG_BACKUP_SEMANTICS;
  end;

  { Reset read-only attribute }
  if (Attr and FILE_ATTRIBUTE_READONLY) <> 0 then
  begin
    SetFileAttributes(PChar(Filename),Attr and not FILE_ATTRIBUTE_READONLY);
  end;

  try
    { Open file or directory }
    Handle := CreateFile(PChar(Filename),Access,0,nil,OPEN_EXISTING,Flags,0);
    if Handle = INVALID_HANDLE_VALUE then
    begin
      RaiseLastOSError;
    end;

    try
      { Compress or decompress }
      InBuffer := CompressionFormat[Operation];
      Win32Check(DeviceIoControl(Handle,FSCTL_SET_COMPRESSION,
                                 @InBuffer,SizeOf(InBuffer),
                                 nil,0,BytesReturned,nil));

    finally
      { Close }
      CloseHandle(Handle);
    end;

  finally
    { Restore read-only attribute }
    if (Attr and FILE_ATTRIBUTE_READONLY) <> 0 then
    begin
      SetFileAttributes(PChar(Filename),
                        GetFileAttributes(PChar(Filename)) or
                        FILE_ATTRIBUTE_READONLY);
    end;
  end;

end;

function NeedChangeCompression(Operation: TCompressOperation;
                               Attr: DWORD): Boolean;
begin

  Result := ((Ord(Operation) xor
              Ord((Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0)) = 0);

end;

{$WARN SYMBOL_PLATFORM ON}

ファイル/フォルダをオープンするときはCreateFileでdwDesiredAccessにGENERIC_READ or GENERIC_WRITEを、dwCreationDispositionにOPEN_EXISTINGを、それぞれ指定する必要があります。また対象がフォルダのときはdwFlagsAndAttributesにFILE_FLAG_BACKUP_SEMANTICSを指定します。さらにファイル/フォルダの属性に書込禁止(FILE_ATTRIBUTE_READONLY)が含まれている場合はSetFileAttributesで一時的に解除する必要もあります。
元ねたはNTFSの圧縮機能 - HEROPA's HomePageやサンプルプログラム集　ファイルの圧縮属性の変更あたり。