unit FileProperties_DSOFileUnit;

interface

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

type
  TForm1 = class(TForm)
    btnRead: TButton;
    btnSave: TButton;
    Panel1: TPanel;
    OpenDialog1: TOpenDialog;
    lblEdit01: TLabeledEdit;
    lblEdit02: TLabeledEdit;
    lblEdit03: TLabeledEdit;
    lblEdit04: TLabeledEdit;
    lblEdit05: TLabeledEdit;
    lblEdit06: TLabeledEdit;
    Panel2: TPanel;
    lblEdit11: TLabeledEdit;
    lblEdit12: TLabeledEdit;
    lblEdit13: TLabeledEdit;
    OleDocumentProperties1: TOleDocumentProperties;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnReadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
  private
    { Private 宣言 }
    BasePath : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

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

  //プロパティ保存ボタンは使用不可に
  //作成日等はDSOFileでは変更不可なのでDisableに
  btnSave.Enabled := False;
  Panel2.Enabled  := False;
end;

//=============================================================================
//  終了処理
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //現在のドキュメントオブジェクトを閉じる
  try
    OleDocumentProperties1.Close(False);
  except
    //DSOFileがインストールされていないPCでは実行できない
  end;
end;

//=============================================================================
//  ファイルのプロパティを読出して表示
//
//  DSOFileによるプロパティの読書きは，対象ファイルを他で操作している場合は実行
//  できない(例えば対象ワード文書を開いている時等)．ロック違反となる
//
//  DSOFileで読出した日付はワードやエクセルのプロパティ
//  エクスプローラの[プロパティ][概要]タブの原作者のところの日付で，[全般]タブ
//  に表示されている日付ではない
//  Shellオブジェクトによる日付取得の場合は，[全般]タブの日付
//=============================================================================
procedure TForm1.btnReadClick(Sender: TObject);
var
  DateTime11 : TDateTime;
  DateTime12 : TDateTime;
  DateTime13 : TDateTime;
begin
  OpenDialog1.InitialDir := BasePath;
  if OpenDialog1.Execute then begin
    Update;
    //プロパティを保存しないで現在のドキュメントオブジェクトを閉じる
    try
      OleDocumentProperties1.Close(False);
    except
      //DSOFileがインストールされていないPCでは実行できない
      exit;
    end;

    lblEdit01.Text := '';
    lblEdit02.Text := '';
    lblEdit03.Text := '';
    lblEdit04.Text := '';
    lblEdit05.Text := '';
    lblEdit06.Text := '';
    lblEdit11.Text := '';
    lblEdit12.Text := '';
    lblEdit13.Text := '';

    OleDocumentProperties1.Open(OpenDialog1.FileName, //フルパス名
                                False,                //書込みを行うのでFalse
                                0);                   //オプション(0はdefault)

    //各コントロール(TLabeledEdit)にプロパティを表示
    Panel1.Caption := ExtractFileName(OpenDialog1.FileName);
    lblEdit01.Text := OleDocumentProperties1.SummaryProperties.Title;
    lblEdit02.Text := OleDocumentProperties1.SummaryProperties.Subject;
    lblEdit03.Text := OleDocumentProperties1.SummaryProperties.Company;
    lblEdit04.Text := OleDocumentProperties1.SummaryProperties.Author;
    lblEdit05.Text := OleDocumentProperties1.SummaryProperties.LastSavedBy;
    lblEdit06.Text := OleDocumentProperties1.SummaryProperties.Comments;

    DateTime11 := OleDocumentProperties1.SummaryProperties.DateCreated;
    DateTime12 := OleDocumentProperties1.SummaryProperties.DateLastSaved;
    DateTime13 := OleDocumentProperties1.SummaryProperties.DateLastPrinted;
    if DateTime11 > 0 then
      lblEdit11.Text := FormatDateTime('yyyy年mm月dd日 hh時mm分', DateTime11);
    if DateTime12 > 0 then
      lblEdit12.Text := FormatDateTime('yyyy年mm月dd日 hh時mm分', DateTime12);
    if DateTime13 > 0 then
      lblEdit13.Text := FormatDateTime('yyyy年mm月dd日 hh時mm分', DateTime13);
     btnSave.Enabled := True;
  end;
end;

//=============================================================================
//  各コントロール(TLabeledEdit)に表示中のプロパティを保存する
//=============================================================================
procedure TForm1.btnSaveClick(Sender: TObject);
begin
  OleDocumentProperties1.SummaryProperties.Title       := lblEdit01.Text;
  OleDocumentProperties1.SummaryProperties.Subject     := lblEdit02.Text;
  OleDocumentProperties1.SummaryProperties.Company     := lblEdit03.Text;
  OleDocumentProperties1.SummaryProperties.Author      := lblEdit04.Text;
  OleDocumentProperties1.SummaryProperties.LastSavedBy := lblEdit05.Text;
  OleDocumentProperties1.SummaryProperties.Comments    := lblEdit06.Text;
  OleDocumentProperties1.Save;
end;

end.

unit FileProperties_DSOFile_CustomUnit;

interface

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

type
  TForm1 = class(TForm)
    btnRead: TButton;
    btnSave: TButton;
    Panel1: TPanel;
    OpenDialog1: TOpenDialog;
    lblEdit01: TLabeledEdit;
    lblEdit02: TLabeledEdit;
    lblEdit03: TLabeledEdit;
    lblEdit04: TLabeledEdit;
    lblEdit05: TLabeledEdit;
    lblEdit06: TLabeledEdit;
    FileProp: TOleDocumentProperties;
    btnDelete: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnReadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    { Private 宣言 }
    BasePath : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

  btnSave.Enabled   := False;
  btnDelete.Enabled := False;
end;

//=============================================================================
//  終了処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  //現在のドキュメントオブジェクトを閉じる
  try
    FileProp.Close(False);
  except
    //DSOFileがインストールされていないPCでは実行できない
  end;
end;

//=============================================================================
//  ファイルのプロパティを読出して表示
//=============================================================================
procedure TForm1.btnReadClick(Sender: TObject);
var
  HasCustomProp : Boolean;
  APropName     : OleVariant;
  i             : Integer;
  AValue        : OleVariant;
begin
  HasCustomProp := False;

  OpenDialog1.InitialDir := BasePath;
  if OpenDialog1.Execute then begin
    //プロパティを保存しないで現在のドキュメントオブジェクトを閉じる
    try
      FileProp.Close(False);
    except
      //DSOFileがインストールされていないPCでは実行できない
      MessageDlg('DSOFileをインストールしないと利用できません．',
                 mtInformation,[mbOK],0);
      exit;
    end;

    lblEdit01.Text := '';
    lblEdit02.Text := '';
    lblEdit03.Text := '';
    lblEdit04.Text := '';
    lblEdit05.Text := '';
    lblEdit06.Text := '';
    Update;
    FileProp.Open(OpenDialog1.FileName,   //対象ファイルのフルパス名
                  False,                  //書込みを行うのでFalse
                  0);                     //オプション(0はdefault)

    //各コントロール(TLabeledEdit)にプロパティを表示
    Panel1.Caption := ExtractFileName(OpenDialog1.FileName);
    lblEdit01.Text := FileProp.SummaryProperties.Title;
    lblEdit02.Text := FileProp.SummaryProperties.Subject;
    lblEdit03.Text := FileProp.SummaryProperties.Company;

    //カスタムプロパティの存在を調査してあれば値を表示
    for i := 0 to FileProp.CustomProperties.Count - 1 do begin
      APropName := FileProp.CustomProperties.Item[i].Name;
      if APropName = '送付先' then begin
        HasCustomProp  := True;
        AValue         := FileProp.CustomProperties.Item[APropName].Get_Value;
        lblEdit04.Text := AValue;
      end else
      if APropName = '送付部数' then begin
        HasCustomProp  := True;
        AValue         := FileProp.CustomProperties.Item[APropName].Get_Value;
        if AValue <> 0 then lblEdit05.Text := AValue;
      end else
      if APropName = '送付日' then begin
        HasCustomProp  := True;
        AValue         := FileProp.CustomProperties.Item[APropName].Get_Value;
        if AValue <> 0 then lblEdit06.Text := AValue;
      end;
    end;

    btnSave.Enabled   := True;
    btnDelete.Enabled := HasCustomProp;
  end;
end;

//=============================================================================
//  各コントロール(TLabeledEdit)に表示中のプロパティを保存する
//
//  カスタムプロパティの設定は以下の様に行う
//  CustomProperties.Item[プロパティ名].Set_Value(値);
//  存在しないプロパティに対して実行するとエラー
//  日付型の値は，日付型の書式にしたがってTLabledEditに入力しておく
//  (デフォルトではyyyy/mm/dd)
//  プロパティの型に使用可能なものは以下の通り
//  ----------------------------
//    データ型             値
//  ----------------------------
//    数値型               1
//    ブール型 (Yes/No)    2
//    日付型               3
//    文字列型             4
//=============================================================================
procedure TForm1.btnSaveClick(Sender: TObject);
var
  HasCustomProp   : Boolean;
  PropertyNumber  : OleVariant;
  PropertyBoolean : OleVariant;
  PropertyDate    : OleVariant;
  PropertyString  : OleVariant;
  AName           : OleVariant;
  ACount          : OleVariant;
  ADate           : OleVariant;
  i               : Integer;
  APropName       : OleVariant;
begin
  //カスタムプロパティの定数値
  PropertyNumber  := 1;
  PropertyBoolean := 2;
  PropertyDate    := 3;
  PropertyString  := 4;

  //それらの値
  AName  := lblEdit04.Text;
  ACount := StrToIntDef(lblEdit05.Text,0);
  try
    ADate  := StrToDate(lblEdit06.Text);
  except
    ADate := 0;
  end;

  FileProp.SummaryProperties.Title       := lblEdit01.Text;
  FileProp.SummaryProperties.Subject     := lblEdit02.Text;
  FileProp.SummaryProperties.Company     := lblEdit03.Text;
  FileProp.SummaryProperties.LastSavedBy := 'Mr.XRAY';

  //APropListのカスタムプロパティがなければ作成
  //作成したら保存しないと有効にならない
  HasCustomProp := False;
  for i := 0 to FileProp.CustomProperties.Count - 1 do begin
    APropName := FileProp.CustomProperties.Item[i].Name;
    if APropName = '送付先' then begin
      HasCustomProp := True;
      break;
    end;
  end;

  //プロパティがない場合
  if HasCustomProp = False then begin
    FileProp.CustomProperties.Add('送付先'  , PropertyString);
    FileProp.CustomProperties.Add('送付部数', PropertyNumber);
    FileProp.CustomProperties.Add('送付日'  , PropertyDate);
    FileProp.Save;
  end;

  //カスタムプロパティの値を設定
  FileProp.CustomProperties.Item['送付先'].  Set_Value(AName);
  FileProp.CustomProperties.Item['送付部数'].Set_Value(ACount);
  FileProp.CustomProperties.Item['送付日'].  Set_Value(ADate);
  FileProp.Save;

  btnDelete.Enabled := HasCustomProp;
end;

//=============================================================================
//  カスタムプロパティを全て削除
//  このコードでは全てのカスタムプロパティを削除してしまうので要注意
//
//  Item番号の代わりにプロパティ名での指定でも可能
//=============================================================================
procedure TForm1.btnDeleteClick(Sender: TObject);
var
  i : Integer;
begin
  for i := FileProp.CustomProperties.Count - 1 downto 0 do begin
    FileProp.CustomProperties.Item[i].Remove;
  end;
  FileProp.Save;
end;

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

   ListView1.Column[1].AutoSize := True;
end;

//=============================================================================
//  Folderオブジェクトのプロパティ名とその値をリスト
//  RIFF情報の一部も取得できる
//  プロパティのリストとプロパティ名はPCの環境によって異なる
//
//  Shellオブジェクトで取得するプロパティは取得順番によって種類が決まっている
//  したがって，プロパティの何番目かを指定しても取得できる
//  ただし，ファイルの種類によって，同じ番号でも異なるプロパティのことがある
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFolderPath  : String;
  AFilePath    : String;
  SHFolder     : Shell32_TLB.Folder;
  SHFolderItem : Shell32_TLB.FolderItem;
  i            : Integer;
  AValue       : WideString;
  PropNoList   : TStringList;
begin
  OpenDialog1.InitialDir := BasePath;

  if OpenDialog1.Execute then begin
    BasePath := ExtractFilePath(OpenDialog1.FileName);

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

    PropNoList  := TStringList.Create;
    AFilePath   := OpenDialog1.FileName;
    AFolderPath := ExtractFilePath(AFilePath);
    SHFolder    := Shell1.NameSpace(AFolderPath);

    try
      //SHFolderオブジェクトのプロパティ名リストを取得
      //予め項目数を取得する方法はないようなので，適当な値だけループ
      for i := 0 to 1000 do begin
        AValue := SHFolder.GetDetailsOf(varNull, i);
        if AValue = '' then break;

        ListView1.Items.Add.Caption := FormatFloat('00 ', i) + AValue;
        PropNoList.Add(IntToStr(i));
      end;

      //OpenDialogで選択したファイルのFolderItemオブジェクトを取得
      SHFolderItem := SHFolder.ParseName(ExtractFileName(AFilePath));

      //ツールチップで表示される文字列
      Memo1.Lines.Text := SHFolder.GetDetailsOf(SHFolderItem, -1);

      //そのFolderItemのプロパティ値を順番に取得
      for i := 0 to PropNoList.Count - 1 do begin
        AValue := SHFolder.GetDetailsOf(SHFolderItem,StrToInt(PropNoList[i]));
        ListView1.Items[i].SubItems.Text := AValue;
      end;
    finally
      FreeAndNil(PropNoList);
    end;
    ListView1.Items.EndUpdate;
  end;
end;

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses StrUtils, Types;

{$R *.dfm}

//=============================================================================
//  初期設定
//  選択フォルダの初期値を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
   BasePath := '../';
   BasePath := ExpandFileName(BasePath);

   ListView1.Column[1].AutoSize := True;
end;

//=============================================================================
//  Folderオブジェクトのプロパティ名とその値をリスト
//  RIFF情報の一部も取得できる
//  プロパティのリストとプロパティ名はPCの環境によって異なる
//
//  Shellオブジェクトで取得するプロパティは取得順番によって種類が決まっている
//  したがって，プロパティの何番目かを指定しても取得できる
//  ただし，ファイルの種類によって，同じ番号でも異なるプロパティのことがある
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFolderPath  : String;
  AFilePath    : String;
  SHFolder     : Shell32_TLB.Folder;
  SHFolderItem : Shell32_TLB.FolderItem;
  i            : Integer;
  AValue       : String;
  PropNoList   : TStringList;
  StrArray     : TStringDynArray;
  StrText      : String;
begin
  OpenDialog1.InitialDir := BasePath;

  if OpenDialog1.Execute then begin
    BasePath := ExtractFilePath(OpenDialog1.FileName);

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

    PropNoList  := TStringList.Create;
    AFilePath   := OpenDialog1.FileName;
    AFolderPath := ExtractFilePath(AFilePath);
    SHFolder    := Shell1.NameSpace(AFolderPath);

    try
      //SHFolderオブジェクトのプロパティ名リストを取得
      //予め項目数を取得する方法はないようなので，適当な値だけループ
      for i := 0 to 1000 do begin
        AValue := SHFolder.GetDetailsOf(varNull, i);
        if AValue = '' then break;

        ListView1.Items.Add.Caption := FormatFloat('00 ', i) + AValue;
        PropNoList.Add(IntToStr(i));
      end;

      //OpenDialogで選択したファイルのFolderItemオブジェクトを取得
      SHFolderItem := SHFolder.ParseName(ExtractFileName(AFilePath));

      //ツールチップで表示される文字列
      Memo1.Lines.Text := SHFolder.GetDetailsOf(SHFolderItem, -1);

      //そのFolderItemのプロパティ値を順番に取得
      for i := 0 to PropNoList.Count - 1 do begin
        AValue := SHFolder.GetDetailsOf(SHFolderItem,StrToInt(PropNoList[i]));
        ListView1.Items[i].SubItems.Text := AValue;
      end;
    finally
      FreeAndNil(PropNoList);
    end;
    ListView1.Items.EndUpdate;

    //---------------------------------------------------------------------
    //  追加部分
    //  画像サイズのプロパティを縦と横に分解して表示
    //  TStringDynArrayの使用には，usseにTypesが必要
    //---------------------------------------------------------------------

    //31は画像ファイルのサイズの文字列の取得(例: 640X480)
    AValue := SHFolder.GetDetailsOf(SHFolderItem, 31);
    //非表示文字を削除
    for i := Length(AValue) downto 1 do begin
      if CharInSet(AValue[i], [Chr(0)..Chr(32)]) then Delete(AValue, i, 1);
    end;
    if Trim(AValue) <> '' then begin
      StrArray := SplitString(AValue, 'x');
      StrText  := Trim(StrArray[0]) + sLineBreak + Trim(StrArray[1]);
      MessageBox(Handle, PChar(StrText), '画像サイズ', MB_OK);
    end;
    //---------------------------------------------------------------------
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Shell1: TShell;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    BasePath : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses StrUtils;

{$R *.dfm}

//=============================================================================
//  初期設定
//  選択フォルダの初期値を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
   BasePath := '../';
   BasePath := ExpandFileName(BasePath);
end;

//=============================================================================
//  画像ファイルの画像サイズを取得して表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFolderPath  : String;
  AFilePath    : String;
  SHFolder     : Shell32_TLB.Folder;
  SHFolderItem : Shell32_TLB.FolderItem;
  i            : Integer;
  XValue       : String;
  YValue       : String;
  StrText      : String;
begin
  OpenDialog1.InitialDir := BasePath;

  if OpenDialog1.Execute then begin
    BasePath := ExtractFilePath(OpenDialog1.FileName);

    AFilePath   := OpenDialog1.FileName;
    AFolderPath := ExtractFilePath(AFilePath);
    SHFolder    := Shell1.NameSpace(AFolderPath);

    //OpenDialogで選択したファイルのFolderItemオブジェクトを取得
    SHFolderItem := SHFolder.ParseName(ExtractFileName(AFilePath));

    //162は画像の幅
    XValue := SHFolder.GetDetailsOf(SHFolderItem, 162);
    //164は画像の高さ
    YValue := SHFolder.GetDetailsOf(SHFolderItem, 164);
    //数字以外を削除
    for i := Length(XValue) downto 1 do begin
      if not CharInSet(XValue[i], ['0'..'9']) then Delete(XValue, i, 1);
    end;
    for i := Length(YValue) downto 1 do begin
      if not CharInSet(YValue[i], ['0'..'9']) then Delete(YValue, i, 1);
    end;

    StrText := Trim(XValue) + sLineBreak + Trim(YValue);
    if Trim(XValue) <> '' then begin
      MessageBox(Handle, PChar(StrText), '画像サイズ', MB_OK);
    end;
  end;
end;

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  初期設定
//  選択フォルダの初期値を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
   BasePath := '../';
   BasePath := ExpandFileName(BasePath);
end;

//=============================================================================
//  画像ファイルの画像サイズを取得して表示
//  TWICImageはDelphi 2010以降で使用可能
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFilePath : String;
  WIC       : TWICImage;
  StrText   : String;
begin
  OpenDialog1.InitialDir := BasePath;

  if OpenDialog1.Execute then begin
    BasePath := ExtractFilePath(OpenDialog1.FileName);
    AFilePath   := OpenDialog1.FileName;

    //TWICImageの対象画像ファイルはBitmap/Jpeg/GIF/PNG/Tiff etc.
    WIC := TWICImage.Create;
    try
      WIC.LoadFromFile(AFilePath);
      //画像ファイルがJPEGの時だけ処理
      if WIC.ImageFormat = wifJpeg then begin
        StrText := IntToStr(WIC.Width) + sLineBreak + IntToStr(WIC.Height);
        MessageBox(Handle, PChar(StrText), '画像サイズ', MB_OK);
      end;
    finally
      WIC.Free;
    end;
  end;
end;

end.

unit ExtendedProperty_ShellUnit;

interface

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

type
  TForm1 = class(TForm)
    btnRead: TButton;
    Panel1: TPanel;
    OpenDialog1: TOpenDialog;
    Panel2: TPanel;
    lblEdit01: TLabeledEdit;
    lblEdit02: TLabeledEdit;
    lblEdit03: TLabeledEdit;
    lblEdit04: TLabeledEdit;
    lblEdit05: TLabeledEdit;
    lblEdit06: TLabeledEdit;
    lblEdit11: TLabeledEdit;
    lblEdit12: TLabeledEdit;
    lblEdit13: TLabeledEdit;
    Shell1: TShell;
    procedure FormCreate(Sender: TObject);
    procedure btnReadClick(Sender: TObject);
  private
    { Private 宣言 }
    BasePath : String;
    function CreatePropStr(GUID: TGUID; ID: Integer): WideString;
    function UTCTimeDateTimeOffset: TDateTime;    
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses plFileInfo_Const, ActiveX;

{$R *.dfm}

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

  //Shellオブジェクトによるプロパティは読出し専用なのでDisableに
  Panel2.Enabled  := False;
end;

//=============================================================================
//  ファイルのプロパティを読出して表示
//  個々ののプロパティを取得するには，FolderItem2オブジェクトのExtendedProperty
//  メソッドを使用する．Extended(拡張)となっているが，このExtendedの意味は不明
//
//  FMTID_XXXXで取得するプロパティ値は構造化ストレージの値なので，対象ファイル
//  が構造化ストレージをサポートしていて，プロパティが格納されていなければ取得
//  できない．つまりRIFF情報は取得できない．
//=============================================================================
procedure TForm1.btnReadClick(Sender: TObject);
var
  AFolderPath   : String;
  AFileName     : String;
  SHFolderItem2 : Shell32_TLB.FolderItem2;
  PropStr       : WideString;
  AValue        : OleVariant;
  ADate         : TDateTime;
begin
  OpenDialog1.InitialDir := BasePath;
  if OpenDialog1.Execute then begin
    lblEdit01.Text := '';
    lblEdit02.Text := '';
    lblEdit03.Text := '';
    lblEdit04.Text := '';
    lblEdit05.Text := '';
    lblEdit06.Text := '';
    lblEdit11.Text := '';
    lblEdit12.Text := '';
    lblEdit13.Text := '';
    Update;

    AFolderPath   := ExtractFilePath(OpenDialog1.FileName);
    AFileName     := ExtractFileName(OpenDialog1.FileName);
    SHFolderItem2 := FolderItem2(Shell1.NameSpace(AFolderPath).
                                   ParseName(AFileName));
    Panel1.Caption := AFileName;

    //タイトル
    PropStr := CreatePropStr(FMTID_SummaryInfo, PID_TITLE);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_BSTR then begin
      lblEdit01.Text := VarToStr(AValue);
    end;

    //サブタイトル
    PropStr := CreatePropStr(FMTID_SummaryInfo, PID_SUBJECT);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_BSTR then begin
      lblEdit02.Text := VarToStr(AValue);
    end;

    //会社名
    PropStr := CreatePropStr(FMTID_DocSummaryInfo, PID_COMPANY);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_BSTR then begin
      lblEdit03.Text := VarToStr(AValue);
    end;

    //作成者
    PropStr := CreatePropStr(FMTID_SummaryInfo, PID_AUTHOR);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_BSTR then begin
      lblEdit04.Text := VarToStr(AValue);
    end;

    //最終保存者
    PropStr := CreatePropStr(FMTID_SummaryInfo, PID_LASTAUTHOR);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_BSTR then begin
      lblEdit05.Text := VarToStr(AValue);
    end;

    //コメント
    PropStr := CreatePropStr(FMTID_SummaryInfo,PID_COMMENTS);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_BSTR then begin
      lblEdit06.Text := VarToStr(AValue);
    end;

    //作成日
    PropStr := CreatePropStr(FMTID_SummaryInfo, PID_CREATE_DTM);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_DATE then begin
      //UTCからローカル時刻に変換
      ADate := AValue + UTCTimeDateTimeOffset;
      lblEdit11.Text := DateTimeToStr(ADate);
    end;

    //最終更新日
    PropStr := CreatePropStr(FMTID_SummaryInfo, PID_LASTSAVE_DTM);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_DATE then begin
      //UTCからローカル時刻に変換
      ADate := AValue + UTCTimeDateTimeOffset;
      lblEdit12.Text := DateTimeToStr(ADate);
    end;

    //最終印刷日
    PropStr := CreatePropStr(FMTID_SummaryInfo, PID_LASTPRINTED);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_DATE then begin
      //UTCからローカル時刻に変換
      ADate := AValue + UTCTimeDateTimeOffset;
      lblEdit13.Text := DateTimeToStr(ADate);
    end;
  end;
end;

//=============================================================================
//  FolderItem2オブジェクトのExtendedPropertyメソッドの引数を作成．これは
//  プロパティのカテゴリのGUIDの文字列 + プロパティの種類の値
//  という形式となっている(間に半角の空白)
//=============================================================================
function TForm1.CreatePropStr(GUID: TGUID; ID: Integer): WideString;
begin
  Result :=GUIDToString(GUID) + ' ' + IntToStr(ID);
end;

//=============================================================================
//  FolderItme2オブジェクトのExtenedPropertyので取得する日付はUTC(世界協定時刻)
//  このUTCとローカルとの時刻差を求める関数
//
//  GetTimeZoneInformationでシステムから現在のタイムゾーンパラメータを取得
//  Bias値は世界協定時刻(UTC)時間とローカル時間との分差，つまり分なので，これを
//  TDateTime型に変換して返す
//  日本の場合は常に9:00:00
//=============================================================================
function TForm1.UTCTimeDateTimeOffset: TDateTime;
var
  TZ   : TTimeZoneInformation;
  Hour : Integer;
  Min  : Integer;
begin
  GetTimeZoneInformation(TZ);
  Hour   := ABS(TZ.Bias) div 60;
  Min    := ABS(TZ.Bias) mod 60;
  Result := EncodeTime(Hour, Min, 0, 0);
end;

end.

    //最終更新日
    PropStr := CreatePropStr(FMTID_SummaryInfo, PID_LASTSAVE_DTM);
    AValue  := SHFolderItem2.ExtendedProperty(PropStr);
    if TVariantArg(AValue).vt = VT_DATE then begin
      //UTCからローカル時刻に変換
      ADate := TTimeZone.Local.ToLocalTime(AValue);
      lblEdit12.Text := DateTimeToStr(ADate);
    end;

unit FileProperties_StorageUnit;

interface

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

type
  TForm1 = class(TForm)
    Bevel1: TBevel;
    OpenDialog1: TOpenDialog;
    btnSave: TButton;
    btnRead: TButton;
    lblEdit01: TLabeledEdit;
    lblEdit02: TLabeledEdit;
    lblEdit03: TLabeledEdit;
    lblEdit04: TLabeledEdit;
    lblEdit05: TLabeledEdit;
    lblEdit06: TLabeledEdit;
    lblEdit11: TLabeledEdit;
    lblEdit12: TLabeledEdit;
    lblEdit13: TLabeledEdit;
    Panel1: TPanel;
    procedure btnReadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    BasePath : String;
    AFileName: string;
    function GetStorage(const FileName: WideString;
        GUID_Type: TGUID; PID_Info: cardinal): string;
    function SetStorage(const FileName: WideString; GUID_Type: TGUID;
        PID_Info: cardinal; InfoStr: string): boolean;
    function SetStorageDate(const FileName: WideString; GUID_Type: TGUID;
        PID_Info: cardinal; ADateTime: TDateTime): boolean;
    function PropertyVariantToString(const Prop: TPropVariant): String;
    function ToDateTime(ATime: TFileTime): TDateTime;
    function ToFileTime(ATime: TDateTime): TFileTime;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses plFileInfo_Const;

{$R *.dfm}

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

//=============================================================================
//  プロパティ読出しボタン
//
//  FMTID_XXXXで取得するプロパティ値は構造化ストレージの値なので，対象ファイル
//  が構造化ストレージをサポートしてなければ取得できない．
//  ただし，サブストリーム(揮発性情報)に書込まれた内容は表示可能
//
//  MP3のID3タグ，デジカメのフォーマット形式であるExif，またマイクロソフトが定
//  めたRIFF形式(AVI,WAV,MID,ビットマップのDIB等)は独自の形式でプロパティ値を格
//  納しているため取得できない．
//  エクスプローラの[プロパティ][概要]タブにはこれらの値の一部が表示されるよう
//  になっている．またShellオブジェクトでもそれらの一部を取得できる
//=============================================================================
procedure TForm1.btnReadClick(Sender: TObject);
begin
  OpenDialog1.InitialDir := BasePath;
  if OpenDialog1.Execute then begin
    lblEdit01.Text := '';
    lblEdit02.Text := '';
    lblEdit03.Text := '';
    lblEdit04.Text := '';
    lblEdit05.Text := '';
    lblEdit06.Text := '';
    lblEdit11.Text := '';
    lblEdit12.Text := '';
    lblEdit13.Text := '';
    Update;

    AFileName := OpenDialog1.FileName;
    Panel1.Caption := ExtractFileName(AFileName);

    lblEdit01.Text:=GetStorage(AFileName, FMTID_SummaryInfo,    PID_TITLE);
    lblEdit02.Text:=GetStorage(AFileName, FMTID_SummaryInfo,    PID_SUBJECT);
    lblEdit03.Text:=GetStorage(AFileName, FMTID_DocSummaryInfo, PID_COMPANY);
    lblEdit04.Text:=GetStorage(AFileName, FMTID_SummaryInfo,    PID_AUTHOR);
    lblEdit05.Text:=GetStorage(AFileName, FMTID_SummaryInfo,    PID_LASTAUTHOR);
    lblEdit06.Text:=GetStorage(AFileName, FMTID_SummaryInfo,    PID_COMMENTS);
    lblEdit11.Text:=GetStorage(AFileName, FMTID_SummaryInfo,    PID_CREATE_DTM);
    lblEdit12.Text:=GetStorage(AFileName, FMTID_SummaryInfo,    PID_LASTSAVE_DTM);
    lblEdit13.Text:=GetStorage(AFileName, FMTID_SummaryInfo,    PID_LASTPRINTED);
  end;
end;

//=============================================================================
//  プロパティ書込みボタン
//  文字列型と日付型で処理分岐(TDateTimePickerを使用した方がいいかも)
//  各テキストの日付書式を変更しないこと
//
//  FMTID_XXXXで操作するプロパティ値は構造化ストレージの値なので，対象ファイル
//  が構造化ストレージをサポートしてなければ操作できない．
//  ただし，サブストリーム(揮発性情報)には書込みができる．たとえばテキストファ
//  イルにもこのbtnSaveClick内で指定する値を書込めるが，FindFirst等で取得する
//  値とは全く別の(構造化ストレージの性質)情報となる．またこの揮発性の情報は，
//  対象ファイルを他の記憶媒体に移動すると消えてしまう．
//=============================================================================
procedure TForm1.btnSaveClick(Sender: TObject);
var
  ADate1 : TDateTime;
  ADate2 : TDateTime;
  ADate3 : TDateTime;
begin
  if FileExists(AFileName) then begin
    //文字列関係
    SetStorage(AFileName, FMTID_SummaryInfo,    PID_TITLE,      lblEdit01.Text);
    SetStorage(AFileName, FMTID_SummaryInfo,    PID_SUBJECT,    lblEdit02.Text);
    SetStorage(AFileName, FMTID_DocSummaryInfo, PID_COMPANY,    lblEdit03.Text);
    SetStorage(AFileName, FMTID_SummaryInfo,    PID_AUTHOR,     lblEdit04.Text);
    SetStorage(AFileName, FMTID_SummaryInfo,    PID_LASTAUTHOR, lblEdit05.Text);
    SetStorage(AFileName, FMTID_SummaryInfo,    PID_COMMENTS,   lblEdit06.Text);

    //日付型
    try
      //作成日
      ADate1 := StrToDateTime(lblEdit11.Text);
      SetStorageDate(AFileName, FMTID_SummaryInfo, PID_CREATE_DTM,  ADate1);
      //最終更新日
      ADate2 := StrToDateTime(lblEdit12.Text);
      SetStorageDate(AFileName, FMTID_SummaryInfo, PID_LASTSAVE_DTM,ADate2);
      //最終印刷日
      ADate3 := StrToDateTime(lblEdit13.Text);
      SetStorageDate(AFileName, FMTID_SummaryInfo, PID_LASTPRINTED, ADate3);
    except
    end;
  end;
end;

//=============================================================================
//  プロパティセットを読出す実際の関数
//
//  同じGUID_Typeのプロパティであれば，Enumメソッドを使用して列挙可能であるが，
//  ここでは使用していない．
//  一つのファイルに対してプロパティを列挙するのではなく，同じプロパティ値のフ
//  ァイルを選択するなどの目的を想定しているので．
//
//  IPropertySetStorage.Open
//  第1引数 開くプロパティセットの(通常FMTIDの識別子を使用)
//  第2引数 開くプロパティセットのモード
//  第3引数 IPropertyStorageインタフェースの受取り値へのポインタ
//
//  IPropertyStorage.ReadMultiple
//  第1引数 読取るプロパティの数
//  第2引数 読取るプロパティの配列
//  第3引数 読取ったプロパティ値が格納されているPROPVARIANT値の配列
//          (プロパティの型，実際の値)
//=============================================================================
function TForm1.GetStorage(const FileName: WideString;
  GUID_Type: TGUID; PID_Info: cardinal): string;
var
  hr          : HRESULT;
  Stg         : IStorage;
  PropSetStg  : IPropertySetStorage;
  PropStg     : IPropertyStorage;
  PropSpec    : TPropSpec;
  PropVariant : TPropVariant;
begin
  Result := '';

  //既存のストレージオブジェクトを開く
  hr := StgOpenStorageEx(pwidechar(FileName),
                                   STGM_READ or STGM_SHARE_DENY_WRITE,STGFMT_ANY,
                                   0,
                                   nil,
                                   nil,
                                   @IID_IPropertySetStorage,
                                   Stg);

  //GUID_Typeで指定するプロパティセットを読出しモードで開く
  //条件文は，if hr <> S_FALSEても可．Succeeded(hr)やnot Failed(hr)でもよい
  if (hr = S_OK) then begin
    PropSetStg := Stg as IPropertySetStorage;
    hr := PropSetStg.Open(GUID_Type,
                          STGM_READ or STGM_SHARE_EXCLUSIVE,
                          PropStg);
    if (hr = S_OK) then begin
      PropSpec.ulKind := PRSPEC_PROPID;
      PropSpec.propid := PID_Info;
      if (PropStg.ReadMultiple(1, @PropSpec, @PropVariant) = S_OK) then begin
        if (PropVariant.pszVal <> nil) then begin
          Result := PropertyVariantToString(PropVariant);
        end;
      end;
    end;
  end;
end;

//=============================================================================
//  プロパティセットを書込む実際の関数(文字列型専用)
//  単一プロパティの値のみを書込む仕様としている．理由はGetStorageと同じ
//
//  IPropertySetStorage.Open
//  第1引数 開くプロパティセットの(通常FMTIDの識別子を使用)
//  第2引数 開くプロパティセットのモード
//  第3引数 IPropertyStorageインタフェースの受取り値へのポインタ
//
//  IPropertyStorage.WriteMultiple
//  第1引数 設定するプロパティの数
//  第2引数 プロパティ識別子(PIDXXX)
//  第3引数 PROPVARIANT値の配列(プロパティの型，実際の値)
//  第4引数 割り当てられているプロパティ識別子の最小値 
//=============================================================================
function TForm1.SetStorage(const FileName: WideString;
  GUID_Type: TGUID; PID_Info: Cardinal; InfoStr: string): boolean;
var
  hr          : HRESULT;
  Stg         : IStorage;
  PropSetStg  : IPropertySetStorage;
  PropStg     : IPropertyStorage;
  PropSpec    : TPropSpec;
  PropVariant : TPropVariant;
begin
  Result := False;

  //既存のストレージオブジェクトを開く
  hr := StgOpenStorageEx(pwidechar(FileName),
                         STGM_SHARE_EXCLUSIVE or STGM_READWRITE,
                         STGFMT_ANY,
                         0,
                         nil,
                         nil,
                         @IID_IPropertySetStorage,
                         Stg);

  //GUID_Typeで指定するプロパティセットを読書き両用モードで開く
  if (hr = S_OK) then begin
    PropSetStg := Stg as IPropertySetStorage;
    hr  := PropSetStg.Open(GUID_Type,
                           STGM_READWRITE or STGM_SHARE_EXCLUSIVE,
                           PropStg);

    //新しいプロパティセットの作成
    //[詳細]タブに項目があってもストレージがあるとは限らないので作成
    if (hr <> S_OK) then begin
      hr := PropSetStg.Create(
         GUID_Type,GUID_Type,
         PROPSETFLAG_DEFAULT,STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE,
         PropStg);
    end;

    //新しいプロパティ値を書込む
    if (hr = S_OK) then begin
      PropSpec.ulKind    := PRSPEC_PROPID;
      PropSpec.propid    := PID_Info;
      PropVariant.vt     := VT_LPSTR;
      PropVariant.pszVal := PAnsiChar(AnsiString(InfoStr));
      if (PropStg.WriteMultiple(1,@PropSpec, @PropVariant, 2) = S_OK) then begin
        Result := (PropStg.Commit(STGC_DEFAULT) = S_OK);
      end;
    end;
  end;
end;

//=============================================================================
//  プロパティセットを書込む実際の関数(日付型専用)
//
//  上の関数との違いは，最後の引数がTDateTime型なので(1)(2)の部分を変更
//  必要であれば，SetFtorage関数の引数を変更して汎用的にしてもいいかも知れない
//=============================================================================
function TForm1.SetStorageDate(const FileName: WideString;
  GUID_Type: TGUID; PID_Info: cardinal; ADateTime: TDateTime): boolean;
var
  hr          : HRESULT;
  Stg         : IStorage;
  PropSetStg  : IPropertySetStorage;
  PropStg     : IPropertyStorage;
  PropSpec    : TPropSpec;
  PropVariant : TPropVariant;
begin
  Result := False;

  //既存のストレージオブジェクトを開く
  hr := StgOpenStorageEx(pwidechar(FileName),
                         STGM_SHARE_EXCLUSIVE or STGM_READWRITE,
                         STGFMT_ANY,
                         0,
                         nil,
                         nil,
                         @IID_IPropertySetStorage,
                         Stg);

  //GUID_Typeで指定するプロパティセットを読書き両用モードで開く
  if (hr = S_OK) then begin
    PropSetStg := Stg as IPropertySetStorage;
    hr  := PropSetStg.Open(GUID_Type,
                           STGM_READWRITE or STGM_SHARE_EXCLUSIVE,
                           PropStg);

    //新しいプロパティセットの作成
    //[詳細]タブに項目があってもストレージがあるとは限らないので作成
    if (hr <> S_OK) then begin
      hr := PropSetStg.Create(
        GUID_Type,
        GUID_Type,
        PROPSETFLAG_DEFAULT,STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE,
        PropStg);
   end;

   //新しいプロパティ値を書込む
   if (hr = S_OK) then begin
      PropSpec.ulKind      := PRSPEC_PROPID;
      PropSpec.propid      := PID_Info;
      PropVariant.vt       := VT_FILETIME;            //(1)
      PropVariant.filetime := ToFileTime(ADateTime);  //(2)
      if (PropStg.WriteMultiple(1, @PropSpec, @PropVariant,2) = S_OK) then begin
        Result := (PropStg.Commit(STGC_DEFAULT) = S_OK);
      end;
    end;
  end;
end;

//=============================================================================
//  プロパティ値をその値に応じて文字列に変換
//  プロパティ書込みの際は，この逆の変換が必要であるが，このサンプルプログラム
//  では文字列と日付のみを扱っているので省略し，文字列型と日付型の設定を別関数
//  とした．
//=============================================================================
function TForm1.PropertyVariantToString(const Prop: TPropVariant): String;
begin
  case Prop.vt of
    VT_EMPTY    : Result := '';
    VT_NULL     : Result := '';
    VT_VOID     : Result := '';
    VT_I2       : Result := IntToStr(Prop.iVal);
    VT_I4       : Result := IntToStr(Prop.lVal);
    VT_INT      : Result := IntToStr(Prop.lVal);
    VT_R4       : Result := FloatToStr(Prop.fltVal);
    VT_R8       : Result := FloatToStr(Prop.dblVal);
    VT_BSTR     : Result := Prop.bstrVal;
    VT_UI1      : Result := IntToStr(Prop.bVal);
    VT_UI2      : Result := IntToStr(Prop.uiVal);
    VT_UI4      : Result := IntToStr(Prop.ulVal);
    VT_UINT     : Result := IntToStr(Prop.ulVal);
    VT_I8       : Result := IntToStr(Int64(Prop.hVal));
    VT_UI8      : Result := IntToStr(Int64(Prop.uhVal));
    VT_LPSTR    : Result := String(Prop.pszVal);
    VT_LPWSTR   : Result := Prop.pwszVal;
    VT_ERROR    : Result := 'ERROR : ' + IntToStr(Prop.sCode);
    VT_BOOL     : if Prop.boolVal=False then Result := '0' else Result := '1';
    VT_CLSID    : if Prop.puuid<>nil then Result := GuidToString(Prop.puuid^);
    VT_FILETIME : Result := DateTimeToStr(ToDateTime(Prop.filetime));
  else
    Result := '';
  end;
end;

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

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

end.

unit FileProperties_WordObjectUnit;

interface

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

type
  TForm1 = class(TForm)
    Bevel1: TBevel;
    btnSave: TButton;
    btnRead: TButton;
    lblEdit01: TLabeledEdit;
    lblEdit02: TLabeledEdit;
    lblEdit03: TLabeledEdit;
    lblEdit04: TLabeledEdit;
    lblEdit05: TLabeledEdit;
    lblEdit06: TLabeledEdit;
    lblEdit07: TLabeledEdit;
    Panel1: TPanel;
    Panel2: TPanel;
    OpenDialog1: TOpenDialog;
    ListView1: TListView;
    lblEdit11: TLabeledEdit;
    lblEdit12: TLabeledEdit;
    lblEdit13: TLabeledEdit;
    btnDelete: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnReadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    { Private 宣言 }
    BasePath : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj, Word2000, Office2000;

{$R *.dfm}

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

  btnSave.Enabled   := False;
  btnDelete.Enabled := False;
  Panel2.Enabled    := False;
end;

//=============================================================================
//  プロパティ読出しボタン
//=============================================================================
procedure TForm1.btnReadClick(Sender: TObject);
var
  WordApp      : OleVariant;
  WordDoc      : OleVariant;
  i            : Integer;
  Properties   : OleVariant;
  DocuProperty : OleVariant;
  Value        : OleVariant;
  AItem        : TListItem;
begin
  OpenDialog1.InitialDir := BasePath;
  OpenDialog1.Filter := 'Word Document|*.doc;*.docx;*.docm';

  if OpenDialog1.Execute then begin
    lblEdit01.Text := '';
    lblEdit02.Text := '';
    lblEdit03.Text := '';
    lblEdit04.Text := '';
    lblEdit05.Text := '';
    lblEdit06.Text := '';
    lblEdit07.Text := '';
    lblEdit11.Text := '';
    lblEdit12.Text := '';
    lblEdit13.Text := '';
    Update;
    ListView1.Items.Clear;
    ListView1.Update;
    ListView1.Items.BeginUpdate;

    WordApp := CreateOleObject('Word.Application');
    WordApp.Documents.Open(OpenDialog1.FileName);
    try
      //ワードに組込み済みのプロパティ(BuiltInDocumentPropertie)のリスト作成
      Properties := WordApp.ActiveDocument.BuiltInDocumentProperties;

      for i := 1 to Properties.Count do begin
        DocuProperty := Properties.Item[i];
        try
          Value := DocuProperty.Value;
        except
          Value := '';
        end;
        AItem := ListView1.Items.Add;
        AItem.Caption := DocuProperty.Name;
        AItem.SubItems.Add(Value);
      end;

      //ユーザ定義のプロパティ(CustomDocumentPropertie)があればリストに追加
      Properties := WordApp.ActiveDocument.CustomDocumentProperties;
      for i := 1 to Properties.Count do begin
        DocuProperty := Properties.Item[i];
        try
          Value := DocuProperty.Value;
        except
          Value := '';
        end;
        AItem := ListView1.Items.Add;
        AItem.Caption := DocuProperty.Name;
        AItem.SubItems.Add(Value);
      end;
      ListView1.Items.EndUpdate;

      //左側の項目別プロパティの取得
      Panel1.Caption := OpenDialog1.FileName;
      WordDoc := WordApp.ActiveDocument;

      //タイトル
      Value := WordDoc.BuiltInDocumentProperties[wdPropertyTitle];
      lblEdit01.Text := Value;
      //サブタイトル
      Value := WordDoc.BuiltInDocumentProperties[wdPropertySubject];
      lblEdit02.Text := Value;
      //会社名
      Value := WordDoc.BuiltInDocumentProperties[wdPropertyCompany];
      lblEdit03.Text := Value;
      //作成者
      Value := WordDoc.BuiltInDocumentProperties[wdPropertyAuthor];
      lblEdit04.Text := Value;
      //最終保存者
      Value := WordDoc.BuiltInDocumentProperties[wdPropertyLastAuthor];
      lblEdit05.Text := Value;
      //コメント
      Value := WordDoc.BuiltInDocumentProperties[wdPropertyComments];
      lblEdit06.Text := Value;

      //作成日
      Value := WordDoc.BuiltInDocumentProperties[wdPropertyTimeCreated];
      lblEdit11.Text := Value;

      //最終更新日
      Value := WordDoc.BuiltInDocumentProperties[wdPropertyTimeLastSaved];
      lblEdit12.Text := Value;

      //最終印刷日付
      Value := WordDoc.BuiltInDocumentProperties[wdPropertyTimeLastPrinted];
      try
        lblEdit13.Text := Value;
      except
      end;

      //ユーザ定義プロパティ
      try
        Value := WordDoc.CustomDocumentProperties['送付先'].Value;
        lblEdit07.Text := Value;
      except
      end;

      btnSave.Enabled   := True;
      btnDelete.Enabled := True;
    finally
      //保存なしでワード終了
      WordApp.Quit(wdDoNotSaveChanges);
      WordDoc := Unassigned;
      WordApp := Unassigned;
    end;
  end;
end;

//=============================================================================
//  プロパティ値の書込み
//
//  フォームの左側に表示しているプロパティを定義して値をセット
//  ユーザ定義プロパティで使用可能なプロパティの種類は以下の通り
//  (Office2000.pas内での定義)
//  msoPropertyTypeBoolean   論理型
//  msoPropertyTypeDate      日付型
//  msoPropertyTypeFloat     実数型
//  msoPropertyTypeNumber    整数型
//  msoPropertyTypeString    文字列型
//=============================================================================
procedure TForm1.btnSaveClick(Sender: TObject);
var
  WordApp : OleVariant;
  WordDoc : OleVariant;
  Value   : OleVariant;
begin
  WordApp := CreateOleObject('Word.Application');
  WordApp.Documents.Open(OpenDialog1.FileName);
  try
    WordDoc := WordApp.ActiveDocument;
    //タイトル
    Value := lblEdit01.Text;
    WordDoc.BuiltInDocumentProperties[wdPropertyTitle].Value := Value;
    //サブタイトル
    Value := lblEdit02.Text;
    WordDoc.BuiltInDocumentProperties[wdPropertySubject].Value := Value;
    //会社名
    Value := lblEdit03.Text;
    WordDoc.BuiltInDocumentProperties[wdPropertyCompany].Value := Value;
    //作成者
    Value := lblEdit04.Text;
    WordDoc.BuiltInDocumentProperties[wdPropertyAuthor].Value := Value;
    //最終保存者
    //実際には編集内容は変更されない．最終保存者はWordApp.Quitの時にワードが
    //が判断して更新する
    Value := lblEdit05.Text;
    WordDoc.BuiltInDocumentProperties[wdPropertyLastAuthor].Value := Value;
    //コメント
    Value := lblEdit06.Text;
    WordDoc.BuiltInDocumentProperties[wdPropertyComments].Value := Value;

    //プロパティを追加
    //値を設定しようとして例外発生ならプロパティなしと勝手に判断
    try
      WordDoc.CustomDocumentProperties['送付先'].Value := lblEdit07.Text;
    except
      WordDoc.CustomDocumentProperties.Add('送付先',
                                            False,
                                            msoPropertyTypeString,
                                            lblEdit07.Text,
                                            EmptyParam);
    end;
  finally
    //ワード文書を保存して終了
    WordApp.Quit(wdSaveChanges);
    WordDoc := Unassigned;
    WordApp := Unassigned;
  end;
end;

//=============================================================================
//  ユーザ定義プロパティの削除
//  実際には削除できない(参考コード)
//
//  VBAのヘルプではDeleteメソッドなのであるが，何故かこのコードでは削除されない
//=============================================================================
procedure TForm1.btnDeleteClick(Sender: TObject);
var
  WordApp : OleVariant;
  WordDoc : OleVariant;
begin
  WordApp := CreateOleObject('Word.Application');
  WordApp.Documents.Open(OpenDialog1.FileName);
  try
    WordDoc := WordApp.ActiveDocument;
    try
      WordDoc.CustomDocumentProperties['送付先'].Delete;
    except
      //該当プロパティが存在しない場合は例外発生
    end;
  finally
    //ワード文書を保存して終了
    WordApp.Quit(wdSaveChanges);
    WordDoc := Unassigned;
    WordApp := Unassigned;
  end;
end;

end.

unit FileProperties_ExcelObjectUnit;

interface

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

type
  TForm1 = class(TForm)
    Bevel1: TBevel;
    btnSave: TButton;
    btnRead: TButton;
    lblEdit01: TLabeledEdit;
    lblEdit02: TLabeledEdit;
    lblEdit03: TLabeledEdit;
    lblEdit04: TLabeledEdit;
    lblEdit05: TLabeledEdit;
    lblEdit06: TLabeledEdit;
    lblEdit07: TLabeledEdit;
    Panel1: TPanel;
    Panel2: TPanel;
    OpenDialog1: TOpenDialog;
    ListView1: TListView;
    lblEdit11: TLabeledEdit;
    lblEdit12: TLabeledEdit;
    lblEdit13: TLabeledEdit;
    btnDelete: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnReadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    { Private 宣言 }
    BasePath : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj, Office2000;

{$R *.dfm}

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

  btnSave.Enabled   := False;
  btnDelete.Enabled := False;
  Panel2.Enabled    := False;
end;

//=============================================================================
//  プロパティ読出しボタン
//=============================================================================
procedure TForm1.btnReadClick(Sender: TObject);
var
  ExcelApp     : OleVariant;
  ExcelBook    : OleVariant;
  i            : Integer;
  Properties   : OleVariant;
  DocuProperty : OleVariant;
  Value        : OleVariant;
  AItem        : TListItem;
begin
  OpenDialog1.InitialDir := BasePath;
  OpenDialog1.Filter := 'Excel Book|*.xls;*.xlsx;xlsm';

  if OpenDialog1.Execute then begin
    lblEdit01.Text := '';
    lblEdit02.Text := '';
    lblEdit03.Text := '';
    lblEdit04.Text := '';
    lblEdit05.Text := '';
    lblEdit06.Text := '';
    lblEdit07.Text := '';
    lblEdit11.Text := '';
    lblEdit12.Text := '';
    lblEdit13.Text := '';
    Update;
    ListView1.Items.Clear;
    ListView1.Update;
    ListView1.Items.BeginUpdate;

    ExcelApp  := CreateOleObject('Excel.Application');
    ExcelBook := ExcelApp.Workbooks.Open(OpenDialog1.FileName);
    try
      //エクセルに組込み済みのプロパティ(BuiltInDocumentPropertie)のリスト作成
      Properties := ExcelBook.BuiltInDocumentProperties;
      for i := 1 to Properties.Count do begin
        DocuProperty := Properties.Item[i];
        try
          Value := DocuProperty.Value;
        except
          Value := '';
        end;
        AItem := ListView1.Items.Add;
        AItem.Caption := DocuProperty.Name;
        AItem.SubItems.Add(String(Value));
      end;

      //ユーザ定義のプロパティ(CustomDocumentPropertie)があればリストに追加
      Properties := ExcelBook.CustomDocumentProperties;
      for i := 1 to Properties.Count do begin
        DocuProperty := Properties.Item[i];
        try
          Value := DocuProperty.Value;
        except
          Value := '';
        end;
        AItem := ListView1.Items.Add;
        AItem.Caption := DocuProperty.Name;
        AItem.SubItems.Add(String(Value));
      end;
      ListView1.Items.EndUpdate;

      //左側の項目別プロパティの取得
      Panel1.Caption := OpenDialog1.FileName;

      //タイトル
      Value := ExcelBook.BuiltinDocumentProperties['Title'];
      lblEdit01.Text := Value;
      //サブタイトル
      Value := ExcelBook.BuiltInDocumentProperties['Subject'];
      lblEdit02.Text := Value;
      //会社名
      Value := ExcelBook.BuiltInDocumentProperties['Company'];
      lblEdit03.Text := Value;
      //作成者
      Value := ExcelBook.BuiltInDocumentProperties['Author'];
      lblEdit04.Text := Value;
      //最終保存者
      Value := ExcelBook.BuiltInDocumentProperties['Last Author'];
      lblEdit05.Text := Value;
      //コメント
      Value := ExcelBook.BuiltInDocumentProperties['Comments'];
      lblEdit06.Text := Value;

      //作成日
      Value := ExcelBook.BuiltInDocumentProperties['Creation Date'];
      try
        lblEdit11.Text := Value;
      except
      end;

      //最終更新日
      Value := ExcelBook.BuiltInDocumentProperties['Last Save Time'];
      try
        lblEdit12.Text := Value;
      except
      end;

      //最終印刷日付
      Value := ExcelBook.BuiltInDocumentProperties['Last Print Date'];
      try
        lblEdit13.Text := Value;
      except
      end;

      //ユーザ定義プロパティ
      try
        Value := ExcelBook.CustomDocumentProperties['送付先'];
        lblEdit07.Text := String(Value);
      except
      end;

      btnSave.Enabled   := True;
      btnDelete.Enabled := True;
    finally
      //保存なしエクセル終了
      ExcelApp.Quit;
      ExcelBook := Unassigned;
      ExcelApp  := Unassigned;
    end;
  end;
end;

//=============================================================================
//  プロパティ値の書込み
//
//  フォーム左側に表示しているプロパティを定義して値をセット
//  ユーザ定義プロパティで使用可能なプロパティの種類は以下の通り
//  (Office2000.pas内での定義)
//  msoPropertyTypeBoolean   論理型
//  msoPropertyTypeDate      日付型
//  msoPropertyTypeFloat     実数型
//  msoPropertyTypeNumber    整数型
//  msoPropertyTypeString    文字列型
//=============================================================================
procedure TForm1.btnSaveClick(Sender: TObject);
var
  ExcelApp  : OleVariant;
  ExcelBook : OleVariant;
  Value     : OleVariant;
begin
  ExcelApp  := CreateOleObject('Excel.Application');
  ExcelBook := ExcelApp.Workbooks.Open(OpenDialog1.FileName);
  //保存確認のダイアログを表示させない
  ExcelApp.DisplayAlerts:=False;

  try
    //タイトル
    Value := lblEdit01.Text;
    ExcelBook.BuiltInDocumentProperties['Title'].Value := Value;
    //サブタイトル
    Value := lblEdit02.Text;
    ExcelBook.BuiltInDocumentProperties['Subject'].Value := Value;
    //会社名
    Value := lblEdit03.Text;
    ExcelBook.BuiltInDocumentProperties['Company'].Value := Value;
    //作成者
    Value := lblEdit04.Text;
    ExcelBook.BuiltInDocumentProperties['Author'].Value := Value;
    //最終保存者
    //実際には編集内容は変更されない．最終保存者はExcelBook.Saveの時にエクセ
    //ルが判断して更新する
    Value := lblEdit05.Text;
    ExcelBook.BuiltInDocumentProperties['Last Author'].Value := Value;
    //コメント
    Value := lblEdit06.Text;
    ExcelBook.BuiltInDocumentProperties['Comments'].Value := Value;

    //プロパティを追加
    //値を設定しようとして例外発生ならプロパティなしと勝手に判断
    try
      ExcelBook.CustomDocumentProperties['送付先'].Value := lblEdit07.Text;
    except
      ExcelBook.CustomDocumentProperties.Add('送付先',
                                            False,
                                            msoPropertyTypeString,
                                            lblEdit07.Text,
                                            EmptyParam);
    end;
  finally
    //エクセルのブックを保存してエクセル終了
    ExcelBook.Save;
    ExcelApp.Quit;
    ExcelBook := Unassigned;
    ExcelApp  := Unassigned;
  end;
end;

//=============================================================================
//  ユーザ定義プロパティの削除
//=============================================================================
procedure TForm1.btnDeleteClick(Sender: TObject);
var
  ExcelApp  : OleVariant;
  ExcelBook : OleVariant;
begin
  ExcelApp  := CreateOleObject('Excel.Application');
  ExcelBook := ExcelApp.Workbooks.Open(OpenDialog1.FileName);
  //保存確認のダイアログを表示させない
  ExcelApp.DisplayAlerts := False;

  try
    try
      ExcelBook.CustomDocumentProperties['送付先'].Delete;
    except
    end;
  finally
    //エクセルのブックを保存してエクセル終了
    ExcelBook.Save;
    ExcelApp.Quit;
    ExcelBook := Unassigned;
    ExcelApp  := Unassigned;
  end;
end;

end.

program FileProperties_Storage;

uses
  Forms,
  FileProperties_StorageUnit in 'FileProperties_StorageUnit.pas' {Form1},
  plFileInfo_Const in '..\plFileInfo_Const.pas';

{$R *.res}

begin
  Application.Initialize;
  //Delphi2007以上
  {$IF CompilerVersion > 18.49}
  Application.MainFormOnTaskbar := True;
  {$IFEND}
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit plFileInfo_Const;

interface

uses Windows, ComObj, ActiveX, Classes;

const
//-----------------------------------------------------------------------------
// プロパティセットのカテゴリのGUID
// 直接GUIDで指定しないでここでは定数名で使用するために定義
// どのGUIDがどんなファイルに対応するか正確には不明
//
// これらのGUIDは全てが，また全ての環境で(レジストリに)登録されているわけでは
// ない．オーディオ関係のアプリがインストールされていなければ，該当する情報は
// レジストリに登録されないので使用できない．
// つまり，どのような機能がそのPCにインストールされているかによる．
//
// FMTID_SummaryInfo
// ファイルのプロパティで概要タブで扱うプロパティセット
// FMTID_DocSummaryInfo
// 主にワード等が使用するプロパティセット
//  FMTID_UserDefinedProperties
//     [ファイル][プロパティ]のカスタムタブで扱うプロパティセット
//  FMTID_ImageSummaryInfo
//     イメージファイル関係
//  FMTID_MusicFileInfo
//     音楽ファイル関係
//  FMTID_AudioFileInfo
//     オーディオファイル関係
//  FMTID_VideoFileInfo
//     ビデオファイル関係
//  FMTID_MediaFileInfo
//     メディアファイル関係
//
//  実際のプロパティの値は，このGUIDと下の[各プロパティ変数]の組合わせを使用する
//-----------------------------------------------------------------------------

  FMTID_SummaryInfo           : TGUID='{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
  FMTID_DocSummaryInfo        : TGUID='{D5CDD502-2E9C-101B-9397-08002B2CF9AE}';
  FMTID_DiscardableInfo       : TGUID='{D725EBB0-C9B8-11D1-89BC-0000F804B057}';
  FMTID_UserDefinedProperties : TGUID='{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
  FMTID_ImageSummaryInfo      : TGUID='{6444048F-4C8B-11D1-8B70-080036B11A03}';
  FMTID_MusicFileInfo         : TGUID='{56A3372E-CE9C-11D2-9F0E-006097C686F6}';
  FMTID_AudioFileInfo         : TGUID='{64440490-4C8B-11D1-8B70-080036B11A03}';
  FMTID_VideoFileInfo         : TGUID='{64440491-4C8B-11D1-8B70-080036B11A03}';
  FMTID_MediaFileInfo         : TGUID='{64440492-4C8B-11D1-8B70-080036B11A03}';

//-----------------------------------------------------------------------------
//  IPropertySetStorageのGUID
//-----------------------------------------------------------------------------

  IID_IPropertySetStorage: TGUID ='{0000013A-0000-0000-C000-000000000046}';

//-----------------------------------------------------------------------------
//  各プロパティのID値の定義
//  FMTID_Summary Informationの定義はActiveX.pasで定義されているが再定義
//  (ActiveX.pas内での定数名はPIDSI_XXXXX)
//  定数名は，極力，ネット上にある参考コードと同じになるようにしているが，.NET
//  では，これらの定数名の定義が設定されているようである
//  正確な日本語表記名は不明
//  説明の参考リンク
//  http://msdn2.microsoft.com/en-us/library/ms690941.aspx
//
//  VT_XXXは変数の型．記載がないのは不明．変数の型には以下もあり
//  VT_EMPTY,VT_NULL,VT_VOID  空またはプロパティがない?
//  VT_R4,VT_R8               実数値
//  VT_ERROR                  エラー値(整数)
//-----------------------------------------------------------------------------

  // Summary Info用
  PID_TITLE            = 2;  // VT_LPSTR,タイトル
  PID_SUBJECT          = 3;  // VT_LPSTR,サブタイトル,表題
  PID_AUTHOR           = 4;  // VT_LPSTR,作成者，著作
  PID_KEYWORDS         = 5;  // VT_LPSTR,キーワード
  PID_COMMENTS         = 6;  // VT_LPSTR,コメント
  PID_TEMPLATE         = 7;  // VT_LPSTR,テンプレート
  PID_LASTAUTHOR       = 8;  // VT_LPSTR,前回保存者
  PID_REVNUMBER        = 9;  // 改定番号
  PID_EDITTIME         = 10; // VT_FILETIME(UTC),編集時間
  PID_LASTPRINTED      = 11; // VT_FILETIME(UTC),最終印刷日時
  PID_CREATE_DTM       = 12; // VT_FILETIME(UTC),作成日時
  PID_LASTSAVE_DTM     = 13; // VT_FILETIME(UTC),最終保存日時
  PID_PAGECOUNT        = 14; // VT_I4,頁数
  PID_WORDCOUNT        = 15; // VT_I4,単語数
  PID_CHARCOUNT        = 16; // VT_I4,文字数
  PID_THUMBNAIL        = 17; // VT_CF,サムネイル
  PID_APPNAME          = 18; // VT_LPSTR,アプリケーション名
  PID_SECURITY         = 19; // VT_I4,セキュリティ

  // Document Summary Info用
  PID_CATEGORY         = 2;  // VT_LPSTR,カテゴリ
  PID_PRESFORMAT       = 3;  // VT_LPSTR
  PID_BYTECOUNT        = 4;  // VT_I4
  PID_LINECOUNT        = 5;  // VT_I4,行数
  PID_PARCOUNT         = 6;  // VT_I4 
  PID_SLIDECOUNT       = 7;  // VT_I4,スライド数
  PID_NOTECOUNT        = 8;  // VT_I4
  PID_HIDDENCOUNT      = 9;  // VT_I4
  PID_MMCLIPCOUNT      = 10; // VT_I4
  PID_SCALE            = 11; // VT_BOOL
  PID_HEADINGPAIR      = 12; // VT_VARIANT or VT_VECTOR
  PID_DOCPARTS         = 13; // VT_LPSTR or VT_VECTOR
  PID_MANAGER          = 14; // VT_LPSTR
  PID_COMPANY          = 15; // VT_LPSTR,会社名
  PID_LINKSDIRTY       = 16; // VT_BOOL,未更新のリンクオブジェクト
  PID_CHARCOUNT2       = 17; //

  // FMTID_ImageSummaryInfo用
  PIDISI_FILETYPE      = 2;  // VT_LPWSTR,ファイルの種類
  PIDISI_CX            = 3;  // VT_UI4,幅
  PIDISI_CY            = 4;  // VT_UI4,高さ
  PIDISI_RESOLUTIONX   = 5;  // VT_UI4,水平方向の解像度
  PIDISI_RESOLUTIONY   = 6;  // VT_UI4.垂直方向の解像度
  PIDISI_BITDEPTH      = 7;  // VT_UI4,ビットの深さ
  PIDISI_COLORSPACE    = 8;  // VT_LPWSTR
  PIDISI_COMPRESSION   = 9;  // VT_LPWSTR,圧縮の有無
  PIDISI_TRANSPARENCY  = 10; // VT_UI4
  PIDISI_GAMMAVALUE    = 11; // VT_UI4,ガンマ値
  PIDISI_FRAMECOUNT    = 12; // VT_UI4,フレーム数
  PIDISI_DIMENSIONS    = 13; // VT_LPWSTR

  // FMTID_MusicFileInfo用
  // 3はhttp://msdn2.microsoft.com/en-us/library/ms690941.aspxには定義なし
  PIDSI_ARTIST         = 2;  // アーチストの名前
  PIDSI_SONGTITLE      = 3;  // 定義なし?
  PIDSI_ALBUM          = 4;  // アルバム名
  PIDSI_YEAR           = 5;  // アルバムが記録された年
  PIDSI_COMMENT        = 6;  // コメント
  PIDSI_TRACK          = 7;  // アルパムのトラック番号
  PIDSI_GENRE          = 11; // アルバムのジャンル
  PIDSI_LYRICS         = 12; // 音楽ファイルの歌詞

  // FMTID_VideoFileInfo用
  PIDVSI_STREAM_NAME   = 2;  // VT_LPWSTR,ビデオの名前,StreamName
  PIDVSI_FRAME_WIDTH   = 3;  // VT_UI4,幅,FrameWidth
  PIDVSI_FRAME_HEIGHT  = 4;  // VT_UI4,高さ,FrameHeight
  PIDVSI_TIMELENGTH    = 7;  // VT_UI4,長さ,TimeLength (milliseconds)
  PIDVSI_FRAME_COUNT   = 5;  // VT_UI4,フレーム数,FrameCount
  PIDVSI_FRAME_RATE    = 6;  // VT_UI4,フレーム率,FrameRate (frames/millisecond)
  PIDVSI_DATA_RATE     = 8;  // VT_UI4,ビットレート,DataRate (bps,bytes/second)
  PIDVSI_SAMPLE_SIZE   = 9;  // VT_UI4,SampleSize
  PIDVSI_COMPRESSION   = 10; // VT_LPWSTR,圧縮レベル,Compression
  PIDVSI_STREAM_NUMBER = 11; // VT_UI2,StreamNumber

  // FMTID_AudioFileInfo用
  PIDASI_FORMAT        = 2;  // VT_BSTR
  PIDASI_TIMELENGTH    = 3;  // VT_UI4,(milliseconds)
  PIDASI_AVG_DATA_RATE = 4;  // VT_UI4,(Hz)
  PIDASI_SAMPLE_RATE   = 5;  // VT_UI4,(bits)
  PIDASI_SAMPLE_SIZE   = 6;  // VT_UI4,(bits)
  PIDASI_CHANNEL_COUNT = 7;  // VT_UI4
  PIDASI_STREAM_NUMBER = 8;  // VT_UI2
  PIDASI_STREAM_NAME   = 9;  // VT_LPWSTR
  PIDASI_COMPRESSION   = 10; // VT_LPWSTR


  //FMTID_MediaFileInfo用
  PIDMSI_EDITOR        = 2;  // VT_LPWSTR
  PIDMSI_SUPPLIER      = 3;  // VT_LPWSTR
  PIDMSI_SOURCE        = 4;  // VT_LPWSTR
  PIDMSI_SEQUENCE_NO   = 5;  // VT_LPWSTR
  PIDMSI_PROJECT       = 6;  // VT_LPWSTR
  PIDMSI_STATUS        = 7;  // VT_UI4
  PIDMSI_OWNER         = 8;  // VT_LPWSTR
  PIDMSI_RATING        = 9;  // VT_LPWSTR
  PIDMSI_PRODUCTION    = 10; // VT_FILETIME(UTC)
  PIDMSI_COPYRIGHT     = 11; // VT_LPWSTR 

//-----------------------------------------------------------------------------
// StgOpenStorageEx関数の第3引数．ストレージファイルのフォーマット
//
// STGFMT_STORAGE  必ずワード等の複合ファイルである
// STGFMT_FILE     必ずしも複合ファイルではないことを指定．現在未サポート　
// STGFMT_ANY      ファイル形式をシステムが決定し，適当な構造化ストレージやプ
// ロパティセットの実装を使用
// STGFMT_DOCFILE  STGFMT_STORAGE同様にファイルが必ず複合ファイルであることを
// 指定．古い形式の複合ファイル用か?
//-----------------------------------------------------------------------------

  STGFMT_STORAGE = 0;
  STGFMT_FILE    = 3;
  STGFMT_ANY     = 4;
  STGFMT_DOCFILE = 5;

//-----------------------------------------------------------------------------
//  ファイルシステム上の既存のストレージオブジェクトを開く関数
//  ワード等の複合ファイルを開くためにも，通常のファイルを開くためにも使用可能
//  ActiveX.pasにはこの関数がないため，定義して使用
//
//  Delphi7の場合，StgOpenStorage関数はあるが，MicrosoftではWindows2000以降の
//  アプリはこのStgOpenStorageEx関数を使うべきとしている．
//  ただし，Office 2007以降は，この構造化ストレージを使用しなくなった
//
//  pwcsName    : フルパスで指定．文字数はMAX_PATHを越えてはいけない
//  grfMode     : このオブジェクトのアクセスモード．各グループから一つ指定
//                Access group
//                STGM_READ      読取専用
//                STGM_WRITE     現在未サポート
//                STGM_READWRITE 読書き両用
//                Sharing group
//                STGM_SHARE_DENY_NONE  後発のオブジェクト読み書きアクセスを拒否
//                                      しない 
//                STGM_SHARE_DENY_READ  後発のSTGM_READモードの取得を阻止する
//                                      通常ストレージオブジェクトに使用
//                STGM_SHARE_DENY_WRITE 後発のSTGM_WRITE,STGM_READWRITEアクセス
//                                      モードでのオブジェクトの取得を阻止する
//                                      複数のユーザによる操作禁止に使用される
//                STGM_SHARE_EXCLUSIVE  STGM_SHARE_DENY_READと
//                                      STGM_SHARE_DENY_WRITEとの組合わせ
//                                      後発のあらゆるアクセスモードでのオブジェ
//                                      クトの取得を阻止する
//                STGM_PRIORITY         排他アクセスで開く指定
//                Direct SWMR and Simple group
//                STGM_SIMPLE           複合ファイルのより高速な実装を提供．
//                                      よく使用される(制限があるらしい)
//  stgfmt      : ストレージファイルフォーマット．通常0で可
//  grfAttrs    : 予約．0を指定
//  pStgOptions : STGOPTIONS ポインタのアドレス．通常nil
//  reserved2   : 予約．nilを指定
//  riid        : インタフェースポインタのGUID
//                通常はID IPropertySetStorageでよい
//  stgOpen     : インタフェースポインタのアドレス
//                開かれたストレージオブジェクトのインタフェースポインタを受け
//                取るポインタ変数のアドレス．
//                オープンに失敗すると0を返す
//
//  戻値
//  正常終了の場合はS_OKを返す
//  STG_E_INVALIDPOINTER  stgOpenパラメータのポインタが無効
//  STG_E_INVALIDPOINTER  pStgOptionsパラメータのポインタが無効
//  E_NOINTERFACE         指定されたインタフェースはサポートされていない
//  STG_E_INVALIDFLAG     grfMode ポインタのフラグの組み合わせが無効
//  STG_E_INVALIDNAME     pwcsName パラメータの名前が無効
//  STG_E_LOCKVIOLATION   ファイルが開かれロックしているためアクセス拒否  
//  STG_E_SHAREVIOLATION  同上
//  STG_E_INCOMPLETE      高度に隠れているデバイス(?)のためファイルが開けない
//  STG_E_ACCESSDENIED  　ユーザアクセスを許可していないためファイルが開けない
//
//  [参考]
//  新しいストレージファイルの作成はStgCreateStorageEx関数
//-----------------------------------------------------------------------------
function StgOpenStorageEx (
         const pwcsName : POleStr;
         grfMode : LongInt;
         stgfmt : DWORD;
         grfAttrs : DWORD;
         pStgOptions : Pointer;
         reserved2 : Pointer;
         riid : PGUID;
         out stgOpen : IStorage) : HResult; stdcall; external 'ole32.dll';

implementation

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses
  ShellAPI;

{$R *.DFM}

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

//=============================================================================
//  ファイルを選択してプロパティのダイアログを表示
//  usesにShellAPIが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSHExeInfo : TSHELLEXECUTEINFO;
  LFlag      : Cardinal;
  LFilePath  : String;
begin
  OpenDialog1.InitialDir := FBasePath;
  if not OpenDialog1.Execute then exit;

  //ファイルのパス
  LFilePath := OpenDialog1.FileName;

  LFlag := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;

  LSHExeInfo.cbSize       := Sizeof(LSHExeInfo);
  LSHExeInfo.fMask        := LFlag;
  LSHExeInfo.lpVerb       := 'Properties';
  LSHExeInfo.Wnd          := Handle;
  LSHExeInfo.lpParameters := nil;
  LSHExeInfo.lpDirectory  := nil;
  LSHExeInfo.lpIDList     := nil;
  LSHExeInfo.lpFile       := PChar(LFilePath);

  if not ShellExecuteEx(@LSHExeInfo) then begin
    //表示失敗
  end;
end;

end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses
  ShlObj;

{$R *.DFM}

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

//=============================================================================
//  ファイルを選択してプロパティのダイアログを表示
//  usesにShlObjが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath : String;
  LPage     : String;
begin
  OpenDialog1.InitialDir := FBasePath;
  if not OpenDialog1.Execute then exit;

  //ファイルのパス
  LFilePath := OpenDialog1.FileName;
  FBasePath := ExtractFilePath(LFilePath);
  //初期表示タブ名
  //指定したタブがない場合はデフォルトのタブとなる
  LPage := '詳細';

  SHObjectProperties(Handle, SHOP_FILEPATH, PChar(LFilePath), PChar(LPage));
end;

end.