zoukankan      html  css  js  c++  java
  • 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.

  • 相关阅读:
    DGA域名可以是色情网站域名
    使用cloudflare加速你的网站隐藏你的网站IP
    167. Two Sum II
    leetcode 563. Binary Tree Tilt
    python 多线程
    leetcode 404. Sum of Left Leaves
    leetcode 100. Same Tree
    leetcode 383. Ransom Note
    leetcode 122. Best Time to Buy and Sell Stock II
    天津Uber优步司机奖励政策(12月28日到12月29日)
  • 原文地址:https://www.cnblogs.com/MaxWoods/p/522008.html
Copyright © 2011-2022 走看看