end;

function TPropertySet.GetPropertyByID(APropertyID: Integer): TPropVariant;

var

  ps: PPropSpecArray;

  pv: PPropVariantArray;

begin

  ps := nil;

  pv := nil;

  try

    GetMem(ps, sizeof(TPropSpec));

    GetMem(pv, sizeof(TPropVariant));

    ps[0].ulKind := PRSPEC_PROPID;

    ps[0].propid := APropertyID;

    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;

end;

procedure TPropertySet.InternalOpen;

begin

  if FFileName = '' then

    raise Exception.Create('文件名必须设置!');

  OleCheck(StgOpenStorageEx(PWChar(FFileName), STGM_READ or STGM_SHARE_DENY_WRITE,

    STGFMT_ANY, 0, nil, nil, @IID_IPropertySetStorage, FStorage));

  FPropertySetStorage := FStorage as IPropertySetStorage;

  OleCheck(FPropertySetStorage.Open(FStreamGUID, STGM_READ or STGM_SHARE_EXCLUSIVE,

    FPropertyStorage));

end;

procedure TPropertySet.InternalClose;

begin

  FPropertyStorage := nil;

  FPropertySetStorage := nil;

  FStorage := nil;

end;

procedure TPropertySet.SetActive(const Value: Boolean);

begin

  if FActive <> Value then

  begin

    if Value then

      InternalOpen

    else

      InternalClose;

    FActive := Value;

  end;

end;

procedure TPropertySet.SetFileName(const Value: WideString);

begin

  if FFileName <> Value then

  begin

    if FActive then

    begin

      InternalClose;

      FFileName := Value;

      InternalOpen;

    end

    else

      FFileName := Value;

  end;

end;

procedure TPropertySet.SetStreamGUID(const Value: TGUID);

begin

  if FStreamGUID <> Value then

  begin

    if FActive then

    begin

      InternalClose;

      FStreamGUID := Value;

      InternalOpen;

    end

    else

      FStreamGUID := Value;

  end;

end;

end.