Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2009年02月01日] [更新 2016年10月09日] Delphi サンプルプログラム集
   
782_FileSystemObject によるファイル情報の取得
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
782_FileSystemObject.zip [2,335 KB] 2016年10月09日版 (EXE 同梱)







タイプライブラリの取り込み


FileSystemObject はファイル・システムにアクセスするためのオブジェクトで,Scrrun.dll 内のスクリプトライブラリです.ファイルやフォルダ等の操作に利用できます.
マイクロソフトでは Web サーバー上のファイルやフォルダを追加、移動、変更、作成または削除等の操作用に提供しているようです.
VB のサンプルはネット上でもたまに見かけますが,Delphi でテストしてみました.

Delphi で FielSystemObject を使用するには,[タイプライブラリの取り込み] で
    [Microsoft Scripting Rumtime (Version 1.0)]
を取り込んで Scripting_TLB.pas を作成します.以下のサンプルにはありませんが,ファイルやフォルダの作成・削除・移動等のメソッドもあります.


図1
タイプライブラリの取り込み
  • [コンポーネント]
    [コンポーネントのインポート]
  • [ユニットの作成]を選択

  • 当ページのサンプルでは,パッケージへのインストールは不要




01_ファイルの情報を取得


IFile オブジェクトを使用してファイルの情報を取得します.
ファイル名と属性の一部を変更可能にしました.エクスプローラで [プロパティ] ダイアログを表示した時に,[全般] タブで表示される内容とほぼ同様の項目を取得しています.


図2
設計時画面

図3
ファイルの情報を表示
  • [更新]ボタンでファイル名が変更可能

リスト1
ファイルの情報を取得
unit FileInfoUnit;

interface

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

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    Button1: TButton;
    Panel2: TPanel;
    ChkBox1: TCheckBox;
    ChkBox2: TCheckBox;
    ChkBox3: TCheckBox;
    ChkBox4: TCheckBox;
    LblEdit1: TLabeledEdit;
    LblEdit2: TLabeledEdit;
    LblEdit3: TLabeledEdit;
    LblEdit5: TLabeledEdit;
    LblEdit6: TLabeledEdit;
    LblEdit7: TLabeledEdit;
    LblEdit4: TLabeledEdit;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    FFileSystem : IFileSystem3;
    FFileObjet  : IFile;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ファイルシステムオブジェクト(IFileSystem)生成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  FFileSystem := CoFileSystemObject.Create;

  Button2.Enabled := False;
end;

//=============================================================================
//  生成したオブジェクトをnilに
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(FFileSystem) then FFileSystem := nil;
  if Assigned(FFileObjet)  then FFileObjet  := nil;
end;

//=============================================================================
//  ファイルを選択して情報取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileSize   : Int64;
  LAttrib     : Integer;
  LDateFormat : String;
begin
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';

  if OpenDialog1.Execute then begin
    //ファイルオブジェクト(IFile)生成
    FFileObjet := FFileSystem.GetFile(OpenDialog1.FileName);

    LblEdit1.Text := '';
    LblEdit2.Text := '';
    LblEdit3.Text := '';
    LblEdit4.Text := '';
    LblEdit5.Text := '';
    LblEdit6.Text := '';
    LblEdit7.Text := '';

    //選択したファイルのフルパス
    LblEdit1.Text := FFileObjet.Path;
    //ファイル名
    LblEdit2.Text := FFileObjet.Name;
    //ファイル種類
    LblEdit3.Text := FFileObjet.type_;
    //ファイル種類
    LblEdit3.Text := FFileObjet.type_;
    //サイズ
    LFileSize     := FFileObjet.Size / 1024;
    LblEdit4.Text := FormatFloat('###,##0 KB', LFileSize);
    //作成日時
    LDateFormat   := 'yyyy/mm/dd hh:nn:ss';
    LblEdit5.Text := FormatDateTime(LDateFormat, FFileObjet.DateCreated);
    //更新日時
    LblEdit6.Text := FormatDateTime(LDateFormat, FFileObjet.DateLastModified);
    //最終アクセス日時
    LblEdit7.Text := FormatDateTime(LDateFormat, FFileObjet.DateLastAccessed);

    //属性
    LAttrib := FFileObjet.Attributes;
    ChkBox1.Checked := Bool(LAttrib and FILE_ATTRIBUTE_READONLY);
    ChkBox2.Checked := Bool(LAttrib and FILE_ATTRIBUTE_HIDDEN);
    ChkBox3.Checked := Bool(LAttrib and FILE_ATTRIBUTE_SYSTEM);
    ChkBox4.Checked := Bool(LAttrib and FILE_ATTRIBUTE_ARCHIVE);

    Button2.Enabled := True;
  end;
end;

//=============================================================================
//  ファイル情報の変更(属性のみ)
//  ファイルの日時関係は読み出し専用だと変更できない
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LOldFileName : String;
  LOldAttrib   : Cardinal;
  LNewAttrib   : Cardinal;
begin
  if FFileObjet = nil then exit;

  LOldFileName := FFileObjet.Name;

  //ファイル属性の変更.変更がなければ更新しないようにする
  LOldAttrib := FFileObjet.Attributes;
  LNewAttrib := LOldAttrib;
  //読出し専用
  if ChkBox1.Checked then begin
    if (LNewAttrib and FILE_ATTRIBUTE_READONLY) = 0 then begin
      LNewAttrib := LNewAttrib or FILE_ATTRIBUTE_READONLY;
    end;
  end else begin
    if (LNewAttrib and FILE_ATTRIBUTE_READONLY) <> 0 then begin
      LNewAttrib := LNewAttrib xor FILE_ATTRIBUTE_READONLY;
    end;
  end;
  //隠し属性
  if ChkBox2.Checked then begin
    if (LNewAttrib and FILE_ATTRIBUTE_HIDDEN) = 0 then begin
      LNewAttrib := LNewAttrib or  FILE_ATTRIBUTE_HIDDEN;
    end;
  end else begin
    if (LNewAttrib and FILE_ATTRIBUTE_HIDDEN) <> 0 then begin
      LNewAttrib := LNewAttrib xor FILE_ATTRIBUTE_HIDDEN;
    end;
  end;
  if (LOldAttrib and LNewAttrib) <> 0 then begin
    FFileObjet.Attributes := LNewAttrib;
  end;

  //フォルダの名前を変更
  if LOldFileName <> LblEdit2.Text then begin
    FFileObjet.Name := LblEdit2.Text;
    LblEdit1.Text   := FFileObjet.Path;
  end;
end;

end.


ファイルの属性変更方法として,次のようなコーディングも考えられます.
これは,変更対象の属性だけを全てをクリアして,チェックボックスがチェックしてあれば,該当するその属性だけ有効にする方法です.


リスト2
属性変更の別の方法
  //変更対象以外の属性は元のままとして,変更対象の属性をクリアしてしまう
  LOldAttrib := FFileObjet.Attributes;
  LNewAttrib := LOldAttrib and not FILE_ATTRIBUTE_READONLY
                           and not FILE_ATTRIBUTE_HIDDEN
                           and not FILE_ATTRIBUTE_SYSTEM
                           and not FILE_ATTRIBUTE_ARCHIVE;

  if ChkBox1.Checked then LNewAttrib := LNewAttrib or FILE_ATTRIBUTE_READONLY;
  if ChkBox2.Checked then LNewAttrib := LNewAttrib or FILE_ATTRIBUTE_HIDDEN;
  if ChkBox3.Checked then LNewAttrib := LNewAttrib or FILE_ATTRIBUTE_SYSTEM;
  if ChkBox4.Checked then LNewAttrib := LNewAttrib or FILE_ATTRIBUTE_ARCHIVE;

  //属性変更
  FFileObjet.Attributes := LNewAttrib;




02_フォルダの情報を取得


IFolder オブジェクトを使用して,フォルダの情報を取得して表示します.
フォルダ名の変更が可能です.


図4
設計時画面
図5
実行結果例
  • リストボックスにフォルダ内のファイルをリスト (フォルダは除外)
  • 大きなサイズのフォルダを選択すると,非常に時間がかかる

リスト3
フォルダの情報を取得
unit FoldderInfoUnit;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Panel2: TPanel;
    ChkBox1: TCheckBox;
    ChkBox2: TCheckBox;
    ChkBox3: TCheckBox;
    ChkBox4: TCheckBox;
    LblEdit1: TLabeledEdit;
    LblEdit2: TLabeledEdit;
    LblEdit3: TLabeledEdit;
    LblEdit4: TLabeledEdit;
    LblEdit5: TLabeledEdit;
    LblEdit6: TLabeledEdit;
    LblEdit7: TLabeledEdit;
    LblEdit8: TLabeledEdit;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    FFileSystem   : IFileSystem3;
    FFolderObject : IFolder;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses FileCtrl, ActiveX;

{$R *.dfm}

//=============================================================================
//  ファイルシステムオブジェクト(IFileSystem)生成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  FFileSystem := CoFileSystemObject.Create;

  Button2.Enabled := False;
end;

//=============================================================================
//  生成したオブジェクトをnilに
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(FFileSystem)   then FFileSystem   := nil;
  if Assigned(FFolderObject) then FFolderObject := nil;
end;

//=============================================================================
//  フォルダを選択して情報取得
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//
//  ファイルの列挙もテストしてみたが列挙には向いていないのかも知れない
//  システム関係のファイルの取得には失敗する場合がある
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBasePath   : String;
  LFolderSize : Int64;
  LFineCount  : Integer;
  LAttrib     : Cardinal;
  LDateFormat : String;
  LEnumRow    : IEnumVariant;
  LRowObj     : OleVariant;
  LValue      : Cardinal;
  i           : Integer;
begin
  if SelectDirectory('対象フォルダ選択', '', LBasePath, []) then begin
    Button1.Enabled := False;
    Button2.Enabled := False;

    //ファイルオブジェクト(IFile)生成
    FFolderObject := FFileSystem.GetFolder(LBasePath);
    //ドライブを指定すると空(仕様か?)
    if FFolderObject.Name = '' then exit;

    LblEdit1.Text := '';
    LblEdit2.Text := '';
    LblEdit3.Text := '';
    LblEdit4.Text := '';
    LblEdit5.Text := '';
    LblEdit6.Text := '';
    LblEdit7.Text := '';

    //選択したファイルのフルパス
    LblEdit1.Text := FFolderObject.Path;
    //ファイル名
    LblEdit2.Text := FFolderObject.Name;
    //ファイル種類
    LblEdit3.Text := FFolderObject.type_;
    //サイズ
    LFolderSize   := FFolderObject.Size / 1024;
    LblEdit4.Text := FormatFloat('###,##0 KB', LFolderSize);
    //ファイル数(フォルダも含む)
    LFineCount    := FFolderObject.Files.Count+FFolderObject.SubFolders.Count;
    LblEdit5.Text := FormatFloat('###,##0 ', LFineCount);
    //作成日時
    LDateFormat   := 'yyyy/mm/dd hh:nn:ss';
    LblEdit6.Text := FormatDateTime(LDateFormat, FFolderObject.DateCreated);
    //更新日時
    LblEdit7.Text := FormatDateTime(LDateFormat, FFolderObject.DateLastModified);
    //アクセス日時
    LblEdit8.Text := FormatDateTime(LDateFormat, FFolderObject.DateLastAccessed);

    //属性
    LAttrib := FFolderObject.Attributes;
    ChkBox1.Checked := Bool(LAttrib and FILE_ATTRIBUTE_READONLY);
    ChkBox2.Checked := Bool(LAttrib and FILE_ATTRIBUTE_HIDDEN);
    ChkBox3.Checked := Bool(LAttrib and FILE_ATTRIBUTE_SYSTEM);
    ChkBox4.Checked := Bool(LAttrib and FILE_ATTRIBUTE_ARCHIVE);

    //リストボックスのフォルダ内のファイル名だけをリスト
    //サブフォルダ数やファイル数が多いと時間がかかるが,続けて同じフォルダ
    //を指定するとそこそこ速い(キャッシャが効くのか?)
    Screen.Cursor := crHourGlass;
    ListBox1.Items.Clear;
    ListBox1.Items.BeginUpdate;

    //フォルダオブジェクトを列挙(Enum)する
    LEnumRow := FFolderObject.Files._NewEnum as IEnumVariant;
    for i := 0 to FFolderObject.Files.Count - 1 do begin
      //次の1つだけ取出す
      //Valueの戻り値が0以下であればもうない
      //RowObjがIFileオブジェクト
      LEnumRow.Next(1, LRowObj, LValue);
      if LValue <= 0 then break;

      ListBox1.Items.Add(LRowObj.Name);
      Application.ProcessMessages;
    end;
    ListBox1.Items.EndUpdate;
    Screen.Cursor := crDefault;

    Button1.Enabled := True;
    Button2.Enabled := True;
  end;
end;

//=============================================================================
//  フォルダの名前と属性変更
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LOldfileName : String;
  LOldAttrib   : Cardinal;
  LNewAttrib   : Cardinal;
begin
  if FFolderObject = nil then exit;

  LOldfileName := FFolderObject.Name;

  //ファイル属性の変更.変更がなければ更新しないようにする
  LOldAttrib := FFolderObject.Attributes;
  LNewAttrib := LOldAttrib;
  //読出し専用
  if ChkBox1.Checked then begin
    if (LNewAttrib and FILE_ATTRIBUTE_READONLY) = 0 then begin
      LNewAttrib := LNewAttrib or FILE_ATTRIBUTE_READONLY;
    end;
  end else begin
    if (LNewAttrib and FILE_ATTRIBUTE_READONLY) <> 0 then begin
      LNewAttrib := LNewAttrib xor FILE_ATTRIBUTE_READONLY;
    end;
  end;
  //隠し属性
  if ChkBox2.Checked then begin
    if (LNewAttrib and FILE_ATTRIBUTE_HIDDEN) = 0 then begin
      LNewAttrib := LNewAttrib or  FILE_ATTRIBUTE_HIDDEN;
    end;
  end else begin
    if (LNewAttrib and FILE_ATTRIBUTE_HIDDEN) <> 0 then begin
      LNewAttrib := LNewAttrib xor FILE_ATTRIBUTE_HIDDEN;
    end;
  end;
  if (LOldAttrib and LNewAttrib) <> 0 then begin
    FFolderObject.Attributes := LNewAttrib;
  end;

  //フォルダの名前を変更
  if LOldfileName <> LblEdit2.Text then begin
    FFolderObject.Name := LblEdit2.Text;
    LblEdit1.Text      := FFolderObject.Path;
  end;
end;

end.




03_ドライブの情報を取得


IDriveCollection, IDrive オブジェクトを使用して,ドライブのリストとその情報を取得して表示します.DVD, USB 等の区別はないようです.


図6
設計時画面
  • あらかじめ表示項目 (列) を作成しておく
図7
実行結果例
  • CD-ROMドライブに CD が挿入されていれば準備完了となる

リスト4
ドライブの情報を取得
unit DriveInfoUnit;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    ListView1: TListView;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FFileSystemj : IFileSystem3;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  FileCtrl,
  ActiveX;

{$R *.dfm}

//=============================================================================
//  ファイルシステムオブジェクト(IFileSystem)生成
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  FFileSystemj := CoFileSystemObject.Create;
end;

//=============================================================================
//  生成したオブジェクトをnilに
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(FFileSystemj) then FFileSystemj := nil;
end;

//=============================================================================
//  ドライブのリストを作成
//  VolumeNameは何故か[ボリューム]という文字列しか取得できないので取得中止
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDrivesObj : IDriveCollection;
  LDriveObj  : IDrive;
  LEnumRow   : IEnumVariant;
  LRowObj    : OleVariant;
  LValue     : Cardinal;
  LItem      : TListItem;
  LDriveType : Integer;
  LDriveSize : Double;
  i          : Integer;
begin
  //ドライブ列挙オブジェクト(IDrives)生成
  LDrivesObj := FFileSystemj.Drives;
  try
    ListView1.Items.Clear;
    Screen.Cursor := crHourGlass;
    ListView1.Items.BeginUpdate;

    //ドライブオブジェクトを列挙(Enum)する
    LEnumRow := LDrivesObj._NewEnum as IEnumVariant;
    for i := 0 to LDrivesObj.Count - 1 do begin
      //次の1つだけ取出す
      //Valueの戻り値が0以下であればもうない
      //RowObjがIDriveオブジェクト
      LEnumRow.Next(1, LRowObj, LValue);
      if LValue <= 0 then break;

      //ドライブ名を取出して,後の操作のためにIDriveオブジェクトとして再取得
      LDriveObj := FFileSystemj.GetDrive(LRowObj.DriveLetter);

      //ListViewのItemを追加して各ドライブの情報を表示
      LItem := ListView1.Items.Add;
      //ドライブ名
      LItem.Caption := LDriveObj.DriveLetter;

      //ドライブの種類
      LDriveType := LDriveObj.DriveType;
      if LDriveType = 0 then begin
        LItem.SubItems.Add('不明');
      end else
      if LDriveType = 1 then begin
        LItem.SubItems.Add('リムーバブルディスク');
      end else
      if LDriveType = 2 then begin
        LItem.SubItems.Add('ハードディスク');
      end else
      if LDriveType = 3 then begin
        LItem.SubItems.Add('ネットワークドライブ');
      end else
      if LDriveType = 4 then begin
        LItem.SubItems.Add('CD-ROMドライブ');
      end else
      if LDriveType = 5 then begin
        LItem.SubItems.Add('RAMディスク');
      end else begin
        LItem.SubItems.Add('');
      end;

      //ドライブの準備状態.この検出には少し時間がかかる
      if LDriveObj.IsReady then begin
        LItem.SubItems.Add('準備完了');
        //合計サイズ
        LDriveSize := LDriveObj.TotalSize / 1024 / 1024 / 1024;
        LItem.SubItems.Add(FormatFloat('###,##0.0 GB', LDriveSize));
        //空き容量
        LDriveSize := LDriveObj.FreeSpace / 1024 / 1024 / 1024;
        LItem.SubItems.Add(FormatFloat('###,##0.0 GB', LDriveSize));
      end else begin
        LItem.SubItems.Add('');
        LItem.SubItems.Add('');
        LItem.SubItems.Add('');
      end;

      Application.ProcessMessages;
    end;
    ListView1.Items.EndUpdate;
    Screen.Cursor := crDefault;
  finally
    if Assigned(LDrivesObj) then LDrivesObj := nil;
    if Assigned(LDriveObj)  then LDriveObj  := nil;
  end;
end;

end.




04_タイプライブラリを使用しない場合


タイプライブラリを使用しないで,OleVariant 型で FileSystemObject を利用するには,以下のコードのように,CreateOleObject でオブジェクトを生成します.
ProgID は Scripting.FileSystemObject とします.


リスト5
タイプライブラリの取り込みをしないで FileSystemObect を使用する方法
implementation

uses
  ComObj;

{$R *.dfm}

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

//=============================================================================
//  ファイルを選択して情報取得
//  usesにComObjが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileSystemObj : OleVariant;
  LFileObj       : OleVariant;
  LFormat        : string;
  LText          : string;
begin
  OpenDialog1.OptionsEx  := [];
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

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

  //FileSystemObjectオブジェクト(IFileSystem)生成
  LFileSystemObj := CreateOleObject('Scripting.FileSystemObject');
  //ファイルオブジェクト(IFile)取得
  LFileObj := LFileSystemObj.GetFile(OpenDialog1.FileName);

  //更新日時(最終書き込み日時)を取得
  //IFile.DateLastModifiedはミリ秒は取得できない(0になる)
  LFormat := 'yyyy/mm/dd hh:nn:ss.zzz';
  LText   := FormatDateTime(LFormat, LFileObj.DateLastModified);

  MessageBox(Handle, PChar(LText), '', MB_ICONINFORMATION);

  LFileObj := unassigned;
  LFileSystemObj := unassigned;
end;




05_ディレクトリとフォルダ


当サイトでは,ディレクトリとフォルダはほとんど区別なしに用いていますが,Windows では「ディレクトリ」は,記憶媒体上のファイルの保存場所で,「フォルダ」は「オブジェクトの入れ物」のような意味で使われています.

エクスプローラに [ライブラリ] とか [ピクチャー] とかいうフォルダがありますが,これらのフォルダ名はディレクトリ名ではなく,実体は,ディスク上の別のディレクトリ内にあります.ディスク上には [ライブラリ] というディレクトリ名は存在しません.
実際のところ,ディレクトリをフォルダと言っても差支えないでしょう.なぜなら「ファイル」や「フォルダ」というオブジェクトを入れておく物であることには間違いありません.

通常は意識する必要はないと思いますが,ファイルやフォルダの操作を対象にするアプリケーションでは意識する必要があるかも知れません.