如何用Delphi修改doc文件的摘要属性

Question

前面看了一篇文章《Delphi实现按文件摘要属性查找文件》，其中给的功能可以用Delphi获取文件的摘要属性。
哪位大侠帮我写下修改摘要的功能呢？
http://wenku.baidu.com/link?url=_Y2JDM7ke6UiVtMPBKCUzDWBibhw2JJGHPBNl4g9VuB6aoZmWqKph4PqQ10XlMVQateGtVmd22LucJkkKkZNPz0MhapGgacuRrVUtf1rCEC这是《Delphi实现按文件摘要属性查找文件》的文库版。

Answer 1

//准备读摘要属性的代码
unit PropertySet;
 
interfaceuses Windows, SysUtils, ComObj, ActiveX;type
  TPropertySet = class
  private
    FFileName: WideString;
    FActive: Boolean;
    FPropertySetStorage: IPropertySetStorage;
    FPropertyStorage: IPropertyStorage;
    FStorage: IStorage;
    FStreamGUID: TGUID;    procedure SetActive(const Value: Boolean);
    procedure SetFileName(const Value: WideString);
    procedure SetStreamGUID(const Value: TGUID);
  protected
    procedure InternalOpen; dynamic;
    procedure InternalClose; dynamic;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    function GetPropertyByName(APropertyName: WideString): TPropVariant;
    function GetPropertyByID(APropertyID: Integer): TPropVariant;
 
    property Active: Boolean read FActive write SetActive;
    property FileName: WideString read FFileName write SetFileName;
    property StreamGUID: TGUID read FStreamGUID write SetStreamGUID;
  end;const
  FMTID_SummaryInformation: TGUID = '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
  FMTID_DocumentSummaryInformation: TGUID = '{D5CDD502-2E9C-101B-9397-08002B2CF9AE}';
  FMTID_UserDefinedProperties: TGUID = '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
  IID_IPropertySetStorage : TGUID = '{0000013A-0000-0000-C000-000000000046}';implementation
type
  TPropSpecArray = array [0..1000] of TPropSpec;
  PPropSpecArray = ^TPropSpecArray;
  TPropVariantArray = array [0..1000] of TPropVariant;
  PPropVariantArray = ^TPropVariantArray;
 
  tagSTGOPTIONS = record
    usVersion: ShortInt;
    reserved: Short;
    ulSectorSize: LongInt;
    pwcsTemplateFile: PWideChar;
  end;
 
  STGOPTIONS = ^tagSTGOPTIONS;
 
const
  STGFMT_STORAGE = 0;
  STGFMT_FILE = 3;
  STGFMT_ANY = 4;
  STGFMT_DOCFILE = 5;
 
function StgOpenStorageEx(const pwcsName: POleStr; grfMode: Longint;
  stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: STGOPTIONS; reserved2: Pointer;
  riid: PGUID; out ppObjectOpen: IStorage): HResult; stdcall;
  external 'ole32.dll';constructor TPropertySet.Create;
begin
  inherited;
  FStreamGUID := FMTID_SummaryInformation;
end;
 
destructor TPropertySet.Destroy;
begin
  Close;
end;
 
procedure TPropertySet.Open;
begin
  Active := True;
end;
 
procedure TPropertySet.Close;
begin
  Active := False;
end;
 
function TPropertySet.GetPropertyByName(APropertyName: WideString): TPropVariant;
var
  ps: PPropSpecArray;
  pv: PPropVariantArray;
begin
  ps := nil;
  pv := nil;
  try
    GetMem(ps, sizeof(TPropSpec));
    GetMem(pv, sizeof(TPropVariant));
    ps[0].ulKind := PRSPEC_LPWSTR;
    ps[0].lpwstr := PWideChar(APropertyName);
    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;
 
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 (GUIDToString(FStreamGUID)<>GUIDToString(Value)) then
  begin
    if FActive then
    begin
      InternalClose;
      FStreamGUID := Value;
      InternalOpen;
    end
    else
      FStreamGUID := Value;
  end;
end;end.
//我读摘要属性的代码
procedure TForm1.Button1Click(Sender: TObject);
var
  Propertyset: TPropertySet;
  P:TPropVariant;
  path:string;
begin
  path := ExtractFilePath(application.ExeName);
  propertyset:=Tpropertyset.Create;
  PropertySet.FileName:= path+'1.doc';
          try
            PropertySet.Open;
            try
              P:= PropertySet.GetPropertyByID(6);//此处获取备注。我想要实现的是修改备注
              showMessage(p.pszVal);
            finally
              PropertySet.Close;
            end;
          except
            on EOleSysError do
            showMessage('error');
          end;
  propertyset.Free
end;我的QQ125456987，谢谢各位。

Answer 2

word盲撸过，不知道啥是文档的摘要

Answer 3

通过ole进行的？

Answer 4

用delphi能做手机查阅WORD文档的软件吗？

Answer 5

现在开发   手机软件，大多数是  JAVA的