Delphi读写COM复合文档用户自定义属性参考代码

unit UserDefinedProperties;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

ComObj, ActiveX, LocalFiles_TLB, StdVcl;

type

TVariantNameValue=packed record

Name:string;

Value:Variant;

end;

TVariantNameValueList=array of TVariantNameValue;

TUserDefinedProperties = class(TAutoObject, IUserDefinedProperties)

private

FFilePath:WideString;

FNameValues:TVariantNameValueList;

FCount:Integer;

private

procedure Set_FilePath(Value:WideString);

procedure GetProperties;

public

procedure Initialize;override;

protected

function Get_Count: Integer; safecall;

function Get_Name(Index: Integer): WideString; safecall;

function Get_Value(Index: Integer): OleVariant; safecall;

function Get_GetValueByName(const Name: WideString): OleVariant; safecall;

procedure SetValueByName(const Name: WideString; Value: OleVariant);

safecall;

public

property FilePath:WideString read FFilePath write Set_FilePath;

end;

implementation

uses ComServ,Dialogs,SysUtils,Variants,Windows,Classes;

{ TUserDefinedProperties }

procedure TUserDefinedProperties.GetProperties;

const

FMTID_UserDefinedProperties:TGU;

type

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

PPropSpecArray=^TPropSpecArray;

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

PPropVariantArray=^TPropVariantArray;

TStatPropStgArray=array[0..0] of TStatPropStg;

PStatPropStgArray=^TStatPropStgArray;

var

Storage:IStorage;

PSStorage:IPropertySetStorage;

PS:IPropertyStorage;

Enum:IEnumSTATPROPSTG;

PSArray:PPropSpecArray;

PVArray:PPropVariantArray;

SPS:PStatPropStgArray;

LocalFileTime:TFileTime;

Systime:TSystemTime;

begin

if StgOpenStorage(StringToOleStr(FFilePath),nil,STGM_READ or STGM_SHARE_EXCLUSIVE,nil,0,Storage)<>S_OK then Exit;

PSStorage:=Storage as IPropertySetStorage;

if PSStorage.Open(FMTID_UserDefinedProperties,STGM_READ or STGM_SHARE_EXCLUSIVE,PS)<>S_OK then Exit;

//

GetMem(PSArray,SizeOf(TPropSpec));

GetMem(PVArray,SizeOf(TPropVariant));

GetMem(SPS,SizeOf(TStatPropStg));

//

if PS.Enum(Enum)<>S_OK then Exit;

while Enum.Next(1,SPS[0],nil)=S_OK do

begin

Inc(FCount);

PSArray[0].ulKind:=PRSPEC_PROPID;

PSArray[0].propid:=SPS[0].propid;

PS.ReadMultiple(1,@PSArray[0],@PVArray[0]);

SetLength(FNameValues,FCount);

FNameValues[FCount-1].Name:=WideCharToString(SPS[0].lpwstrName);

case PVArray[0].vt of

//整数

VT_I4:FNameValues[FCount-1].Value:=PVArray[0].lVal;

//实数

VT_R8:FNameValues[FCount-1].Value:=PVArray[0].dblVal;

//是否

VT_BOOL:FNameValues[FCount-1].Value:=PVArray[0].boolVal;

//字符

VT_LPSTR:FNameValues[FCount-1].Value:=UTF8Decode(PVArray[0].pszVal);//一定要解码

//日期

VT_FILETIME:

begin

//日期要转换到当前时区

FileTimeToLocalFileTime(PVArray[0].filetime,LocalFileTime);

FileTimeToSystemTime(LocalFileTime,Systime);

FNameValues[FCount-1].Value:=SystemTimeToDateTime(Systime);

end;

end;

end;

//

if PSArray<>nil then FreeMem(PSArray);

if PVArray<>nil then FreeMem(PVArray);

if SPS<>nil then FreeMem(SPS);

//

PS:=nil;

PSStorage:=nil;

end;

procedure TUserDefinedProperties.Initialize;

begin

inherited;

FCount:=0;

end;

procedure TUserDefinedProperties.Set_FilePath(Value: WideString);

begin

FFilePath:=Value;

GetProperties;

end;

function TUserDefinedProperties.Get_Count: Integer;

begin

Result:=FCount;

end;

function TUserDefinedProperties.Get_Name(Index: Integer): WideString;

begin

if (Index>=0) and (Index<FCount) then Result:=FNameValues[Index].Name

else Result:='';

end;

function TUserDefinedProperties.Get_Value(Index: Integer): OleVariant;

begin

if (Index>=0) and (Index<FCount) then Result:=FNameValues[Index].Value

else Result:=NULL;

end;

function TUserDefinedProperties.Get_GetValueByName(

const Name: WideString): OleVariant;

var

Counter:Integer;

begin

for Counter:=0 to FCount-1 do

if WideCompareText(Name,FNameValues[Counter].Name)=0 then

begin

Result:=FNameValues[Counter].Value;

Exit;

end;

Result:=NULL;

end;

procedure TUserDefinedProperties.SetValueByName(const Name: WideString;

Value: OleVariant);

const

FMTID_UserDefinedProperties:TGU;

type

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

PPropSpecArray=^TPropSpecArray;

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

PPropVariantArray=^TPropVariantArray;

TStatPropStgArray=array[0..0] of TStatPropStg;

PStatPropStgArray=^TStatPropStgArray;

var

Storage:IStorage;

PSStorage:IPropertySetStorage;

PS:IPropertyStorage;

PSArray:PPropSpecArray;

PVArray:PPropVariantArray;

LocalFileTime:TFileTime;

Systime:TSystemTime;

begin

if StgOpenStorage(StringToOleStr(FFilePath),nil,STGM_READWRITE or STGM_SHARE_EXCLUSIVE,nil,0,Storage)<>S_OK then Exit;

PSStorage:=Storage as IPropertySetStorage;

if PSStorage.Open(FMTID_UserDefinedProperties,STGM_READWRITE or STGM_SHARE_EXCLUSIVE,PS)<>S_OK then Exit;

//

GetMem(PSArray,SizeOf(TPropSpec));

GetMem(PVArray,SizeOf(TPropVariant));

//

PSArray[0].ulKind:=PRSPEC_LPWSTR;

PSArray[0].lpwstr:=PWideChar(Name);

PVArray[0].vt:=VarType(Value);

if PVArray[0].vt=VT_BSTR then PVArray[0].vt:=VT_LPSTR;

if PVArray[0].vt=VT_DATE then PVArray[0].vt:=VT_FILETIME;

//

case PVArray[0].vt of

//整数

VT_I4:PVArray[0].lVal:=Value;

//实数

VT_R8:PVArray[0].dblVal:=Value;

//是否

VT_BOOL:PVArray[0].boolVal:=Value;

//字符

VT_LPSTR:PVArray[0].pszVal:=PAnsiChar(UTF8Encode(Value));

//日期

VT_FILETIME:

begin

DateTimeToSystemTime(Value,Systime);

SystemTimeToFileTime(Systime,LocalFileTime);

LocalFileTimeToFileTime(LocalFileTime,PVArray[0].filetime);

end;

end;

case PVArray[0].vt of

VT_I4,VT_R8,VT_BOOL,VT_LPSTR,VT_FILETIME:

PS.WriteMultiple(1,@PSArray[0],@PVArray[0],2);

end;

//

if PSArray<>nil then FreeMem(PSArray);

if PVArray<>nil then FreeMem(PVArray);

//

PS:=nil;

PSStorage:=nil;

end;

initialization

TAutoObjectFactory.Create(ComServer, TUserDefinedProperties, Class_UserDefinedProperties,

ciMultiInstance, tmApartment);

end.