如何读出 word文件（doc) 中 属性->自定义页面 的内容？

Question

谢谢回答

Answer 1

参考或者直接引用下面的单元，按照下面的方法进行调用
  t:=TStringList.create;
  GetDocInfo(filename,t);
  memo1.text:=t.text;
unit DocFileInfo;// Get Summary information from Doc, PPT, XLS files
// Copyright 2002 by Ziff Davis Media, Inc.
// Written by Bruno SonninointerfaceUses Classes, SysUtils, ActiveX, ComObj, Variants, Windows;procedure GetDocInfo(const FileName : String; var List : TStringList);implementationconst
  SummaryInformationID : TGUID = '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';//
// Converts Doc FileTime to TDateTime
//
function FileTimeToDateTime(FileTime : TFileTime): TDateTime;
var
  SystemTime: TSystemTime;
begin
  Result := 0;
  FileTimeToSystemTime(FileTime, SystemTime);
  with SystemTime do
  try
    Result := EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
    Result := Result+EncodeDate(wYear, wMonth, wDay);
  except
    On EConvertError do
      ;
  end;
  if Result = 0 then
    Result := Date;
end;//
// Converts TPropVariant to String
//
function PropToString(const Prop: TPropVariant): String;
begin
  case Prop.vt of
    VT_I2:
      Result := IntToStr(Prop.iVal);
    VT_I4:
      Result := IntToStr(Prop.lVal);
    VT_R4:
      Result := FloatToStr(Prop.fltVal);
    VT_R8:
      Result := FloatToStr(Prop.dblVal);
    VT_CY:
      Result := FloatToStr(Prop.cyVal);
    VT_DATE:
      Result := DateToStr(TDateTime(Prop.date));
    VT_BSTR:
      Result := String(Prop.bstrVal);
    VT_BOOL:
      if Prop.boolVal then
        Result := 'True'
      else
        Result := 'False';
    VT_I1: // Char
      Result := String(Chr(Prop.bVal));
    VT_UI1: // Unsigned char
      Result := IntToStr(Prop.bVal);
    VT_UI2: // 2 byte unsigned int
      Result := IntToStr(Prop.uiVal);
    VT_UI4: // 4 byte unsigned int
      Result := IntToStr(Prop.ulVal);
    VT_LPSTR:
      Result := String(Prop.pszVal);
    VT_LPWSTR:
      Result := String(Prop.pwszVal);
    VT_FILETIME:
      if (Prop.filetime.dwLowDateTime = 0) and (Prop.filetime.dwHighDateTime = 0) then
        Result := ''
      else if (Prop.filetime.dwHighDateTime < 1000) then
        Result := TimeToStr(FileTimeToDateTime(Prop.filetime))
      else
        Result := DateTimeToStr(FileTimeToDateTime(Prop.filetime));
    else
      Result := '';
  end;
end;procedure GetDocInfo(const FileName : String; var List : TStringList);
const
  Captions : Array[2..19] of String = ('Title','Subject','Author','Keywords',
    'Comments','Template','Last saved by','Revision number','Total editing time',
    'Last printed','Create time/date','Last saved time/date','Number of pages',
    'Number of words','Number of characters','Thumbnail','Creating application',
    'Security');
var
  WideName: array[0..256] of WideChar;
  FileStorage : IStorage;
  PropStorage : IPropertyStorage;
  Summary : IPropertySetStorage;
  EnumStat : IEnumStatPropStg;
  StatProp : TStatPropStg;
  Name : TPropSpec;
  Value : TPropVariant;
  ValName : String;
begin
  StringToWideChar(FileName,WideName,256);
// Is storage file ?
  if StgIsStorageFile(WideName) = S_OK then begin
// Open storager file
    if StgOpenStorage(WideName, nil, STGM_READ or STGM_SHARE_DENY_WRITE, nil,
        0, FileStorage) = S_OK then
    try
// Retrieve and open summary
      Summary := FileStorage as IPropertySetStorage;
      if Summary.Open(SummaryInformationId, STGM_READ or STGM_SHARE_EXCLUSIVE,
            PropStorage) = S_OK then begin
// Enumerate properties in summary
        PropStorage.Enum(EnumStat);
        if Assigned(EnumStat) then begin
          while EnumStat.Next(1, StatProp, nil) = S_OK do begin
            Name.ulKind := PRSPEC_PROPID;
            Name.propid := StatProp.propid;
// Read property
            PropStorage.ReadMultiple(1, @Name, @Value);
            if Value.vt <> VT_EMPTY then begin
// Convert property to string
              ValName := PropToString(Value);
// Add to list
              if ValName <> '' then
                if (StatProp.propid >= 2) and (StatProp.propid <= 19) then
                  List.Add(Captions[StatProp.propid]+'='+ValName)
                else
                  List.Add('$' + IntToHex(StatProp.propid, 8)+'='+ValName);
            end;
          end;
          EnumStat := nil;
        end;
        Summary := nil;
      end;
    finally
      FileStorage := nil;
    end;
  end;
end;end.