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:TGUID='{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
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:TGUID='{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
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.
