Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2007年04月01日] [更新 2016年10月01日]　Delphi サンプルプログラム集
780_ファイル情報の取得と日時・属性の変更等
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
780_FileInfoListETC.zip　[8,732 KB]　2016年10月01日版 (EXE 同梱)



  • 2013年02月16日
  • コードの整備と，Windows 7 U64(SP1) + Delphi XE Pro での動作確認
    Delphi 2007 以前でも最小限の変更で利用可能なコードとした
  • 2016年09月28日
  • ディスク上のファイルサイズを取得するサンプルを追加



ファイル情報の取得とファイルの日付，属性の変更等


ファイルの情報，指定フォルダ内のファイルリストを取得したり，フォルダ内のファイルの合計サイズを取得するサンプルプログムです．ファイルの日時や属性を変更するコードもテストしてみました．

Delphi 2010 以降で，同様の操作をするためのコードは，[817_ディレクトリとファイルのリスト] の記事を参考にしてください．



ファイルのサイズだけを取得するのであれば，GetFileSizeEx, TFileStream を使用しても取得できます．あるいは TMemoryStream に呼び込めば，その TMemoryStream のサイズから取得できます．
以下の記事を参考にしてください．
また，上のリンクの uIOUtilsEx を使用すると TFile.GetSize で簡単に取得できます．


ファイルの更新日時の取得だけであれば，以下のように FileAge 関数か TFile.GetLastWriteTime メソッドを使用した方法が最も簡単ではないかと思われます．


[備考]
下のコードで使用している DateTimeToStr 関数は，ミリ秒の値は取得しません．また，時刻の値が 0 の時は，時刻は表示しません．
FileGetDate と FileDateToDateTime を使用するコードで取得する値は，ミリ秒の値が 0 となるだけでなく，1 ～ 2 数秒程度の誤差を伴うことがあります．おそらく，ファイルのタイムスタンプにミリ秒の値が存在する時にこの現象が発生するのではないかと思われますが，詳細は不明です．このことが確認できるように，参考としてコードを掲載しておきます．
実務で FileGetDate と FileDateToDateTime を使用するのは避けた方が無難と思われます．



図1
ファイルの更新日時の取得結果
  • 以下の関数類を使用した結果
    FileAge 関数
    FileGetDate 関数
    TFile.GetLastWriteTime メソッド

リスト1
ファイルの更新日時の取得		 
//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
end;

//=============================================================================
//  ファイルのタイムスタンプ(更新日時)の取得
//  System.SysUtils.FileAgeを使用する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath : String;
  LFileDate : TDateTime;
begin
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

  OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);


  LFilePath := OpenDialog1.FileName;

  if FileAge(LFilePath, LFileDate, True) then begin
    ShowMessage(DateTimeToStr(LFileDate));
  end;
end;
//=============================================================================
//  ファイルのタイムスタンプ(更新日時)の取得
//  IOUtils.TFile.GetLastWriteTime メソッドを使用する例
//
//  usesにIOUtilsが必要(Delphi 2010以降)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFilePath : String;
  LFileDate : TDateTime;
begin
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

  OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);


  LFilePath := OpenDialog1.FileName;

  LFileDate := IOUtils.TFile.GetLastWriteTime(LFilePath);
  ShowMessage(DateTimeToStr(LFileDate));
end;

//=============================================================================
//  ファイルのタイムスタンプ(更新日時)の取得
//  System.SysUtils.FileGetDateを使用する例
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LFilePath  : String;
  LHandle    : Integer;
  LFileiDate : Integer;
  LFileDate  : TDateTime;
begin
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

  OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);


  LFilePath := OpenDialog1.FileName;

  LHandle := FileOpen(LFilePath, fmOpenRead);
  try
    LFileiDate :=  FileGetDate(LHandle);
    LFileDate  :=  FileDateToDateTime(LFileiDate);
    ShowMessage(DateTimeToStr(LFileDate));
  finally
    FileClose(LHandle);
  end;
end;



01_指定ファイルの情報取得 ( SHGetFileInfo を使用 )


シェル関数の SHGetFileInfo を使用した例です．
ファイルのハンドルを CreateFile で取得し，このハンドルを使用して，GetFileTime 関数でファイルの作成日時等の情報を取得します．このサンプルのコードでは，フォルダの情報は，フォルダ名以外は取得できません．


図2
設計時画面
図3
ファイルの選択
  • ファイル選択ダイアログで，情報を取得したいファイルを選択
図4
実行結果

リスト2
指定ファイルの情報を取得 (SHGetFileInfo 使用) 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    OpenDialog1: TOpenDialog;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    LabeledEdit5: TLabeledEdit;
    LabeledEdit6: TLabeledEdit;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    function FileTimeToDateTime(ATime: TFileTime): TDateTime;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  ShellApi;

{$R *.dfm}

//=============================================================================
//  ファイルを選択して情報取得
//  SHGetFileInfoを使用した例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
   LFileInfo   : TSHFileInfo;
   LFileName   : String;
   LFileHandle : THandle;
   LAttributes : Integer;
   LDateTime   : TDateTime;
   LCreateTime : TFileTime;
   LAccessTime : TFileTime;
   LModifyTime : TFileTime;
   LIcon       : TIcon;
begin
  OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

  LabeledEdit1.Text := '';
  LabeledEdit2.Text := '';
  LabeledEdit3.Text := '';
  LabeledEdit4.Text := '';
  LabeledEdit5.Text := '';
  LabeledEdit6.Text := '';

  LFileName := OpenDialog1.FileName;

  //選択したファイル名
  LabeledEdit1.Text := LFileName;

  //表示名の取得
  SHGetFileInfo(PChar(LFileName), 0, LFileInfo, SizeOf(LFileInfo), SHGFI_DISPLAYNAME);
  LabeledEdit2.Text := LFileInfo.szDisplayName;

  //ファイル種別の取得
  SHGetFileInfo(PChar(LFileName), 0, LFileInfo, SizeOf(LFileInfo), SHGFI_TYPENAME);
  LabeledEdit3.Text := LFileInfo.szTypeName;

  //ファイルに関連づいたアイコンの取得
  LIcon := TIcon.Create;
  try
    SHGetFileInfo(PChar(LFileName),
                  FILE_ATTRIBUTE_DIRECTORY,
                  LFileInfo,
                  SizeOf(LFileInfo),
                  SHGFI_ICON);

    LIcon.Handle := LFileInfo.hIcon;
    Image1.Picture.Assign(LIcon);
  finally
    FreeAndNil(LIcon);
  end;

  // ファイル属性の取得
  LAttributes := GetFileAttributes(PChar(LFileName));

  CheckBox1.Checked := Bool(LAttributes and FILE_ATTRIBUTE_READONLY);
  CheckBox2.Checked := Bool(LAttributes and FILE_ATTRIBUTE_HIDDEN);
  CheckBox3.Checked := Bool(LAttributes and FILE_ATTRIBUTE_SYSTEM);
  CheckBox4.Checked := Bool(LAttributes and FILE_ATTRIBUTE_ARCHIVE);

  //ファイルハンドルを使用してファイルの日付関係の値を取得
  LFileHandle := Windows.CreateFile(PChar(LFileName),
                                    GENERIC_READ,
                                    0,
                                    nil,
                                    OPEN_ALWAYS,
                                    0,
                                    0);
  //フォルダの場合は失敗する
  if LFileHandle <> INVALID_HANDLE_VALUE then begin
    try
      // タイムスタンプを取得
      GetFileTime(LFileHandle, @LCreateTime, @LAccessTime, @LModifyTime);

      //作成日
      LDateTime := FileTimeToDateTime(LCreateTime);
      LabeledEdit4.Text := FormatDateTime('yyyy年mm月dd日 hh時nn分', LDateTime);
      //最終更新日
      LDateTime := FileTimeToDateTime(LModifyTime);
      LabeledEdit5.Text := FormatDateTime('yyyy年mm月dd日 hh時nn分', LDateTime);
      //最終アクセス日
      LDateTime:=FileTimeToDateTime(LAccessTime);
      LabeledEdit6.Text := FormatDateTime('yyyy年mm月dd日 hh時nn分', LDateTime);
    finally
      CloseHandle(LFileHandle);
    end;
  end;
end;

//=============================================================================
//  TFileTime型の値をDelphiのTDateTime型に変換する関数
//=============================================================================
function TForm1.FileTimeToDateTime(ATime: TFileTime): TDateTime;
var
  LSystemTime : TSystemTime;
  LTempTime   : TFileTime;
begin
  try
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(ATime, LTempTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(LTempTime, LSystemTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result := SystemTimeToDateTime(LSystemTime);
  except
    Result := 0;
  end;
end;

end.



02_指定ファイルの情報取得 ( FindFirst と SHGetFileInfo を使用 )


FindFirst 関数を用いた例です．ただし，ファイルのアイコンの取得には SHGetFileInfo 関数を使用しています．
FindFirst 関数で，該当ファイルの情報を，TSHFileInfo 構造体 (レコード型) に取得し，そこからファイルの属性と作成日時等を取得します．このサンプルは，上のサンプルと違い，フォルダの情報も取得できます．


図5
設計時画面
図6
実行結果

リスト3
指定ファイルの情報取得 (FindFirst 使用) 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    OpenDialog1: TOpenDialog;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    LabeledEdit5: TLabeledEdit;
    Image1: TImage;
    LabeledEdit6: TLabeledEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    function FileTimeToDateTime(ATime: TFileTime): TDateTime;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  ShellApi;

{$R *.dfm}

//=============================================================================
//  ファイルを選択して情報取得
//  FindFirstを使用した例(アイコンの取得にはSHGetFileInfoを使用)
//  フォルダの情報取得も可能
//
//  SHGetFileInfoにはusesにShellApiが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileInfo   : TSHFileInfo;
  LFileName   : String;
  LAttributes : Cardinal;
  LDateTime   : TDateTime;
  LFileSize   : Int64;
  LIcon       : TIcon;
  LSearchRec  : TSearchRec;
  LFileData   : TWin32FindData;
begin
  OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

  LabeledEdit1.Text := '';
  LabeledEdit2.Text := '';
  LabeledEdit4.Text := '';
  LabeledEdit5.Text := '';
  LabeledEdit6.Text := '';

  LFileName := OpenDialog1.FileName;

  //選択したファイル名
  LabeledEdit1.Text := LFileName;

  //ファイルに関連づいたアイコンの取得
  LIcon := TIcon.Create;
  try
    SHGetFileInfo(PChar(LFileName),
                  FILE_ATTRIBUTE_DIRECTORY,
                  LFileInfo,
                  SizeOf(LFileInfo),
                  SHGFI_ICON);

    LIcon.Handle := LFileInfo.hIcon;
    Image1.Picture.Assign(LIcon);
  finally
    FreeAndNil(LIcon);
  end;

  if FindFirst(LFileName, faAnyFile, LSearchRec) = 0 then begin
    //TWin32FindData構造体
    LFileData := LSearchRec.FindData;
    LabeledEdit2.Text := LSearchRec.Name;

    //ファイルまたフォルダの属性を取得
    LAttributes := LFileData.dwFileAttributes;

    CheckBox1.Checked := Bool(LAttributes and FILE_ATTRIBUTE_READONLY);
    CheckBox2.Checked := Bool(LAttributes and FILE_ATTRIBUTE_HIDDEN);
    CheckBox3.Checked := Bool(LAttributes and FILE_ATTRIBUTE_SYSTEM);
    CheckBox4.Checked := Bool(LAttributes and FILE_ATTRIBUTE_ARCHIVE);

    //作成日
    LDateTime := FileTimeToDateTime(LFileData.ftCreationTime);
    LabeledEdit3.Text := FormatDateTime('yyyy年mm月dd日 hh時nn分', LDateTime);
    //最終更新日
    LDateTime := FileTimeToDateTime(LFileData.ftLastWriteTime);
    LabeledEdit4.Text := FormatDateTime('yyyy年mm月dd日 hh時nn分', LDateTime);
    //最終アクセス日
    LDateTime := FileTimeToDateTime(LFileData.ftLastAccessTime);
    LabeledEdit5.Text := FormatDateTime('yyyy年mm月dd日 hh時nn分', LDateTime);

    //ファイルサイズ(TSearchRec.Size)
    LFileSize := LSearchRec.Size;
    LabeledEdit6.Text := FormatFloat('##,##0 バイト', LFileSize);
  end;

  FindClose(LSearchRec);
end;

//=============================================================================
//  TFileTime型の値をDelphiのTDateTime型に変換する関数
//=============================================================================
function TForm1.FileTimeToDateTime(ATime: TFileTime): TDateTime;
var
  LSystemTime : TSystemTime;
  LTempTime   : TFileTime;
begin
  try
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(ATime, LTempTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(LTempTime, LSystemTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result := SystemTimeToDateTime(LSystemTime);
  except
    Result := 0;
  end;
end;

end.



03_指定フォルダ内のファイルとフォルダの一覧を取得


findFirst と FindNext 関数を使用して，指定フォルダ内のファイルとフォルダの一覧を取得するサンプルプログラムです．
指定したフォルダ直下のものだけ取得して表示します．サブフォルダ内は検索しません．

このサンプルや，次のサンプルのようなコードで，フォルダやファイルのリストを取得できますが，ファイル数が多くなると表示に時間がかかるようになります．そのような場合は，仮想リストビュー方式を使用することになります．更に多くなる場合は，ファイルそのもののデータベース化ということになるでしょう．


図7
設計時画面
図8
フォルダを選択
  • ここでは，このプロジェクトのフォルダを選択
  • 本ページのサンプルでは，フォルダの指定用に，SelectDirectory を使用しているが，Delphi 2007 以上であれば，TFileOpenDialog の方がいいかも知れない
図9
実行結果
  • AAA, BBB, CCCはフォルダ

リスト4
指定フォルダ内のファイルとフォルダをリスト 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListView1: TListView;
    Panel2: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilesCount : Integer;
    procedure GetFilesList(APath: String; FileList: TStringList);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  指定フォルダ内のファイルとフォルダを表示
//  FFilesCountはファイル数(フォルダ数を含む)でグローバル変数
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileList : TStringList;
  LPath     : String;
  i         : Integer;
begin
  FFilesCount    := 0;
  Panel1.Caption := '';

  LPath := ExtractFileDir(Application.ExeName);

  //Delphi 2007より前には，最後の引数がない
  //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', SrcDir, [sdNewUI])
  //でダイアログを表示すると，指定したフォルダ位置までスクロールしてくれない
  if SelectDirectory('検索フォルダ指定', '', LPath, []) then begin
    LFileList := TStringList.Create;
    LFileList.Clear;
    ListView1.Items.Clear;
    try
      GetFilesList(LPath, LFileList);
      ListView1.Items.BeginUpdate;
      for i := 0 to LFileList.Count - 1 do begin
        ListView1.Items.Add.Caption := LFileList[i];
      end;
      ListView1.Items.EndUpdate;
    finally
      FreeAndNil(LFileList);
    end;
  end;
  Panel1.Caption := 'ファイル数 : ' + IntToStr(FFilesCount);
end;

//=============================================================================
//  APathで指定するフォルダ内の全てのファイルを検索するメソッド
//  サブフォルダ内は検索しない
//=============================================================================
procedure TForm1.GetFilesList(APath: String; FileList: TStringList);
var
  LSearchPath : String;
  LSearchRec  : TSearchRec;
begin
  LSearchPath:=IncludeTrailingPathDelimiter(APath) + '*.*';
  if FindFirst(LSearchPath, faAnyFile,LSearchRec) = 0 then begin
    repeat
      if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
        FileList.Add(LSearchRec.Name);
        Inc(FFilesCount);
      end;
    until FindNext(LSearchRec) <> 0;
    FindClose(LSearchRec);
  end;
end;

end.



04_指定フォルダ内 ( サブフォルダを含む ) のファイル一覧を取得


上のサンプルは，サブフォルダ内を検索しませんでしたが，こちらは，サブフォルダも含めて，指定フォルダ内のファイル全てをフルパスで表示します．
検索用の関数を再帰的に呼出すことで，サブフォルダも検索するようにしています．


図10
設計時画面
図11
実行結果
  • このプロジェクトのフォルダ内のファイル全て

リスト5
指定フォルダ内のファイルとフォルダをサブフォルダ内を含めて全てリスト 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListView1: TListView;
    Panel2: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilesCount : Integer;
    procedure GetFilesListAll(APath: String; FileList: TStringList);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  検索開始
//  FFilesCountはファイル数でグローバル変数
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileList : TStringList;
  LBasePath : String;
  i         : Integer;
begin
  FFilesCount    := 0;
  Panel1.Caption := '';

  LBasePath := ExtractFileDir(Application.ExeName);

  //Delphi 2007より前には，最後の引数がない
  //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', SrcDir, [sdNewUI])
  //でダイアログを表示すると，指定したフォルダ位置までスクロールしてくれない
  if SelectDirectory('検索フォルダ指定', '', LBasePath, []) then begin
    LFileList := TStringList.Create;
    try
      LBasePath := IncludeTrailingPathDelimiter(LBasePath);
      ListView1.Items.Clear;
      LFileList.Clear;
      GetFilesListAll(LBasePath, LFileList);

      ListView1.Items.BeginUpdate;
      for i := 0 to LFileList.Count - 1 do begin
        ListView1.Items.Add.Caption := LFileList[i];
      end;
      ListView1.Items.EndUpdate;
    finally
      FreeAndNil(LFileList);
    end;
  end;
  Panel1.Caption:='ファイル数 : ' + IntToStr(FFilesCount);
end;

//=============================================================================
//  APathで指定するフォルダ内の全てのファイルを検索するメソッド
//  サブフォルダ内も検索
//=============================================================================
procedure TForm1.GetFilesListAll(APath: String; FileList: TStringList);
var
  LSearchPath : String;
  LSearchRec  : TSearchRec;
begin
  if FindFirst(APath + '*.*', faAnyFile, LSearchRec) = 0 then begin
    repeat
      if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
        if LSearchRec.Attr = faDirectory then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath+LSearchRec.Name);

          //フォルダの場合は，この関数を再帰的に呼出して，そのフォルダ内を検索
          GetFilesListAll(LSearchPath, FileList);
        end else begin
          //LSearchRec.Nameだけにすればファイル名のみ
          FileList.Add(APath + LSearchRec.Name);
          Inc(FFilesCount);
        end;
      end;
    until FindNext(LSearchRec) <> 0;

    FindClose(LSearchRec);
  end;
end;

end.



05_指定フォルダ内の指定拡張子のファイルを取得


サブフォルダも含めて，指定フォルダ内の拡張子が doc のファイルを検索して表示します．


図12
設計時画面
図13
実行結果
  • このプロジェクトのフォルダ内を検索

リスト6
指定フォルダ内の指定拡張子のファイルのみリスト 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListView1: TListView;
    Panel2: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilesCount : Integer;
    procedure GetFilesListAllExt(APath, Ext: String; FileList: TStringList);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  拡張子が.docのファイルのみを検索
//  FFilesCountはファイル数でグローバル変数
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileList : TStringList;
  LBasePath : String;
  LFileExt  : String;
  i         : Integer;
begin
  FFilesCount     := 0;
  Panel1.Caption := '';

  LBasePath := ExtractFileDir(Application.ExeName);

  //Delphi 2007より前には，最後の引数がない
  //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', SrcDir, [sdNewUI])
  //でダイアログを表示すると，指定したフォルダ位置までスクロールしてくれない
  if SelectDirectory('検索フォルダ指定', '', LBasePath, []) then begin
    LBasePath := IncludeTrailingPathDelimiter(LBasePath);
    LFileExt  := '.doc';
    LFileList  := TStringList.Create;
    LFileList.Clear;
    ListView1.Items.Clear;
    try
      GetFilesListAllExt(LBasePath, LFileExt, LFileList);
      ListView1.Items.BeginUpdate;
      ListView1.Columns[0].Width := 500;

      for i := 0 to LFileList.Count - 1 do begin
        ListView1.Items.Add.Caption := LFileList[i];
      end;
      ListView1.Items.EndUpdate;
    finally
      FreeAndNil(LFileList);
    end;
  end;
  Panel1.Caption := 'ファイル数 : ' + IntToStr(FFilesCount);
end;

//=============================================================================
//  APathで指定するフォルダ内の全てのファイルの中から拡張子がExtのファイルを検
//  索するメソッド
//  サブフォルダ内も検索
//=============================================================================
procedure TForm1.GetFilesListAllExt(APath, Ext: String; FileList: TStringList);
var
  LSearchPath : String;
  LSearchRec  : TSearchRec;
begin
  if FindFirst(APath + '*.*', faAnyFile, LSearchRec) = 0 then begin
    repeat
      if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
        if LSearchRec.Attr = faDirectory then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath+LSearchRec.Name);
          //フォルダの場合は，この関数を再帰的に呼出して，そのフォルダ内を検索
          GetFilesListAllExt(LSearchPath, Ext, FileList);
        end else begin
          if ExtractFileExt(LSearchRec.Name) = Ext then begin
            FileList.Add(APath+LSearchRec.Name);
            Inc(FFilesCount);
          end;
        end;
      end;
    until FindNext(LSearchRec) <> 0;

    FindClose(LSearchRec);
  end;
end;

end.



06_指定フォルダ内のファイル名の部分一致検索


サブフォルダも含めて，指定フォルダ内の，ファイル名に東京という文字列を含むファイルを検索して表示します．ファイルのサイズと更新日時も表示するようにしてみました．また，表示されたファイル名をダブルクリックすると，そのファイルに関連付けされたアプリを起動します．


  • 図14
  • 設計時画面

  • 図15
  • このプロジェクト内を検索した実行結果
  • ファイル名をダブルクリックすると，拡張子が .doc なのでワードが起動する


図16
ワードが起動

リスト7
指定フォルダ内のファイル名の部分一致検索 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Panel2: TPanel;
    Button1: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
  private
    { Private 宣言 }
    FFilesCount : Integer;
    procedure GetFilesListFindTitle(APath, FindText: String);
    function FileTimeToDateTime(ATime:TFileTime): TDateTime;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl, 
  ShellAPI;

{$R *.dfm}

//=============================================================================
//  検索開始
//  ファイル名に'東京'という文字列があるファイルのみを取得
//  FFilesCountはファイル数でグローバル変数
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBasePath : String;
  LFindText : String;
begin
  FFilesCount    := 0;
  Panel1.Caption := '';

  LBasePath := ExtractFileDir(Application.ExeName);

  //Delphi 2007より前には，最後の引数がない
  //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', SrcDir, [sdNewUI])
  //でダイアログを表示すると，指定したフォルダ位置までスクロールしてくれない
  if SelectDirectory('検索フォルダ指定', '', LBasePath, []) then begin
    LBasePath  := IncludeTrailingPathDelimiter(LBasePath);
    LFindText  := '東京';

    ListView1.Items.Clear;
    ListView1.MultiSelect := False;
    ListView1.Items.BeginUpdate;

    GetFilesListFindTitle(LBasePath, LFindText);

    ListView1.Items.EndUpdate;
  end;
  Panel1.Caption := '該当ファイル数 : ' + IntToStr(FFilesCount);
end;

//=============================================================================
//  APathで指定するフォルダ内(サブフォルダを含む)の全てのファイルの中からファイ
//  ル名に指定の文字列を含むファイルをTListViewに表示
//=============================================================================
procedure TForm1.GetFilesListFindTitle(APath, FindText: String);
var
  LSearchPath : String;
  LSearchRec  : TSearchRec;
  LItem       : TListItem;
  LSize       : Integer;
  LDateTime   : TDateTime;
  LTempStr    : String;
begin
  if FindFirst(APath + '*.*', faAnyFile, LSearchRec) = 0 then begin
    repeat
      if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin

        if LSearchRec.Attr = faDirectory then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath+LSearchRec.Name);

          //フォルダの場合は，この関数を再帰的に呼出して，そのフォルダ内を検索
          GetFilesListFindTitle(LSearchPath, FindText);
        end else begin
          if Pos(FindText, LSearchRec.Name) <> 0 then begin
            //ファイル名とフルパス名をListView1に追加
            LItem := ListView1.Items.Add;
            LItem.Caption := LSearchRec.Name;
            LItem.SubItems.Add(APath+LSearchRec.Name);

            //ファイルサイズ
            LSize   := LSearchRec.FindData.nFileSizeLow;
            LTempStr := FormatFloat('###,##0', LSize) + ' バイト';
            LItem.SubItems.Add(LTempStr);

            //最終更新日
            LDateTime := FileTimeToDateTime(LSearchRec.FindData.ftLastWriteTime);
            LTempStr   := FormatDateTime('yyyy年mm月dd日 hh時nn分', LDateTime);
            LItem.SubItems.Add(LTempStr);
            Inc(FFilesCount);
          end;
        end;
      end;
    until FindNext(LSearchRec) <> 0;

    FindClose(LSearchRec);
  end;
end;

//=============================================================================
//  TFileTime型の値をDelphiのTDateTime型に変換する関数
//=============================================================================
function TForm1.FileTimeToDateTime(ATime: TFileTime): TDateTime;
var
  LSystemTime : TSystemTime;
  LTempTime   : TFileTime;
begin
  try
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(ATime, LTempTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(LTempTime, LSystemTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result:=SystemTimeToDateTime(LSystemTime);
  except
    Result := 0;
  end;
end;

//=============================================================================
//  ダブルクリックしたら関連付けアプリを起動
//  ShellExecuteはusesにShellApiが必要
//=============================================================================
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  LFileName : String;
begin
  if ListView1.SelCount = 0 then exit;

  LFileName := ListView1.Selected.SubItems[0];
  ShellExecute(Handle, 'OPEN', PChar(LFileName), nil, nil, SW_SHOWNORMAL);
end;

end.



07_指定フォルダ内のファイルのサイズを取得


特に改めて紹介する内容ではありませんが，ファイルサイズの合計を取得するサンプルコードです．
単にファイルのサイズの値を加算しているだけです．


図17
設計時画面
図18
実行結果
  • このプロジェクト内のファイルサイズ

リスト8
指定フォルダ内のファイルサイズの合計 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListView1: TListView;
    Panel2: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilesCount : Integer;
    FTotalSize  : Int64;
    procedure GetFilesListAll(APath: String);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  検索開始
//  FFilesCountはファイル数でグローバル変数
//  FTotalSizeはファイルサイズの合計でグローバル変数
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBasePath : String;
begin
  FFilesCount := 0;
  FTotalSize  := 0;
  Panel1.Caption := '';

  LBasePath := ExtractFileDir(Application.ExeName);

  if SelectDirectory('検索フォルダ指定', '', LBasePath, []) then begin
    LBasePath := IncludeTrailingPathDelimiter(LBasePath);
    ListView1.Items.Clear;
    ListView1.Items.BeginUpdate;

    GetFilesListAll(LBasePath);

    ListView1.Items.EndUpdate;
  end;
  Panel1.Caption := 'ファイル数 : ' + IntToStr(FFilesCount) + '    '
                  + '合計サイズ : ' + FormatCurr('###,##0', FTotalSize) + ' バイト';
end;

//=============================================================================
//  APathで指定するフォルダ内の全てのファイルを検索するメソッド
//  サブフォルダ内も検索して，ファイル数とサイズを計算
//=============================================================================
procedure TForm1.GetFilesListAll(APath: String);
var
  LSearchPath : String;
  LSearchRec  : TSearchRec;
begin
  if FindFirst(APath + '*.*', faAnyFile, LSearchRec) = 0 then begin
    repeat
      if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
        if LSearchRec.Attr = faDirectory then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath + LSearchRec.Name);

          //フォルダの場合は，この関数を再帰的に呼出して，そのフォルダ内を検索
          GetFilesListAll(LSearchPath);
        end else begin
          //ファイル名のみListView1に追加
          ListView1.Items.Add.Caption := LSearchRec.Name;
          Inc(FFilesCount);
          //サイズを加算
          FTotalSize := FTotalSize+LSearchRec.FindData.nFileSizeLow;
        end;
      end;
    until FindNext(LSearchRec) <> 0;

    FindClose(LSearchRec);
  end;
end;

end.



08_指定フォルダ内のファイルの日時を一括変更


指定フォルダ内のファイルの作成日時，最終更新日時を，一括して変更するサンプルです．
サブフォルダ内のファイルやフォルダの日時も変更します．最終アクセス日時は変更しても意味がないので変更しません．
このサンプルでは，指定したフォルダそのものの日時も変更するようにしています．

Delphi 2010 で実装された TFile を使用すると，簡単にファイルの日時の取得や変更ができます．以下のリンクの記事を参考にしてください．



図19
設計時画面
図20
日付を変更したところ
  • このプロジェクトフォルダ内の例
  • DateTimePicker1 値の日付に変更
  • 時刻表示はないが，現在の時刻に変更
図21
エクスプローラで確認
  • フォルダの日付も変更される

リスト9
指定フォルダ内のファイルの日時を一括変更 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    ListView1: TListView;
    Panel3: TPanel;
    Button1: TButton;
    Button2: TButton;
    DateTimePicker1: TDateTimePicker;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    FFilesCount : Integer;
    FBasePath   : String;
    procedure GetFilesListAll(APath: String);
    procedure ChangeFilesDate(APath: String; AfterDateTime: TDateTime);
    function DateTimeToFileTime(ATime: TDateTime): TFileTime;
    function FileTimeToDateTime(ATime: TFileTime): TDateTime;
    procedure SetFileTimeStamp(AFileName: String; AfterDateTime: TDateTime);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  日付を本日にする
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  FBasePath := ExtractFileDir(Application.ExeName);
  DateTimePicker1.DateTime := Now;
end;

//=============================================================================
//  [ファイル一覧]ボタン
//  FFilesCountはファイル数でグローバル変数
//  FBasePathは検索開始フォルダ名でグローバル変数
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  FFilesCount    := 0;
  Panel1.Caption := '';
  ListView1.Items.Clear;
  ListView1.Items.BeginUpdate;

  //Sender = nil は[日時変更]ボタンをクリックした時
  if Sender <> nil then begin
    //Delphi 2007より前には，最後の引数がない
    //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', SrcDir, [sdNewUI])
    //でダイアログを表示すると，指定したフォルダ位置までスクロールしてくれない
    if FileCtrl.SelectDirectory('フォルダ指定', '', FBasePath, []) then begin
      Update;
    end;
  end;

  FBasePath := IncludeTrailingPathDelimiter(FBasePath);
  GetFilesListAll(FBasePath);

  ListView1.Items.EndUpdate;
  Button2.Enabled := ListView1.Items.Count > 0;
  Panel1.Caption  := 'ファイル数 : ' + IntToStr(FFilesCount);
end;

//=============================================================================
//  [日付変更]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LNewDateTime : TDateTime;
begin
  LNewDateTime := DateTimePicker1.DateTime;
  ChangeFilesDate(FBasePath, LNewDateTime);

  //確認のために再表示
  Button1Click(nil);
end;

//=============================================================================
//  APathで指定するフォルダ内(サブフォルダも含む)の全てのファイルを検索して
//  TListViewに表示する(ファイル名のみ)
//=============================================================================
procedure TForm1.GetFilesListAll(APath: String);
var
  LSearchPath : String;
  LSearchRec  : TSearchRec;
  LItem       : TListItem;
  LDateTime   : TDateTime;
  LTempStr    : String;
begin
  if FindFirst(APath + '*.*', faAnyFile, LSearchRec) = 0 then begin
    repeat
      if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
        if LSearchRec.Attr = faDirectory then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath + LSearchRec.Name);

          //フォルダの場合は，この関数を再帰的に呼出して，そのフォルダ内を検索
          GetFilesListAll(LSearchPath);
        end else begin
          LItem := ListView1.Items.Add;
          LItem.Caption := LSearchRec.Name;
          //作成日
          LDateTime := FileTimeToDateTime(LSearchRec.FindData.ftCreationTime);
          LTempStr   := FormatDateTime('yyyy/mm/dd hh:nn', LDateTime);
          LItem.SubItems.Add(LTempStr);
          Inc(FFilesCount);
        end;
      end;
    until FindNext(LSearchRec) <> 0;
    FindClose(LSearchRec);
  end;
end;

//=============================================================================
//  APathで指定するフォルダ内(サブフォルダも含めて)の日付を変更するメソッド
//  読み取り専用属性のファイルは変更できない
//=============================================================================
procedure TForm1.ChangeFilesDate(APath: String; AfterDateTime: TDateTime);
var
  LSearchPath : String;
  LSearchRec  : TSearchRec;
begin
  //現在のフォルダの日時も変更してしまうことにする
  SetFileTimeStamp(APath, AfterDateTime);

  if FindFirst(APath + '*.*', faAnyFile, LSearchRec) = 0 then begin
    repeat
    if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
        if LSearchRec.Attr = faDirectory then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath + LSearchRec.Name);
          SetFileTimeStamp(LSearchPath, AfterDateTime);

          //フォルダの時は，このメソッドを再帰的に呼び出して設定
          ChangeFilesDate(LSearchPath, AfterDateTime);
        end else begin
          SetFileTimeStamp(APath + LSearchRec.Name, AfterDateTime);
          Inc(FFilesCount);
        end;
      end;
    until FindNext(LSearchRec) <> 0;
    FindClose(LSearchRec);
  end;
end;

//=============================================================================
//  TFileTime型の値をDelphiのTDateTime型に変換する関数
//=============================================================================
function TForm1.FileTimeToDateTime(ATime: TFileTime): TDateTime;
var
  LSystemTime : TSystemTime;
  LTempTime   : TFileTime;
begin
  try
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(ATime, LTempTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(LTempTime, LSystemTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result := SystemTimeToDateTime(LSystemTime);
  except
    Result := 0;
  end;
end;

//=============================================================================
//  DelphiのTDateTime型の値をTFileTime型に変換する関数
//=============================================================================
function TForm1.DateTimeToFileTime(ATime: TDateTime): TFileTime;
var
  LSystemTime    : TSystemTime;
  LLocalFileTime : TFileTime;
begin
  try
    //TFileTimeをSystemTimeに変換
    DateTimeToSystemTime(ATime, LSystemTime);
    //SystemTimeをローカルのFileTimeに変換
    SystemTimeToFileTime(LSystemTime, LLocalFileTime);
    //最後にローカルの日時をGMT(世界協定時刻)に変換
    LocalFileTimeToFileTime(LLocalFileTime, Result);
  except
    Result.dwLowDateTime  := 0;
    Result.dwHighDateTime := 0;
  end;
end;

//=============================================================================
//  ファイルやフォルダの日付を変更するメソッド
//  実行中の自分自身は変更できない
//  AFileName    : 日時を変更するファイルまたはフォルダ名
//  LCreateTime  : 作成日時
//  LModifyTime  : 更新日時
//  アクセス日時は変更しても意味がないのでしない
//=============================================================================
procedure TForm1.SetFileTimeStamp(AFileName: String; AfterDateTime: TDateTime);
var
  LHandle     : THandle;
  LCreateTime : TFileTime;
  LModifyTime : TFileTime;
begin
  LHandle := 0;
  try
    //デリミタは削除
    AFileName := ExcludeTrailingPathDelimiter(AFileName);
    LHandle   := CreateFile(Pchar(AFileName),
                            GENERIC_WRITE,
                            FILE_SHARE_READ,
                            nil,
                            OPEN_EXISTING,
                            FILE_FLAG_BACKUP_SEMANTICS,
                            0);

    if LHandle > 0 then begin
      LCreateTime := DateTimeToFileTIme(AfterDateTime);
      LModifyTime := DateTimeToFileTIme(AfterDateTime);
      //日付を変更する
      SetFileTime(LHandle, Addr(LCreateTime), nil, Addr(LModifyTime));
    end;
  finally
    CloseHandle(LHandle);
  end;
end;

end.



09_指定フォルダ内のファイルの属性を一括変更


続いてファイルの属性を変更してしまうサンプルコードです．ファイルの日付変更の部分を属性変更のコードにしたものです．ただし，このサンプルでは，Windows API の FindFirstFile と FindNextFile を使用してみました．

Delphi 2010 で実装された TFile を使用すると，簡単にファイルの属性の取得や変更ができます．以下のリンクの記事を参考にしてください．



図22
設計時画面
図23
フォルダを選択
  • このフォルダ内のファイルの属性を変更
  • 本ページのサンプルでは，フォルダの指定用に，SelectDirectory を使用しているが，Delphi 2007 以上であれば，TFileOpenDialog の方がいいかも知れない
図24
変更対象ファイル
  • このプロジェクト内の BBB というフォルダ内のファイル
図25
属性変更
  • NORMAL はファイルやフォルダの一般的な属性
    R　読出し専用
    H　隠しファイル
    S　システムファイル
    A　アーカイブ
  • 属性を変更すると，次回ファイルの検索で取得できなくなることがある．その場合は，そのファイルを含むフォルダの属性を NORMAL にして，再度ファイル一覧を取得する

リスト10
指定フォルダ内のファイルの属性を一括変更 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListView1: TListView;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Panel3: TPanel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilesCount : Integer;
    FBasePath   : String;
    procedure GetFilesListAll(APath: String);
    procedure SetFilesListAttrib(APath: String; dmFileAttributes:Cardinal);
    procedure SetFileAttrib(FileName:String; dmFileAttributes:Cardinal);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  [ファイル一覧]ボタン
//  FFilesCountはファイル数でグローバル変数
//  FBasePathは検索開始フォルダ名でグローバル変数
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  FFilesCount    := 0;
  Panel1.Caption := '';

  ListView1.Items.Clear;
  ListView1.Items.BeginUpdate;

  //Sender = nil は[属性変更]ボタンをクリックした時
  if Sender <> nil then begin
    FBasePath := ExtractFileDir(Application.ExeName);

    //Delphi 2007より前には，最後の引数がない
    //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', SrcDir, [sdNewUI])
    //でダイアログを表示すると，指定したフォルダ位置までスクロールしてくれない
    if SelectDirectory('検索フォルダ指定', '', FBasePath, []) then begin
      FBasePath := IncludeTrailingPathDelimiter(FBasePath);

      //フォルダの場合は，この関数を再帰的に呼出して，そのフォルダ内を検索
      GetFilesListAll(FBasePath);
    end;
  end else begin
    GetFilesListAll(FBasePath);
  end;
  ListView1.Items.EndUpdate;
  Button2.Enabled:=ListView1.Items.Count > 0;
  Panel1.Caption := 'ファイル数 : ' + IntToStr(FFilesCount);
end;

//=============================================================================
//  [属性変更]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LAttrib : Cardinal;
begin
  LAttrib := 0;

  if CheckBox5.Checked then begin
    LAttrib := FILE_ATTRIBUTE_NORMAL;
  end else begin
    if CheckBox1.Checked = True then LAttrib := LAttrib or FILE_ATTRIBUTE_READONLY;
    if CheckBox2.Checked = True then LAttrib := LAttrib or FILE_ATTRIBUTE_HIDDEN;
    if CheckBox3.Checked = True then LAttrib := LAttrib or FILE_ATTRIBUTE_SYSTEM;
    if CheckBox4.Checked = True then LAttrib := LAttrib or FILE_ATTRIBUTE_ARCHIVE;
  end;

  SetFilesListAttrib(FBasePath, LAttrib);
  //確認のために再表示
  Button1Click(nil);
end;

//=============================================================================
//  FILE_ATTRIBUTE_NORMALは単独での指定しかできないので他の設定は無しにする
//=============================================================================
procedure TForm1.CheckBox5Click(Sender: TObject);
begin
  if CheckBox5.Checked then begin
    CheckBox1.Checked := False;
    CheckBox2.Checked := False;
    CheckBox3.Checked := False;
    CheckBox4.Checked := False;
  end;
  CheckBox1.Enabled := not CheckBox5.Checked;
  CheckBox2.Enabled := not CheckBox5.Checked;
  CheckBox3.Enabled := not CheckBox5.Checked;
  CheckBox4.Enabled := not CheckBox5.Checked;
end;

//=============================================================================
//  APathで指定するフォルダ内(サブフォルダも含む)の全てのファイルを検索して
//  ListView1に表示する(ファイル名のみ)
//  サブアイテムに属性の頭文字を表示
//  ここではWin32APIのFindFirstFileとFindNextFileを使ってみた
//=============================================================================
procedure TForm1.GetFilesListAll(APath: String);
var
  LHandle     : THandle;
  LFileName   : String;
  LAttrib     : DWORD;
  LSearchPath : String;
  LItem       : TListItem;
  LTempStr    : String;
  LFileData   : TWin32FindData;
begin
  LHandle := FindFirstFile(PChar(APath + '*.*'), LFileData);

  if LHandle <> INVALID_HANDLE_VALUE then begin
    repeat
      LFileName := LFileData.cFileName;
      LAttrib   := LFileData.dwFileAttributes;

      if not ((LFileName = '..') or (LFileName = '.')) then begin
        if LAttrib = FILE_ATTRIBUTE_DIRECTORY then begin
          LSearchPath := IncludeTrailingPathDelimiter(APath + LFileName);

          //フォルダの場合は，この関数を再帰的に呼出して，そのフォルダ内を検索
          GetFilesListAll(LSearchPath);
        end else begin
          LItem := ListView1.Items.Add;
          LItem.Caption := LFileName;

          //属性を取得
          LTempStr := ' ';
          if Bool(LAttrib and FILE_ATTRIBUTE_READONLY) then
             LTempStr := LTempStr + 'R ';
          if Bool(LAttrib and FILE_ATTRIBUTE_HIDDEN) then
             LTempStr := LTempStr + 'H ';
          if Bool(LAttrib and FILE_ATTRIBUTE_SYSTEM) then
             LTempStr := LTempStr + 'S ';
          if Bool(LAttrib and FILE_ATTRIBUTE_ARCHIVE) then
             LTempStr := LTempStr + 'A ';
          LItem.SubItems.Add(LTempStr);
          Inc(FFilesCount);
        end;
      end;
    until FindNextFile(LHandle, LFileData) = False;

    Windows.FindClose(LHandle);
  end;
end;

//=============================================================================
//  APathで指定するフォルダ内(サブフォルダも含めて)の属性を変更するメソッド
//=============================================================================
procedure TForm1.SetFilesListAttrib(APath: String; dmFileAttributes:Cardinal);
var
  LSearchPath : String;
  LSearchRec  : TSearchRec;
begin
  if FindFirst(APath + '*.*', faAnyFile, LSearchRec) = 0 then begin
    repeat
      if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
        LSearchPath := IncludeTrailingPathDelimiter(APath+LSearchRec.Name);

        if LSearchRec.Attr = faDirectory then begin
          SetFileAttrib(LSearchPath,dmFileAttributes);

          //フォルダの場合は，この関数を再帰的に呼出して，そのフォルダ内を検索
          SetFilesListAttrib(LSearchPath, dmFileAttributes);
        end else begin
          SetFileAttrib(LSearchPath, dmFileAttributes);
          Inc(FFilesCount);
        end;
      end;
    until FindNext(LSearchRec) <> 0;

    FindClose(LSearchRec);
  end;
end;

//=============================================================================
//  ファイルやフォルダの属性を変更するメソッド
//  属性を変更したら，一度NORMALにしないとFindFirstで検索できなる場合あり
//  FileName         : 日時を変更するファイルまたはフォルダ名
//  dmFileAttributes : 属性
//=============================================================================
procedure TForm1.SetFileAttrib(FileName: String; dmFileAttributes:Cardinal);
var
  LHandle : THandle;
begin
  if ChangeFileExt(FileName, '') = ChangeFileExt(Application.ExeName, '') then exit;

  try
    FileName := ExcludeTrailingPathDelimiter(FileName);
    LHandle  := Windows.CreateFile(Pchar(FileName),
                                   GENERIC_WRITE,
                                   FILE_SHARE_READ,
                                   nil,
                                   OPEN_EXISTING,
                                   FILE_FLAG_BACKUP_SEMANTICS,
                                   0);
    //フォルダの場合は失敗する
    //FileHandle <> INVALID_HANDLE_VALUEでないことに注意
    if LHandle > 0 then begin
      //属性を変更する
      SetFileAttributes(PChar(FileName), dmFileAttributes);
    end;
  finally
     CloseHandle(LHandle);
  end;
end;

end.



10_指定フォルダ内のファイル一覧 ( TShell オブジェクト使用 )


ファイル情報は，TShell オブジェクトを利用しても取得できます．その例です．このテストプログラムでは，TShell オブジェクトをコンポーネントにして Form に配置して利用しています．
TShell オブジェクトのコンポーネントとしてインストールする方法は，[タイプライブラリの取り込み] の記事を参考にしてください．



図26
設計時画面
  • TShell オブジェクトのコンポを配置
図27
実行結果例
  • 指定フォルダ内のファイルリスト
  • フォルダ名のリストも含む
  • ファイルサイズの計算には少し工夫が必要かも知れない

リスト11
指定フォルダ内のファイル一覧 (TShell オブジェクト使用) 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Shell1: TShell;
    Panel1: TPanel;
    Button1: TButton;
    Panel2: TPanel;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FBasePath : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses 
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  初期設定
//  選択フォルダの初期値を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FBasePath := ExtractFileDir(Application.ExeName);
  ListView1.RowSelect := True;
end;

//=============================================================================
//  指定フォルダ内のファイル一覧をListViewに表示
//
//  FolderItemのプロパティは以下の通り
//  Path         : WideString      Itemのフルパス
//  Name         : WideString      Itemのファイル名
//  Type_        : WideString      Itemのタイプ文字列
//  Size         : Integer         Itemのサイズ
//  ModifyDate   : TDateTiem       Itemの最終更新日時
//  IsFileSystem : WordBool        Itemがファイルシステムかどうか
//  IsFolder     : WordBool        Itemがフォルダかどうか
//  GetFolder    : IDispatch       Itemがフォルダの時，フォルダオブジェクト
//  IsLink       : WordBool        Itemが(*.lnk,*.pif,*.url)ならTrue
//  GetLink      : ShellLinkObject Itemがショートカットの時，ShellLinkObject
//  Parent       : IDispatch       Itemの親オブジェクト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSHFolder     : Shell32_TLB.Folder;
  LSHFolderItem : Shell32_TLB.FolderItem;
  LDateTime     : TDateTime;
  LValue        : WideString;
  i             : Integer;
begin
  //Delphi 2007より前には，最後の引数がない
  //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', SrcDir, [sdNewUI])
  //でダイアログを表示すると，指定したフォルダ位置までスクロールしてくれない
  if SelectDirectory('フォルダ選択', '', FBasePath, []) then begin
    ListView1.Items.Clear;
    ListView1.Update;
    ListView1.Items.BeginUpdate;

    LSHFolder := Shell1.NameSpace(FBasePath);

    //SHFolderオブジェクトの各アイテム(ファイル)の情報取得
    for i := 0 to LSHFolder.Items.Count - 1 do begin
      //FoldetItemオブジェクト(つまりフォルダ内の各ファイル)
      LSHFolderItem := LSHFolder.Items.Item(i);

      //ファイル名
      ListView1.Items.Add.Caption := LSHFolderItem.Name;

      //サイズ
      if LSHFolderItem.IsFolder then begin
        ListView1.Items[i].SubItems.Add('');
      end else begin
        LValue := FormatFloat('###,##0 KB', LSHFolderItem.Size div 1024);
        ListView1.Items[i].SubItems.Add(LValue);
      end;

      //最終更新日時
      LDateTime := LSHFolderItem.ModifyDate;
      LValue    := FormatDateTime('yyyy/mm/dd hh:mm', LDateTime);
      ListView1.Items[i].SubItems.Add(LValue);
    end;
    ListView1.Items.EndUpdate;
  end;
end;

end.



11_コンテキストメニューの表示   -  Delphi 2007 以前用


筆者が作成する業務アプリではほとんど必要性は感じませんが，エクスプローラと同じように，選択したファイルのコンテキストメニューは，シェルの機能を使用すると実現できます．これは，上で述べたシェルオブジェクトではなく，シェルネームスペース (シェル名前空間) のことです．
シェルの機能を使用するのは結構面倒ですので，筆者の得意技で，他の方のコンポーネントを利用することにします．それは，ヒシアマゾンさん作の DRPCOMEX というコンポーネントです．Delphian World にありましたが，現在入手できませんのでこのサンプルのフォルダ内に添付しています．

このコンポーネントは，Delphi 2007 以前用です．したがって，本サンプルは Delphi 2007 以前限定です．以下の結果は，Windows 7 U64(SP1) + Delphi 2007-R2 での実行結果です．
このコンポーネントは，コンテキストメニューを表示しなくても，コンテキストメニューのコマンドを 実行することもできます．



図28
設計時画面
  • ヒシアマゾンさんのコンポーネントを配置
図29
実行例
  • コンテキストメニュー表示コードは，リストビューの OnMouseDown イベント内

リスト12
エクスプローラと同じコンテキストメニューが簡単に実現可能 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListView1: TListView;
    ContextMenuEx1: TContextMenuEx;
    Panel2: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    FDirName : String;
    procedure GetFilesList(APath: String);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  指定フォルダ内のファイルとフォルダを表示
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  FDirName := ExtractFileDir(Application.ExeName);

  //Delphi 2007より前には，最後の引数がない
  //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', SrcDir, [sdNewUI])
  //でダイアログを表示すると，指定したフォルダ位置までスクロールしてくれない
  if SelectDirectory('検索フォルダ指定', '', FDirName, []) then begin
    GetFilesList(FDirName);
  end;
end;

//=============================================================================
//  APathで指定するフォルダ内の全てのファイルを検索してListViewに表示
//  サブフォルダ内は検索しない
//=============================================================================
procedure TForm1.GetFilesList(APath: String);
var
  LFilesCount : Integer;
  LSearchPath : String;
  LSearchRec  : TSearchRec;
begin
  Panel1.Caption := '';
  LFilesCount    := 0;
  ListView1.Items.Clear;
  ListView1.Items.BeginUpdate;

  LSearchPath := IncludeTrailingPathDelimiter(APath) + '*.*';

  if FindFirst(LSearchPath, faAnyFile, LSearchRec) = 0 then begin
    repeat
      if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
        ListView1.Items.Add.Caption := LSearchRec.Name;
        Inc(LFilesCount);
      end;
    until FindNext(LSearchRec) <> 0;

    FindClose(LSearchRec);
  end;

  ListView1.Items.EndUpdate;
  Panel1.Caption := 'ファイル数 : ' + IntToStr(LFilesCount);
end;

//=============================================================================
//  マウスクリック位置のファイルのコンテキストメニューを表示
//  FDirName       : 表示中のフォルダ名
//  ContextMenuEx1 : ヒシアマゾンさん作のコンポーネント
//=============================================================================
procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i         : Integer;
  LStrList  : TStringList;
  LFullPath : String;
begin
  if FDirName = '' then exit;

  if Button = mbRight then begin
    LStrList  := TStringList.Create;
    LFullPath := IncludeTrailingPathDelimiter(FDirName);
    try
      if ListView1.SelCount = 0 then begin
        LStrList.Add(LFullPath);
      end else begin
        for i := 0 to ListView1.SelCount - 1 do begin
          LStrList.Add(LFullPath + ListView1.Selected.Caption);
        end;
      end;
      ContextMenuEx1.CMFileName.Assign(LStrList);
    finally
      FreeAndNil(LStrList);
    end;
    ContextMenuEx1.DoMenuEx(ListView1.Handle, X, Y);
    //削除やファイル名変更は，ファイルリストを再取得しないと結果の確認ができない
    //タイムラグが必要なようである(程度については不明)
    Sleep(100);
    GetFilesList(FDirName);
  end;
end;

end.



12_ファイルのディスク上のサイズを取得


ディスク上のファイルサイズを取得するサンプルです．この値は，[ファイルのプロパティ] のダイアログで [ディスク上のサイズ] として表示される値のことです．
stackoverflow に掲載されているコードをひな型として利用しています．ただし，ファイルサイズの値の変数は，符号なしの 64 ビット整数型に変更しています．Cardinal 型のままだと，32 ビット以上のファイルサイズの値が正しく取得できません．



ディスク上のファイルサイズはクラスタ単位です．対象のディスクのクラスタサイズを知る必要があります．本サンプルでは GetDiskFreeSpace 関数を使用して取得しています．
次にファイルサイズを取得します．そして，ファイルサイズの値とクラスタサイズの値からディスク上のサイズを計算します．

本サンプルでは，ファイルサイズの取得に GetCompressedFileSize 関数を使用しています．この関数で圧縮属性のファイルサイズを取得すると，圧縮属性のファイルのファイルサイズとディスク上のサイズは同じ圧縮時の値となります．非圧縮属性時のファイルサイズが必要な場合は，他の関数でファイルサイズを取得します．



図30
4,096 バイトのファイルの例
  • 4,096 はクラスタのサイズと同じ値
図31
4,097 バイトのファイルの例
  • 上の図よりも 1 バイト多いだけだか，1 クラスタのサイズである 4,096 を超えている
  • したがって，ディスク上のサイズは 2 クラスタ分となる
図32
約 100 GB のバイナリファイルの例

リスト13
ファイルのディスク上のサイズを取得するサンプル		 
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;
    LabeledEdit3: TLabeledEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//-----------------------------------------------------------------------------
//  指定ファイルのサイズとディスク上のサイズを取得するルーチン
//-----------------------------------------------------------------------------
procedure GetFileSizeOnDisk(const FileName: string; out AFileSize, ASizeOnDisk: UInt64);
var
  LDriveLetter       : string;
  LSectorsPerCluster : DWORD;
  LBytesPerSector    : DWORD;
  LDummy             : DWORD;
  LClusterSize       : DWORD;
  LFileSizeHigh      : UInt64;
  LFileSizeLow       : UInt64;
begin
  AFileSize   := 0;
  ASizeOnDisk := 0;
  //ファイルが存在しない場合
  if not FileExists(FileName) then begin
    exit;
  end;

  //ドライブレターを取り出す(ex. d:\)
  LDriveLetter := IncludeTrailingPathDelimiter(ExtractFileDrive(FileName));
  //該当ディスクの(セクタ数/クラスタ)と(バイト数/セクタ)を取得
  if not GetDiskFreeSpace(PChar(LDriveLetter),
                          LSectorsPerCluster,
                          LBytesPerSector,
                          LDummy,
                          LDummy) then begin
    //関数の実行に失敗した場合
    //エラーの検出はRaiseLastOSError
    exit;
  end;
  //クラスタのサイズを計算
  LClusterSize := LSectorsPerCluster * LBytesPerSector;

  //ファイルサイズの上位と下位のDWORD値(32ビット)を取得
  //上位DWORDは引数から取得.下位DWOODは関数の戻り値から取得
  //圧縮属性のファイルの場合は圧縮したファイルサイズとなる
  LFileSizeLow := GetCompressedFileSize(PChar(FileName), @LFileSizeHigh);

  //ファイルサイズとディスク上のファイルサイズを計算
  if (GetLastError = NO_ERROR) or (LFileSizeLow <> INVALID_FILE_SIZE) then begin
    //エラーの検出はRaiseLastOSError
    AFileSize   := LFileSizeHigh shl 32 + LFileSizeLow;
    ASizeOnDisk := AFileSize;
    if (ASizeOnDisk mod LClusterSize) > 0 then begin
      ASizeOnDisk := ASizeOnDisk + (LClusterSize) - (ASizeOnDisk mod LClusterSize);
    end;
  end;
end;

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

//=============================================================================
//  ファイルサイズとディスク上のサイズを取得して表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName     : String;
  LFileSize     : UInt64;
  LFileDiskSize : UInt64;
begin
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

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

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

  //ファイルサイズとディスク上のサイズを取得して表示
  GetFileSizeOnDisk(LFileName, LFilesize, LFileDiskSize);
  LabeledEdit2.Text := FormatFloat('##,##0 バイト', LFileSize);
  LabeledEdit3.Text := FormatFloat('##,##0 バイト', LFileDiskSize);
end;

end.



13_TDateTime 型を使用しないファイルの日時変更と取得


上の方のサンプルで，TDateTime 型の値を TFileTime 型，TSystemTime 型等に変換してファイルの日時を取得あるいは変更するサンプルを掲載していますが，参考として，TDateTime 型を使用しないサンプルを掲載しておきます．
上の方のサンプルとの違いは，取得の際に SystemTimeToDateTime 関数を使用しないことと，タイムスタンプの変更の際に DateTimeToSystemTime 関数を使用していないことです．

本サンプルでは，ファイルの更新日時だけを変更，または取得します．



図33
設計時画面
図34
実行結果

リスト14
TDateTime 型を使用しないファイルの日時変更と取得		 
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;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

//=============================================================================
//  ファイルの日付時刻を年月日時分秒,ミリ秒を個別に設定する例
//  TDateTime型を使用しない方法
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileName      : string;
  LModifyTime    : TSystemTime;
  LFileTime      : TFileTime;
  LWriteFileTime : TFileTime;
  LFileHandle    : THandle;
begin
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

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

  //対象のファイルのフルパス
  LFileName := Trim(LabeledEdit1.Text);

  //現在の日付と時刻に設定変更する場合
  //現在の日付時刻をTSystemTime型で取得
  GetLocalTime(LModifyTime);

  //個別に設定する場合は以下のようにTSystemTimeの各メンバに値をセットする
  LModifyTime.wYear         := 2016;
  LModifyTime.wMonth        := 7;
  LModifyTime.wDay          := 19;
  LModifyTime.wHour         := 16;
  LModifyTime.wMinute       := 10;
  LModifyTime.wSecond       := 20;
  LModifyTime.wMilliseconds := 300;

  //SystemTimeをローカルのFileTimeに変換
  SystemTimeToFileTime(LModifyTime, LFileTime);
  //ローカルの日時をGMT(世界協定時刻)に変換
  LocalFileTimeToFileTime(LFileTime, LWriteFileTime);

  //FileOpen関数は内部ではCreateFile関数で処理している
  LFileHandle := FileOpen(LFileName, fmOpenReadWrite);
  try
    //タイムスタンプを変更
    SetFileTime(LFileHandle, nil, nil, @LWriteFileTime);
  finally
    FileClose(LFileHandle);
  end;

  //確認表示
  Button2Click(nil);
end;

//=============================================================================
//  ファイルの日付時刻を年月日時分秒,ミリ秒を個別に取得する例
//  TDateTime型を使用しない方法
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFileName     : string;
  LFileHandle   : THandle;
  LModifyTime   : TFileTime;
  LTempTime     : TFileTime;
  LSystemTime   : TSystemTime;
  LYear         : Word;
  LMonth        : Word;
  LDay          : Word;
  LHour         : Word;
  LMinute       : Word;
  LSecond       : Word;
  LMilliseconds : Word;
  LFormatText   : string;
begin
  if Sender <> nil then begin
    OpenDialog1.OptionsEx  := [];
    OpenDialog1.FileName   := '';
    if not OpenDialog1.Execute then exit;

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

  //対象のファイルのフルパス
  LFileName := Trim(LabeledEdit1.Text);

  //FileOpen関数は内部ではCreateFile関数で処理している
  LFileHandle := FileOpen(LFileName, fmOpenRead);
  try
    // タイムスタンプを取得
    GetFileTime(LFileHandle, nil, nil, @LModifyTime);
  finally
    FileClose(LFileHandle);
  end;

  //FileTime形式(世界協定時刻)を地域に合わせる
  FileTimeToLocalFileTime(LModifyTime, LTempTime);
  //FileTime形式をSystemTime形式にする
  FileTimeToSystemTime(LTempTime, LSystemTime);

  LFormatText   := '%4d年%2d月%2d日 %2d時%2d分%2d秒%3d';
  LYear         := LSystemTime.wYear;
  LMonth        := LSystemTime.wMonth;
  LDay          := LSystemTime.wDay;
  LHour         := LSystemTime.wHour;
  LMinute       := LSystemTime.wMinute;
  LSecond       := LSystemTime.wSecond;
  LMilliseconds := LSystemTime.wMilliseconds;

  LabeledEdit2.Text := Format(LFormatText,
                       [LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliseconds]);
end;

//=============================================================================
//  ファイルの日付時刻を年月日時分秒,ミリ秒を個別に取得する例
//  TDateTime型を使用する方法
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LFileName     : string;
  LFileHandle   : THandle;
  LModifyTime   : TFileTime;
  LTempTime     : TFileTime;
  LSystemTime   : TSystemTime;
  LYear         : Word;
  LMonth        : Word;
  LDay          : Word;
  LHour         : Word;
  LMinute       : Word;
  LSecond       : Word;
  LMilliseconds : Word;
  LFormatText   : string;
  LDataTime     : TDateTime;
begin
  if Sender <> nil then begin
    OpenDialog1.OptionsEx  := [];
    OpenDialog1.FileName   := '';
    if not OpenDialog1.Execute then exit;

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

  //対象のファイルのフルパス
  LFileName := Trim(LabeledEdit1.Text);

  //FileOpen関数は内部ではCreateFile関数で処理している
  LFileHandle := FileOpen(LFileName, fmOpenRead);
  try
    // タイムスタンプを取得
    GetFileTime(LFileHandle, nil, nil, @LModifyTime);
  finally
    FileClose(LFileHandle);
  end;

  //FileTime形式(世界協定時刻)を地域に合わせる
  FileTimeToLocalFileTime(LModifyTime, LTempTime);
  //FileTime形式をSystemTime形式にする
  FileTimeToSystemTime(LTempTime, LSystemTime);
  //SystemTime形式をDelphiのTDateTime形式に変換
  LDataTime := SystemTimeToDateTime(LSystemTime);

  DecodeDate(LDataTime, LYear, LMonth, LDay);
  DecodeTime(LDataTime, LHour, LMinute, LSecond, LMilliseconds);

  LFormatText := '%4d年%2d月%2d日 %2d時%2d分%2d秒%3d';
  LabeledEdit2.Text := Format(LFormatText,
                       [LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliseconds]);
end;

end.



14_IOUtils.TFile を使用したファイルの日時変更と取得


Delphi 2010 で実装された TFile のメソッド類を使用すると，簡単にファイルの日時の取得や変更ができます．そのサンプルです．
ディレクトリだけの場合は，IOUtils.TDirectory に同じ名前のメソッドがあります．TDirectory の関数を使用すると，ディレクトリ内のファイルのタイムスタンプは元のままで，ディレクトリだけのタイムスタンプを変更できます．

本サンプルでは，ファイルの更新日時だけを変更，または取得します．



図35
実行結果
  • TDateTime 型の値を，以下の方法で文字列にして表示
    (1) DateTimeToString
    (2) FormatDateTime
    (3) 年，月，日，時，分，秒，ミリ秒に分解
  • 結果は全て同じ

リスト15
IOUtils.TFile を使用したファイルの日時変更と取得		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button2: TButton;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  protected
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  DateUtils,
  IOUtils;

{$R *.dfm}

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

//=============================================================================
//  ファイルのタイムスタンプ(更新日時)の設定
//  IOUtils.TFileを使用する例
//
//  usesにDateUtils,IOUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath     : String;
  LModifyTime   : TDateTime;
  LYear         : Word;
  LMonth        : Word;
  LDay          : Word;
  LHour         : Word;
  LMinute       : Word;
  LSecond       : Word;
  LMilliseconds : Word;
begin
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;
  OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);

  LFilePath := OpenDialog1.FileName;

  LYear         := 2016;
  LMonth        := 7;
  LDay          := 19;
  LHour         := 16;
  LMinute       := 10;
  LSecond       := 20;
  LMilliseconds := 50;

  //年月日と時刻の各要素の値を元にしてTDataTime型の変数に変換
  LModifyTime := EncodeDateTime(LYear, LMonth, LDay,
                                LHour, LMinute, LSecond, LMilliseconds);
  //ファイルの更新日時(最終書き込み日時)を変更
  IOUtils.TFile.SetLastWriteTime(LFilePath, LModifyTime);

  //確認表示
  Button2Click(nil);
end;

//=============================================================================
//  ファイルのタイムスタンプ(更新日時)の取得
//  IOUtils.TFileを使用する例
//
//  usesにDateUtils,IOUtilsが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFilePath     : String;
  LModifyTime   : TDateTime;
  LYear         : Word;
  LMonth        : Word;
  LDay          : Word;
  LHour         : Word;
  LMinute       : Word;
  LSecond       : Word;
  LMilliseconds : Word;
  LText         : string;
begin
  if Sender <> nil then begin
    OpenDialog1.OptionsEx  := [];
    OpenDialog1.FileName   := '';
    if not OpenDialog1.Execute then exit;

    OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);
  end;

  LFilePath := OpenDialog1.FileName;

  //ファイルの更新日時(最終書き込み日時)を取得
  LModifyTime := IOUtils.TFile.GetLastWriteTime(LFilePath);

  //取得した日付時刻の値を書式設定した文字列にする
  //いくつかの書式設定をやってみる
  DateTimeToString(LText, 'yyyy年mm月dd日 hh時nn分ss秒zzz', LModifyTime);

  LText := LText + sLineBreak
         + FormatDateTime('yyyy年mm月dd日 hh時nn分ss秒zzz', LModifyTime);

  //年月日と時刻の各要素に分解して，それらの書式を個別に設定
  DecodeDate(LModifyTime, LYear, LMonth, LDay);
  DecodeTime(LModifyTime, LHour, LMinute, LSecond, LMilliseconds);
  LText := LText + sLineBreak
         + Format('%4d年%.2d月%.2d日 %.2d時%.2d分%.2d秒%.3d',
                  [LYear, LMonth, LDay, LHour, LMinute, LSecond, LMilliseconds]);

  //結果を表示
  MessageBox(Handle, PChar(LText), '結果', MB_ICONINFORMATION);
end;

end.