unit PropSets;

{
Работа с наборами свойств файлов NTFS и DOC-файлов.

Autor: Набережных С.Н.
Creation:       17/09/2005
Last modified:  21/01/2006
}

interface

uses
  Windows, ActiveX, SysUtils;

type
  EPropSetError = Exception;

  TStgPropOpenMode = (prsRead, prsReadWrite, prsTransacted);
  TMinPropID = 2..$7FFFFFFF;

  TStgOptions = packed record
    usVersion:        Word;
    reserved:         Word;
    ulSectorSize:     ULONG;
    pwcsTemplateFile: PWideChar;
  end;
  PStgOptions = ^TStgOptions;

  TStgPropInfo = record
    PropName: WideString;
    PropId: TPropID;
    PropType: TVarType;
  end;

  TPropSetsList    = array of TStatPropSetStg;
  TPropSpecList    = array of TPropSpec;
  TPropIDList      = array of Cardinal;
  TPropNameList    = array of PWideChar;
  TPropInfoList    = array of TStatPropStg;//TStgPropInfo;
  TPropVariantList = array of TPropVariant;

  TStgPropertySet = class(TObject)
  private
    FContainer: IPropertySetStorage;
    FPropSet: IPropertyStorage;
    FMode: TStgPropOpenMode;
    FPropSetID: TGuid;
    function GetIsSelected: boolean;
  protected
    procedure CheckSelected;
  public
    constructor Create(const PropSetStg: IPropertySetStorage;
      AOpenMode: TStgPropOpenMode);

    procedure GetPropSets(out List: TPropSetsList);
    procedure Select(const PropSetID: TGuid);

    procedure  GetPropSetGuid(out PropSetID: TGUID);
    function  GetPropSetName: WideString;
    procedure SetPropSetName(const NewSetName: WideString);
    procedure AddPropSet(const PropSetID,
      ClassId: TGuid; const PropSetName: WideString);
    procedure DeletePropSet(const PropSetID: TGuid);

    procedure ReadProps(const Spec: TPropSpecList;
      out PropVals: TPropVariantList);
    procedure FinalizePropVariants(const PropVal: TPropVariantList);

    procedure WriteProps(const Spec: TPropSpecList;
      const PropVals: TPropVariantList; MinID: TMinPropID);

        { PropVariantClear for ReadProp result !!!}
    procedure ReadProp(const Spec: TPropSpec; out PropVal: TPropVariant); overload;
    procedure ReadProp(ID: Cardinal; out PropVal: TPropVariant); overload;
    procedure ReadProp(const PropName: WideString; out PropVal: TPropVariant); overload;
    procedure WriteProp(const Spec: TPropSpec; const PropVal: TPropVariant;
      MinID: TMinPropID); overload;
    procedure WriteProp(ID: Cardinal; const PropVal: TPropVariant;
      MinID: TMinPropID); overload;
    procedure WriteProp(const PropName: WideString; const PropVal: TPropVariant;
      MinID: TMinPropID); overload;

    procedure FinalizeNameList(const Names: TPropNameList);
    procedure GetListNames(const IDs: TPropIDList; out Names: TPropNameList);
    procedure SetListNames(const IDs: TPropIDList; const Names: TPropNameList);
    procedure SetPropName(PropID: Cardinal; const NewPropName: WideString);
    function  GetPropName(PropID: Cardinal): WideString;

    procedure DeleteProps(const Spec: TPropSpecList);
    procedure DeleteProperty(ID: Cardinal); overload;
    procedure DeleteProperty(PropName: WideString); overload;
    procedure DeletePropNames(const IDs: TPropIDList);
    procedure Commit(Flags: Cardinal);
    procedure Revert;
    procedure SetStorageObjClass(const ClsId: TCLSID);
    procedure SetTimes(CreateTime, AccessTime, ModifyTime: TDateTime);
    procedure GetStat(out Stat: TStatStg);

    procedure GetPropsInfo(out Info: TPropInfoList);
    procedure FinalizeInformationList(const Info: TPropInfoList);

    property IsSelected: boolean read GetIsSelected;
    property Storage: IPropertySetStorage read FContainer;
    property SelectedSet: IPropertyStorage read FPropSet;
  end;

  TDocFilePropertySet = class(TStgPropertySet)
  public
    constructor Create(const AFileName: WideString;
      AOpenMode: TStgPropOpenMode);
  end;

  TNtfsPropertySet = class(TStgPropertySet)
  public
    constructor Create(const AFileName: WideString;
      AOpenMode: TStgPropOpenMode);
  end;

function StgOpenStorageEx(pwcsName: PWideChar; grfMode: DWORD; stgfmt: DWORD;
    grfAttrs: DWORD;  pOptions: PStgOptions; reserved2: Pointer;
    const riid: TGuid; out Obj): HResult; stdcall;
function StgCreateStorageEx(pwcsName: PWideChar; grfMode: DWORD; stgfmt: DWORD;
    grfAttrs: DWORD;  pOptions: PStgOptions; reserved2: Pointer;
    const riid: TGuid; out Obj): HResult; stdcall;

function PropVariantClear(const PropVal: TPropVariant): HResult; stdcall;

const

{ Predefined Property Set Format Identifiers }
  FMTID_SummaryInformation:    TGUID = '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
  FMTID_DocSummaryInformation: TGUID = '{D5CDD502-2E9C-101B-9397-08002B2CF9AE}';
  FMTID_UserDefinedProperties: TGUID = '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';

type
  TPredefinedPropSet  =  (ppsNoPredef, ppsSumInfo, ppsDocSumInfo, ppsUserDef);
  
const
  STGFMT_STORAGE      =  0;
  STGFMT_NATIVE       =  1;
  STGFMT_FILE         =  3;
  STGFMT_ANY          =  4;
  STGFMT_DOCFILE      =  5;

{ Properties of the Summary Information Property Set }
  PIDSI_TITLE         =  $00000002;
  PIDSI_SUBJECT       =  $00000003;
  PIDSI_AUTHOR        =  $00000004;
  PIDSI_KEYWORDS      =  $00000005;
  PIDSI_COMMENTS      =  $00000006;
  PIDSI_TEMPLATE      =  $00000007;
  PIDSI_LASTAUTHOR    =  $00000008;
  PIDSI_REVNUMBER     =  $00000009;
  PIDSI_EDITTIME      =  $0000000A;
  PIDSI_LASTPRINTED   =  $0000000B;
  PIDSI_CREATE_DTM    =  $0000000C;
  PIDSI_LASTSAVE_DTM  =  $0000000D;
  PIDSI_PAGECOUNT     =  $0000000E;
  PIDSI_WORDCOUNT     =  $0000000F;
  PIDSI_CHARCOUNT     =  $00000010;
  PIDSI_THUMBNAIL     =  $00000011;
  PIDSI_APPNAME       =  $00000012;
  PIDSI_SECURITY      =  $00000013;

{ Properties of the DocumentSummaryInformation and UserDefined Property Sets }
  PIDDSI_CATEGORY     =  $00000002;
  PIDDSI_PRESFORMAT   =  $00000003;
  PIDDSI_BYTECOUNT    =  $00000004;
  PIDDSI_LINECOUNT    =  $00000005;
  PIDDSI_PARCOUNT     =  $00000006;
  PIDDSI_SLIDECOUNT   =  $00000007;
  PIDDSI_NOTECOUNT    =  $00000008;
  PIDDSI_HIDDENCOUNT  =  $00000009;
  PIDDSI_MMCLIPCOUNT  =  $0000000A;
  PIDDSI_SCALE        =  $0000000B;
  PIDDSI_HEADINGPAIR  =  $0000000C;
  PIDDSI_DOCPARTS     =  $0000000D;
  PIDDSI_MANAGER      =  $0000000E;
  PIDDSI_COMPANY      =  $0000000F;
  PIDDSI_LINKSDIRTY   =  $00000010;

function FileTimeToDateTime(const FT: TFileTime): TDateTime;
function DateTimeToFileTime(DT: TDateTime): TFileTime;
function VariantTimeToDateTime(VarTime: TOleDate): TDateTime;
function DateTimeToVariantTime(DT: TDateTime): TOleDate;

procedure GetSpecificationFromInfo(const Info: TPropInfoList; out Spec: TPropSpecList);
function PropVariantToStr(const PropVal: TPropVariant; out s: string): boolean;
function PropSetIdToPredefId(const PropSetID: TGUID): TPredefinedPropSet;
function GetKnownPropName(SetID: TPredefinedPropSet; PropID: Cardinal): string;

implementation

uses ComObj, DateUtils;

const
  Ole32 = 'Ole32.dll';
  
function StgOpenStorageEx;   external Ole32 name 'StgOpenStorageEx';
function StgCreateStorageEx; external Ole32 name 'StgCreateStorageEx';
function PropVariantClear;   external Ole32 name 'PropVariantClear';

const
  StgModes: array [TStgPropOpenMode] of Cardinal =
    (STGM_READ or STGM_SHARE_EXCLUSIVE,
     STGM_READWRITE or STGM_SHARE_EXCLUSIVE,
     STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_TRANSACTED);

function FileTimeToDateTime(const FT: TFileTime): TDateTime;
var
  ST: TSystemTime;
begin
  FileTimeToSystemTime(FT, ST);
  Result:= SystemTimeToDateTime(ST);
end;

function DateTimeToFileTime(DT: TDateTime): TFileTime;
var
  ST: TSystemTime;
begin
  DateTimeToSystemTime(DT, ST);
  SystemTimeToFileTime(ST, Result);
end;

function VariantTimeToDateTime(VarTime: TOleDate): TDateTime;
var
  ST: TSystemTime;
begin
  VariantTimeToSystemTime(VarTime, ST);
  Result:= SystemTimeToDateTime(ST);
end;

function DateTimeToVariantTime(DT: TDateTime): TOleDate;
var
  ST: TSystemTime;
begin
  DateTimeToSystemTime(DT, ST);
  SystemTimeToVariantTime(ST, Result);
end;

procedure GetSpecificationFromInfo(const Info: TPropInfoList;
  out Spec: TPropSpecList);
var
  i, n: integer;
begin
  n:=Length(Info);
  SetLength(Spec, n);
  for i:=0 to pred(n) do
  begin
    Spec[i].ulKind:=PRSPEC_PROPID;
    Spec[i].propid:=Info[i].PropId;
  end;
end;

function PropVariantToStr(const PropVal: TPropVariant; out s: string): boolean;
begin
  s:= '';
  Result:= 0 = (PropVal.vt and VT_VECTOR);
  if not Result then Exit;

  case PropVal.vt and VT_TYPEMASK of
    VT_EMPTY           : s:= 'EMPTY';
    VT_I2              : s:= IntToStr(PropVal.iVal);
    VT_I4              : s:= IntToStr(PropVal.lVal);
    VT_R4              : s:= FloatToStrF(PropVal.fltVal, ffGeneral, 7, 4);
    VT_R8              : s:= FloatToStrF(PropVal.dblVal, ffGeneral, 15, 4);
    VT_CY              : s:= FloatToStrF(PropVal.cyVal,  ffGeneral, 18, 4);
    VT_DATE            : s:= DateTimeToStr(VariantTimeToDateTime(PropVal.date));
    VT_BSTR            : s:= PropVal.bstrVal;
    VT_BOOL            : if PropVal.boolVal then s:= 'TRUE' else s:= 'FALSE';
    VT_I8              : s:= IntToStr(Int64(PropVal.hVal));
    VT_LPSTR           : s:= PropVal.pszVal;
    VT_LPWSTR          : s:= PropVal.pwszVal;
    VT_FILETIME        : s:= DateTimeToStr(FileTimeToDateTime(PropVal.filetime));
    VT_CLSID           : s:= GUIDToString(PropVal.puuid^);
    else                 Result:= false;
  end;
end;

function PropSetIdToPredefId(const PropSetID: TGUID): TPredefinedPropSet;
begin
  if IsEqualGUID(PropSetID, FMTID_SummaryInformation) then
    Result:= ppsSumInfo else
  if IsEqualGUID(PropSetID, FMTID_DocSummaryInformation) then
    Result:= ppsDocSumInfo else
  if IsEqualGUID(PropSetID, FMTID_UserDefinedProperties) then
    Result:= ppsUserDef else
  Result:= ppsNoPredef;
end;

function GetKnownPropName(SetID: TPredefinedPropSet; PropID: Cardinal): string;
begin
  Result:= '';
  case SetID of
    ppsSumInfo: case PropID of
      PIDSI_TITLE         :  Result:= 'Title';
      PIDSI_SUBJECT       :  Result:= 'Subject';
      PIDSI_AUTHOR        :  Result:= 'Author';
      PIDSI_KEYWORDS      :  Result:= 'Keywords';
      PIDSI_COMMENTS      :  Result:= 'Comments';
      PIDSI_TEMPLATE      :  Result:= 'Template';
      PIDSI_LASTAUTHOR    :  Result:= 'Last Saved By';
      PIDSI_REVNUMBER     :  Result:= 'Revision Number';
      PIDSI_EDITTIME      :  Result:= 'Total Editing Time';
      PIDSI_LASTPRINTED   :  Result:= 'Last Printed';
      PIDSI_CREATE_DTM    :  Result:= 'Create Time/Date( (*))';
      PIDSI_LASTSAVE_DTM  :  Result:= 'Last saved Time/Date( (*))';
      PIDSI_PAGECOUNT     :  Result:= 'Number of Pages';
      PIDSI_WORDCOUNT     :  Result:= 'Number of Words';
      PIDSI_CHARCOUNT     :  Result:= 'Number of Characters';
      PIDSI_THUMBNAIL     :  Result:= 'Thumbnail';
      PIDSI_APPNAME       :  Result:= 'Name of Creating Application';
      PIDSI_SECURITY      :  Result:= 'Security';
    end;

    ppsDocSumInfo, ppsUserDef: case PropID of
      PIDDSI_CATEGORY     :  Result:= 'Category';
      PIDDSI_PRESFORMAT   :  Result:= 'PresentationTarget';
      PIDDSI_BYTECOUNT    :  Result:= 'Bytes';
      PIDDSI_LINECOUNT    :  Result:= 'Lines';
      PIDDSI_PARCOUNT     :  Result:= 'Paragraphs';
      PIDDSI_SLIDECOUNT   :  Result:= 'Slides';
      PIDDSI_NOTECOUNT    :  Result:= 'Notes';
      PIDDSI_HIDDENCOUNT  :  Result:= 'HiddenSlides';
      PIDDSI_MMCLIPCOUNT  :  Result:= 'MMClips';
      PIDDSI_SCALE        :  Result:= 'ScaleCrop';
      PIDDSI_HEADINGPAIR  :  Result:= 'HeadingPairs';
      PIDDSI_DOCPARTS     :  Result:= 'TitlesofParts';
      PIDDSI_MANAGER      :  Result:= 'Manager';
      PIDDSI_COMPANY      :  Result:= 'Company';
      PIDDSI_LINKSDIRTY   :  Result:= 'LinksUpToDate';
    end;
  end;
end;

{ TStgPropertySet }

procedure TStgPropertySet.AddPropSet(const PropSetID, ClassId: TGuid;
  const PropSetName: WideString);
var
  P: PGUID;
  ID: Cardinal;
  pName: PWideChar;
  Tmp: IPropertyStorage;
begin
  if IsEqualGUID(ClassId, GUID_NULL) then P:=nil
  else P:=@ClassId;
  OleCheck(FContainer.Create(PropSetID, P^, 0, StgModes[FMode], Tmp));
  if '' <> PropSetName then
  begin
    ID:= PID_DICTIONARY;
    pName:= @PropSetName[1];
    OleCheck(Tmp.WritePropertyNames(1, @ID, @pName));
  end;  
end;

procedure TStgPropertySet.CheckSelected;
begin
  if not IsSelected then
    raise EPropSetError.Create('Not selected property set.');
end;

constructor TStgPropertySet.Create(const PropSetStg: IPropertySetStorage;
  AOpenMode: TStgPropOpenMode);
begin
  FMode:=AOpenMode;
  FContainer:=PropSetStg;
end;

procedure TStgPropertySet.DeletePropSet(const PropSetID: TGuid);
begin
  if IsEqualGUID(PropSetID, FPropSetID) then Select(GUID_NULL);
  OleCheck(FContainer.Delete(PropSetID));
end;

procedure TStgPropertySet.GetPropSets(out List: TPropSetsList);
var
  Enum: IEnumSTATPROPSETSTG;
  Celt, Count: Cardinal;
  Res: HResult;
begin
  OleCheck(FContainer.Enum(Enum));
  Count:=0;
  repeat
    Celt:=4;
    SetLength(List, Count + Celt);
    Res:= Enum.Next(Celt, List[Count], @Celt);
    Inc(Count, Celt);
  until Res <> S_OK;
  SetLength(List, Count);
end;

procedure TStgPropertySet.ReadProp(const Spec: TPropSpec;
  out PropVal: TPropVariant);
begin
  CheckSelected;
  OleCheck(FPropSet.ReadMultiple(1, @Spec, @PropVal));
end;

procedure TStgPropertySet.ReadProp(ID: Cardinal;
  out PropVal: TPropVariant);
var
  Spec: TPropSpec;
begin
  if (ID < 2) or (ID > $7FFFFFFF) then
    raise EPropSetError.CreateFmt('Invalid argument(%d)', [integer(ID)]);

  Spec.ulKind:= PRSPEC_PROPID;
  Spec.propid:= ID;
  ReadProp(Spec, PropVal);
end;

procedure TStgPropertySet.ReadProp(const PropName: WideString;
  out PropVal: TPropVariant);
var
  Spec: TPropSpec;
begin
  if '' = PropName then
    raise EPropSetError.CreateFmt('Invalid argument(%s)', [PropName]);

  Spec.ulKind:= PRSPEC_LPWSTR;
  Spec.lpwstr:= PWideChar(PropName);
  ReadProp(Spec, PropVal);
end;

procedure TStgPropertySet.WriteProp(const Spec: TPropSpec;
  const PropVal: TPropVariant; MinID: TMinPropID);
begin
  CheckSelected;
  OleCheck(FPropSet.WriteMultiple(1, @Spec, @PropVal, MinID));
end;

procedure TStgPropertySet.WriteProp(ID: Cardinal;
  const PropVal: TPropVariant; MinID: TMinPropID);
var
  Spec: TPropSpec;
begin
  if (ID < 2) or (ID > $7FFFFFFF) then
    raise EPropSetError.CreateFmt('Invalid argument(%d)', [integer(ID)]);

  Spec.ulKind:= PRSPEC_PROPID;
  Spec.propid:= ID;
  WriteProp(Spec, PropVal, MinID);
end;

procedure TStgPropertySet.WriteProp(const PropName: WideString;
  const PropVal: TPropVariant; MinID: TMinPropID);
var
  Spec: TPropSpec;
begin
  if '' = PropName then
    raise EPropSetError.CreateFmt('Invalid argument(%s)', [PropName]);

  Spec.ulKind:= PRSPEC_LPWSTR;
  Spec.lpwstr:= PWideChar(PropName);
  WriteProp(Spec, PropVal, MinID);
end;

procedure TStgPropertySet.Select(const PropSetID: TGuid);
begin
  if IsEqualGUID(FPropSetID, PropSetID) then Exit;

  FPropSet:=nil; FPropSetID:=GUID_NULL;
  if IsEqualGUID(PropSetID, GUID_NULL) then Exit;
  
  OleCheck(FContainer.Open(PropSetID, StgModes[FMode], FPropSet));
  FPropSetID:=PropSetID;
end;

function TStgPropertySet.GetIsSelected: boolean;
begin
  Result:=FPropSet <> nil;
end;

procedure TStgPropertySet.ReadProps(const Spec: TPropSpecList;
  out PropVals: TPropVariantList);
var
  Len: integer;
begin
  CheckSelected;
  Len:=Length(Spec);
  if Len = 0 then Exit;
  SetLength(PropVals, Len);
  FillChar(PropVals[0], SizeOf(TPropVariant) * Len, 0);
  OleCheck(FPropSet.ReadMultiple(Len, @Spec[0], @PropVals[0]));
end;

procedure TStgPropertySet.WriteProps(const Spec: TPropSpecList;
  const PropVals: TPropVariantList; MinID: TMinPropID);
var
  LenS, LenV, Len: integer;
begin
  CheckSelected;
  LenS:= length(Spec);
  LenV:= length(PropVals);
  if LenS > LenV then Len:= LenV else Len:= LenS;
  if Len = 0 then Exit;
  OleCheck(FPropSet.WriteMultiple(Len, @Spec[0], @PropVals[0], MinID));
end;

procedure TStgPropertySet.GetListNames(const IDs: TPropIDList;
  out Names: TPropNameList);
var
  Len: integer;
begin
  CheckSelected;
  Len:=Length(IDs);
  if Len = 0 then Exit;
  SetLength(Names, Len);
  OleCheck(FPropSet.ReadPropertyNames(Len, @IDs[0], @Names[0]));
end;

procedure TStgPropertySet.SetListNames(const IDs: TPropIDList;
  const Names: TPropNameList);
var
  Len, LenID, LenN: integer;
begin
  CheckSelected;
  LenID:= Length(IDs);
  LenN:= Length(Names);
  if LenID > LenN then Len:= LenN else Len:= LenID;
  if Len = 0 then exit;
  OleCheck(FPropSet.WritePropertyNames(Len, @IDs[0], @Names[0]));
end;

procedure TStgPropertySet.DeleteProps(const Spec: TPropSpecList);
var
  n: integer;
begin
  CheckSelected;
  n:= Length(Spec);
  if n = 0 then Exit;
  OleCheck(FPropSet.DeleteMultiple(n, @Spec[0]));
end;

procedure TStgPropertySet.DeletePropNames(const IDs: TPropIDList);
var
  n: integer;
begin
  CheckSelected;
  n:= Length(IDs);
  if n = 0 then Exit;
  OleCheck(FPropSet.DeletePropertyNames(n, @IDs[0]));
end;

procedure TStgPropertySet.Commit(Flags: Cardinal);
begin
  CheckSelected;
  OleCheck(FPropSet.Commit(Flags));
end;

procedure TStgPropertySet.Revert;
begin
  CheckSelected;
  OleCheck(FPropSet.Revert);
end;

procedure TStgPropertySet.SetStorageObjClass(const ClsId: TCLSID);
begin
  CheckSelected;
  OleCheck(FPropSet.SetClass(ClsId));
end;

procedure TStgPropertySet.SetTimes(CreateTime, AccessTime,
  ModifyTime: TDateTime);
begin
  CheckSelected;
  OleCheck(FPropSet.SetTimes(
    DateTimeToFileTime(CreateTime),
    DateTimeToFileTime(AccessTime),
    DateTimeToFileTime(ModifyTime)));
end;

procedure TStgPropertySet.GetStat(out Stat: TStatStg);
begin
  CheckSelected;
  OleCheck(FPropSet.Stat(@Stat));
end;

procedure TStgPropertySet.GetPropsInfo(out Info: TPropInfoList);
var
  Enum: IEnumSTATPROPSTG;
  Celt, Count: Cardinal;
  Res: HResult;
begin
  CheckSelected;
  OleCheck(FPropSet.Enum(Enum));
  Count:= 0;
  repeat
    Celt:= 16;
    SetLength(Info, Count + Celt);
    Res:= Enum.Next(Celt, Info[Count], @Celt);
    Inc(Count, Celt);
  until Res <> S_OK;
  SetLength(Info, Count);
end;

procedure TStgPropertySet.DeleteProperty(ID: Cardinal);
var
  Spec: TPropSpec;
begin
  CheckSelected;
  Spec.ulKind:=PRSPEC_PROPID;
  Spec.propid:=ID;
  OleCheck(FPropSet.DeleteMultiple(1, @Spec));
end;

procedure TStgPropertySet.DeleteProperty(PropName: WideString);
var
  Spec: TPropSpec;
begin
  CheckSelected;
  Spec.ulKind:=PRSPEC_LPWSTR;
  Spec.lpwstr:=PWideChar(PropName);
  OleCheck(FPropSet.DeleteMultiple(1, @Spec));
end;

procedure TStgPropertySet.FinalizeNameList(const Names: TPropNameList);
var
  n: integer;
begin
  for n:=0 to Pred(Length(Names)) do
    if Names[n] <> nil then CoTaskMemFree(Names[n]);
end;

procedure TStgPropertySet.FinalizePropVariants(
  const PropVal: TPropVariantList);
var
  n: integer;
begin
  for n:=0 to Pred(Length(PropVal)) do
    PropVariantClear(PropVal[n]);
end;

procedure TStgPropertySet.FinalizeInformationList(const Info: TPropInfoList);
var
  n: integer;
begin
  for n:=0 to Pred(Length(Info)) do
    if Info[n].lpwstrName <> nil then CoTaskMemFree(Info[n].lpwstrName);
end;

function TStgPropertySet.GetPropSetName: WideString;
begin
  Result:= GetPropName(PID_DICTIONARY);
end;

function TStgPropertySet.GetPropName(PropID: Cardinal): WideString;
var
  pName: PWideChar;
begin
  CheckSelected;
  OleCheck(FPropSet.ReadPropertyNames(1, @PropID, @PName));
  try
    Result:= pName;
  finally
    if nil <> pName then CoTaskMemFree(pName);
  end;
end;

procedure TStgPropertySet.SetPropName(PropID: Cardinal;
  const NewPropName: WideString);
var
  pName: PWideChar;
begin
  CheckSelected;
  pName:= PWideChar(NewPropName);
//  if '' <> NewPropName then pName:= @NewPropName[1] else pName:= nil;
  OleCheck(FPropSet.WritePropertyNames(1, @PropID, @pName));
end;

procedure TStgPropertySet.SetPropSetName(const NewSetName: WideString);
begin
  SetPropName(PID_DICTIONARY, NewSetName);
end;

procedure TStgPropertySet.GetPropSetGuid(out PropSetID: TGUID);
begin
  CheckSelected;
  PropSetID:= FPropSetID;
end;

{ TNtfsPropertySet }

constructor TNtfsPropertySet.Create(const AFileName: WideString;
  AOpenMode: TStgPropOpenMode);
var
  TempPropStg: IPropertySetStorage;
begin
  if AOpenMode = prsTransacted then AOpenMode:= prsReadWrite;
  OleCheck(StgOpenStorageEx(PWideChar(AFileName), StgModes[AOpenMode],
                STGFMT_FILE, 0, nil, nil, IPropertySetStorage, TempPropStg));
  inherited Create(TempPropStg, AOpenMode);
end;

{ TDocFilePropertySet }

constructor TDocFilePropertySet.Create(const AFileName: WideString;
  AOpenMode: TStgPropOpenMode);
var
  TempPropStg: IPropertySetStorage;
begin
//  if AOpenMode = prsTransacted then AOpenMode:= prsReadWrite;
  OleCheck(StgOpenStorageEx(PWideChar(AFileName), StgModes[AOpenMode],
                STGFMT_STORAGE, 0, nil, nil, IPropertySetStorage, TempPropStg));
  inherited Create(TempPropStg, AOpenMode);
end;

end.
