[ 750_ファイルの圧縮属性の変更 ]

Delphi Programming / Object Pascal

[掲載 2007年04月01日] [更新 2016年09月28日]　Delphi サンプルプログラム集

750_ファイルの圧縮属性の変更
動作確認等	Windows 7 U64(SP1) + Delphi XE Pro

750_CompressFile.zip　[1,643 KB]　2016年09月28日版 (EXE 同梱)

ファイルの圧縮属性の変更
01_DeviceIOControl 関数を使用したファイルの圧縮属性の変更
02_WMI を使用したファイルの圧縮属性の変更
03_ファイルが圧縮属性かを調べる

2013年10月19日
WMI を使用したサンプルを追加

ファイルの圧縮属性の変更

ここまでのページで「圧縮」というのが続きました．こちらも同じ圧縮ですが，下図のような，ファイルのプロパティで設定する，圧縮属性の変更のプログラムです．

図1
ファイルの圧縮属性

ファイルのプロパティダイアログで，[詳細設定] [内容を圧縮してディスク容量を節約する] の状態を変更する

01_DeviceIOControl 関数を使用したファイルの圧縮属性の変更

このサンプルで使用している DeviceIoControl 関数は，その名の通り，CD のイジェクトの操作等，デバイスドライバの制御や情報の取得，操作にも使用されています．ネット上を検索すると，面白いサンプルが見つかるかも知れません．

	図2 設計時画面ボタンが2つだけ対象はプロジェクトフォルダ内の AAA.TXT
	図3 実行結果

リスト1
DeviceIOControl 関数を使用して，ファイルの圧縮属性を変更

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    FileName : String;
    function SetCompressAttribute(AFileName: String; Flag: Word): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  操作対象ファイルを決める
//  このプロジェクト内のAAA.txtというファイル
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  FileName := ExtractFilePath(Application.ExeName) + 'AAA.txt';
end;

//=============================================================================
//  圧縮するボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  CompressFlag : Word;
Begin
  CompressFlag := 1;

  if SetCompressAttribute(FileName, CompressFlag) then begin
    Application.MessageBox('圧縮しました', '圧縮操作')
  end else begin
    Application.MessageBox('圧縮に失敗しました', '圧縮操作')
  end;
end;

//=============================================================================
//  圧縮解除ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  CompressFlag : Word;
begin
  CompressFlag := 0;

  if SetCompressAttribute(Filename, CompressFlag) then begin
    Application.MessageBox('圧縮を解除しました', '圧縮解除操作')
  end else begin
    Application.MessageBox('圧縮の解除に失敗しました', '圧縮解除操作')
  end;
end;

//=============================================================================
// ファイルの圧縮，非圧縮を実行するメソッド
// Flag=1の時圧縮,0の時圧縮解除
//=============================================================================
function TForm1.SetCompressAttribute(AFileName:String; Flag: Word): Boolean;
var
  hFile    : THandle;
  iTemp    : Cardinal;
  bSuccess : Boolean;
begin
  Result := True;
  hFile := CreateFile(PChar(AFileName),
                     GENERIC_READ or GENERIC_WRITE,
                     0,
                     nil,
                     OPEN_EXISTING,
                     0,
                     0);
  If hFile = INVALID_HANDLE_VALUE then begin
    RaiseLastWin32Error;
    Result := False;
    exit;
  end;

  bSuccess := DeviceIOControl(hFile,
                              FSCTL_SET_COMPRESSION,
                              @Flag,
                              SizeOf(Flag),
                              nil,
                              0,
                              iTemp,
                              nil);
  If (not bSuccess) then begin
    RaiseLastWin32Error;
    Result := False;
  end;

  CloseHandle(hFile);
end;

end.

02_WMI を使用したファイルの圧縮属性の変更

WMI の CIM_DataFile クラスを使用したサンプルです．
このクラスの Compress メソッドと Uncompress メソッドを使用しています．CIM_DataFile クラスではこの他にセキュリティ関係，所有者の設定が可能です．また，ファイルのコピー，削除，名前の変更等のメソッドもあります．

ファイル名はフルパスの文字列で指定しています．クエリ (SQL) 文の中に文字列を含める時は，ダブルクォーテーションが囲みます．また，パスの区切り文字 (デリミタ) は，\ ではなく \\ のように 2 つ必要です．例えば D:\000\ABC.doc は D:\\000\\ABC.doc のようにします．
クエリを実行すると，指定したファイルオブジェクトのインスタンスのセットが取得できます．そのセットから取り出しますが，このサンプルの場合は，1 つだけです．while ループ内の処理は 1 回しか実行されません．

CIM_DataFile クラスでは，検索条件に，ドライブ名，パス名，ディレクトリ部，拡張子を個別に指定することができます．ドライブ名，ディレクトリ部だけを指定したクエリを実行すると，そのディレクトリ内のファイル数分のオブジェクトを取得することになり，while のループがそのファイルの数分だけ繰り返し実行されることになります．

実行結果は，上のサンプルと全く同じです．

図4
設計時画面

リスト2
WMI の CIM_DataFile クラスを使用して，ファイルの圧縮属性を変更

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    FileName       : String;
    FobjWMILocator : OleVariant;
    FobjWMIService : OleVariant;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj, ActiveX;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  操作対象ファイルを決める
//  WMIのオブジェクトのインスタンスを生成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  FileName := ExtractFilePath(Application.ExeName) + 'AAA.txt';

  FObjWMILocator := CreateOleObject('WbemScripting.SWbemLocator');
  FObjWMIService := FObjWMILocator.ConnectServer('', 'root\CIMV2');
end;

//=============================================================================
//  圧縮するボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FilePath       : String;
  strSQL         : String;
  objPropSet     : OleVariant;
  objPropSetEnum : IEnumVariant;
  objTemp        : OleVariant;
  iValue         : LongWord;
  iRet           : Integer;
begin
  FilePath := StringReplace(FileName, '\', '\\', [rfReplaceAll]);
  FilePath := AnsiQuotedStr(FilePath, '"');

  //クエリ文を作成して実行
  strSQL := 'SELECT * FROM CIM_DataFile WHERE NAME = ' + FilePath;
  objPropSet := FobjWMIService.ExecQuery(strSQL, 'WQL');

  objPropSetEnum := IUnknown(objPropSet._NewEnum) as IEnumVariant;

  //-------------------------------------------------------------------------
  //  以下がメソッドの実行関係
  //-------------------------------------------------------------------------
  iRet := -1;
  while objPropSetEnum.Next(1, objTemp, iValue) = 0 do begin
    iRet := objTemp.Compress;
  end;

  if (iRet = 0) then begin
    Application.MessageBox('圧縮しました', '圧縮操作');
  end else begin
    Application.MessageBox('圧縮に失敗しました', '圧縮操作');
  end;
end;

//=============================================================================
//  圧縮解除ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  FilePath       : String;
  strSQL         : String;
  objPropSet     : OleVariant;
  objPropSetEnum : IEnumVariant;
  objTemp        : OleVariant;
  iValue         : LongWord;
  iRet           : Integer;
begin
  FilePath := StringReplace(FileName, '\', '\\', [rfReplaceAll]);
  FilePath := AnsiQuotedStr(FilePath, '"');

  //クエリ文を作成して実行
  strSQL := 'SELECT * FROM CIM_DataFile WHERE NAME = ' + FilePath;
  objPropSet := FobjWMIService.ExecQuery(strSQL, 'WQL');

  objPropSetEnum := IUnknown(objPropSet._NewEnum) as IEnumVariant;

  //-------------------------------------------------------------------------
  //  以下がメソッドの実行関係
  //-------------------------------------------------------------------------
  iRet := -1;
  while objPropSetEnum.Next(1, objTemp, iValue) = 0 do begin
    iRet := objTemp.Uncompress;
  end;

  if (iRet = 0) then begin
    Application.MessageBox('圧縮を解除しました', '圧縮操作');
  end else begin
    Application.MessageBox('圧縮の解除に失敗しました', '圧縮操作');
  end;
end;

end.

03_ファイルが圧縮属性かを調べる

ファイルが圧縮属性になっているかは，DeviceIoControl 関数の制御コードに FSCTL_GET_COMPRESSION を指定すれば取得できますが，ファイルの属性からも知ることができます．
ファイルの他のプロパティを取得する必要がなければ，GetFileAttributes 関数で属性だけを取得することができます．属性に FILE_ATTRIBUTE_COMPRESSED が含まれていれば圧縮属性です．

本サンプルでは，ファイルサイズの取得に GetCompressedFileSize 関数を使用しています．この関数は圧縮属性のファイルの場合，圧縮したサイズの取得となります．圧縮していない状態での値が必要な場合は，他の関数でファイルサイズを取得します．
下図は，同じファイルに対して圧縮属性を設定する前と，設定した時の違いを示しています．

	図5 圧縮属性を設定する前
	図6 圧縮属性にした結果

リスト3
圧縮属性のファイルかどうかを調べるサンプル

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  OpenDialog1.InitialDir := ExpandFileName('..\');
end;

//=============================================================================
//  ファイルの圧縮属性を調べる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName     : string;
  LAttributes   : Cardinal;
  LFileSizeHigh : UInt64;
  LFileSizeLow  : UInt64;
  LFileSize     : UInt64;
begin
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

  OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);
  LabeledEdit1.Text := '';
  LabeledEdit2.Text := '';

  //選択したファイル名
  LFileName := OpenDialog1.FileName;
  LabeledEdit1.Text := LFileName;
  LabeledEdit1.SelStart := Length(LabeledEdit1.Text);

  //ファイルが圧縮属性かを調べる
  LAttributes := GetFileAttributes(PChar(LFileName));
  CheckBox1.Checked := (LAttributes and FILE_ATTRIBUTE_COMPRESSED) <> 0;

  //ファイルサイズを取得
  //ファイルサイズの上位と下位のDWORD値(32ビット)を取得
  //上位DWORDは引数から取得.下位DWOODは関数の戻り値から取得
  LFileSizeLow := GetCompressedFileSize(PChar(LFileName), @LFileSizeHigh);
  LFileSize := LFileSizeHigh shl 32 + LFileSizeLow;

  //ファイルサイズを表示
  LabeledEdit2.Text := FormatFloat('##,##0 バイト', LFileSize);
end;

end.