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}';

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

implementation

type

  TPropSpecArray = array [0..1000] of TPropSpec;

  PPropSpecArray = ^TPropSpecArray;

  TPropVariantArray = array [0..1000] of TPropVariant;

  PPropVariantArray = ^TPropVariantArray;

  tagSTGOPTIONS = record

    usVersion: ShortInt;

    reserved: Short;

    ulSectorSize: LongInt;

    pwcsTemplateFile: PWideChar;

  end;

  STGOPTIONS = ^tagSTGOPTIONS;

const

  STGFMT_STORAGE = 0;

  STGFMT_FILE = 3;

  STGFMT_ANY = 4;

  STGFMT_DOCFILE = 5;

function StgOpenStorageEx(const pwcsName: POleStr; grfMode: Longint;

  stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: STGOPTIONS; reserved2: Pointer;

  riid: PGUID; out ppObjectOpen: IStorage): HResult; stdcall;

  external 'ole32.dll';

constructor TPropertySet.Create;

begin

  inherited;

  FStreamGUID := FMTID_SummaryInformation;

end;

destructor TPropertySet.Destroy;

begin

  Close;

end;

procedure TPropertySet.Open;

begin

  Active := True;

end;

procedure TPropertySet.Close;

begin

  Active := False;

end;

function TPropertySet.GetPropertyByName(APropertyName: WideString): TPropVariant;

var

  ps: PPropSpecArray;

  pv: PPropVariantArray;

begin

  ps := nil;

  pv := nil;

  try

    GetMem(ps, sizeof(TPropSpec));

    GetMem(pv, sizeof(TPropVariant));

    ps[0].ulKind := PRSPEC_LPWSTR;

    ps[0].lpwstr := PWideChar(APropertyName);

    OleCheck(FPropertyStorage.ReadMultiple(1, @ps[0], @pv[0]));

    Result := pv[0];

  finally

    if ps <> nil then

      FreeMem(ps);

    if pv <> nil then

      FreeMem(pv);

  end;