◆解説
  エクスプローラの右クリック［プロパティ］で EXCELや WORDファ
  イルを調べると、タイトルや作成者などの情報（ドキュメントプ
  ロパティ情報）が表示されます。

  このドキュメントプロパティ情報を取得する方法として、Wordや
  Excelを OLE Automationで起動して、BuiltinDocumentProperties
  を呼び出すのが有名です。
  が、実は Wordや Excelを起動しなくても IPropertyStorageイン
  ターフェースの ReadMultipleメソッドで取得可能です。

◆動作確認
  Delphi4(UPD#3) + Win98  ＃Delphi3.1等では動作しません。

◆実際のコード
  Form1に Button1を置いて、以下のコードをお試し下さい
----- ここから -----
implementation

{$R *.DFM}

uses ActiveX, ComObj;

const
  FMTID_SummaryInformation: TGUID =
                   '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
  FMTID_DocumentSummaryInformation: TGUID =
                   '{D5CDD502-2E9C-101B-9397-08002B2CF9AE}';
  FMTID_UserDefinedProperties: TGUID =
                   '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';

function GetDocumentProperties(FileName: WideString): String;
var
  Storage: IStorage;
  PropSetStg: IPropertySetStorage;
  PropStg: IPropertyStorage;
  j: Integer;
  hr: HResult;
  PrSpec:    array[PIDSI_TITLE..PIDSI_DOC_SECURITY] of TPropSpec;
  PrVariant: array[PIDSI_TITLE..PIDSI_DOC_SECURITY] of TPropVariant;
  s: String;

  function ToDateTimeStr(AFileTime: TFileTime): String;
  var
    LocalTime: TFileTime;
    SystemTime: TSystemTime;
    D, T, DT: TDateTime;
  begin
    if int64(AFileTime) = 0 then begin
      Result := '';
      Exit;
    end;
    FileTimeToLocalFileTime(AFileTime, LocalTime);
    FileTimeToSystemTime(LocalTime, SystemTime);
    D := EncodeDate(SystemTime.wYear,
                    SystemTime.wMonth,
                    SystemTime.wDay);
    T := EncodeTime(SystemTime.wHour,
                    SystemTime.wMinute,
                    SystemTime.wSecond,
                    SystemTime.wMilliseconds);
    if D >= 0 then DT := D + T
              else DT := D - T;
    Result := DateTimeToStr(DT);
  end;
begin
  Result := '';
  CoInitialize(nil);
  try
    hr := StgOpenStorage(PWideChar(FileName), nil,
                         STGM_READ or STGM_SHARE_EXCLUSIVE,
                         nil, 0, Storage);
    if Failed(hr) then begin
      if hr = STG_E_FILENOTFOUND then begin
        ShowMessage('ファイルが見つかりません');
      end else
      if hr = STG_E_FILEALREADYEXISTS then begin
        ShowMessage('IStorage未対応ファイルです');
      end else begin
        ShowMessage('Error StgOpenStorage' + #13#10
                   + Format('HResult = $%.8X', [hr]));
      end;
      Exit;
    end;
    PropSetStg := Storage as IPropertySetStorage;
    hr := PropSetStg.Open(FMTID_SummaryInformation,
                          STGM_READ or STGM_SHARE_EXCLUSIVE,
                          PropStg);
  //hr := PropSetStg.Open(FMTID_UserDefinedProperties,
  //                      STGM_READ or STGM_SHARE_EXCLUSIVE,
  //                      PropStg);
    if Failed(hr) then begin
      ShowMessage('Error PropSetStg.Open' + #13#10
                 + Format('HResult = $%.8X', [hr]));
      Exit;
    end;
    for j := PIDSI_TITLE to PIDSI_DOC_SECURITY do begin
      FillChar(PrSpec[j], SizeOf(TPropSpec), 0);
      PrSpec[j].ulKind := PRSPEC_PROPID;
      PrSpec[j].propid := j;
    end;
    hr := PropStg.ReadMultiple(PIDSI_DOC_SECURITY-PIDSI_TITLE+1,
                               @PrSpec, @PrVariant);
    if Failed(hr) then begin
      ShowMessage('Error PropStg.ReadMultiple' + #13#10
                 + Format('HResult = $%.8X', [hr]));
      Exit;
    end;
    if hr <> S_FALSE then begin
      for j := PIDSI_TITLE to PIDSI_DOC_SECURITY do begin
        s := '';
        if PrVariant[j].vt = VT_LPSTR then begin
          if Assigned(PrVariant[j].pszVal) then
            s := PrVariant[j].pszVal;
        end;
        case j of
          PIDSI_TITLE:      s := 'タイトル='     + s;
          PIDSI_SUBJECT:    s := 'サブタイトル=' + s;
          PIDSI_AUTHOR:     s := '作成者='       + s;
          PIDSI_KEYWORDS:   s := 'キーワード='   + s;
          PIDSI_COMMENTS:   s := 'コメント='     + s;
          PIDSI_TEMPLATE:   s := 'テンプレート=' + s;
          PIDSI_LASTAUTHOR: s := '更新者='       + s;
          PIDSI_REVNUMBER:  s := '改訂番号='     + s;
          PIDSI_EDITTIME:
            s := Format('編集時間= %g分',
                        [int64(PrVariant[j].filetime)
                                       /10000000/60]);
          PIDSI_LASTPRINTED:
            s := '印刷日時='
               + ToDateTimeStr(PrVariant[j].filetime);
          PIDSI_CREATE_DTM:
            s := '作成日時='
               + ToDateTimeStr(PrVariant[j].filetime);
          PIDSI_LASTSAVE_DTM:
            s := '最終更新日時='
               + ToDateTimeStr(PrVariant[j].filetime);
          PIDSI_PAGECOUNT:
            s := 'ページ数=' + IntToStr(PrVariant[j].lVal);
          PIDSI_WORDCOUNT:
            s := '単語数='   + IntToStr(PrVariant[j].lVal);
          PIDSI_CHARCOUNT:
            s := '文字数='   + IntToStr(PrVariant[j].lVal);
          PIDSI_THUMBNAIL:
            ;//こいつは無視しとこ(^^;
          PIDSI_APPNAME:
            s := 'アプリケーション名=' + s;
          PIDSI_DOC_SECURITY:
            s := 'セキュリティ=' + IntToStr(PrVariant[j].lVal);
        end;
        if s <> '' then
          Result := Result + s + #13#10;
      end;
    end;
  finally
    CoUninitialize;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  s: String;
begin
  s := GetDocumentProperties('目的のファイル名');
  if s <> '' then ShowMessage(s);
end;
----- ここまで -----

  int64 を Comp に変更すれば Delphi3.1でも動作するかな？、と
  思ったら動作しませんでした。

  IPropertySetStorage, IPropertyStorage, TPropSpec, TPropVariant
  や PIDSI_TITLE〜PIDSI_DOC_SECURITYの定数などが、Delphi3.1の
  ActiveXユニットには定義されていないようです。

  また、上記のサンプルでは UserDefinedPropertiesの取得は行っ
  ておりません、手抜きです。(^^;
  もっと詳しくお知りになりたい方は↓の資料等を調べてみて下さい。

◆参考資料
  MSDN Library Article ID: Q186898

                                 99/08/08(日) 00:45 Satobe(JCG00336)

Original document by Satobe          氏 ID:(JCG00336)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。