前面看了一篇文章《Delphi實作按檔案摘要屬性查找檔案》，其中給的功能可以用Delphi獲取檔案的摘要屬性。
哪位大俠幫我寫下修改摘要的功能呢？
http://wenku.baidu.com/link?url=_Y2JDM7ke6UiVtMPBKCUzDWBibhw2JJGHPBNl4g9VuB6aoZmWqKph4PqQ10XlMVQateGtVmd22LucJkkKkZNPz0MhapGgacuRrVUtf1rCEC這是《Delphi實作按檔案摘要屬性查找檔案》的文庫版。
uj5u.com熱心網友回復：
//準備讀摘要屬性的代碼unit PropertySet;
interface
uses 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，謝謝各位。
uj5u.com熱心網友回復：
word盲擼過，不知道啥是檔案的摘要
uj5u.com熱心網友回復：
這么快就進入第二頁了，高手們出來吧。uj5u.com熱心網友回復：
自己解決，散分中。uj5u.com熱心網友回復：
把解決方案分享一下uj5u.com熱心網友回復：
你是怎么弄的，把方案分享一下吧uj5u.com熱心網友回復：
接分。分享一下吧，給后來人提供些方便uj5u.com熱心網友回復：
通過ole進行的？uj5u.com熱心網友回復：
樓主把解決問題的方案給一下啊uj5u.com熱心網友回復：
uj5u.com熱心網友回復：
接分，如何解決，分享一下吧。uj5u.com熱心網友回復：
用delphi能做手機查閱WORD檔案的軟體嗎？uj5u.com熱心網友回復：
這個還與磁盤檔案格式有關哦uj5u.com熱心網友回復：
現在開發 手機軟體，大多數是 JAVA的
uj5u.com熱心網友回復：
樓主，感謝你這個讀取方法，不知道研究出怎么寫入沒有uj5u.com熱心網友回復：
呵呵接分。能否分享一下您的解決方法？uj5u.com熱心網友回復：
接分，如何解決，分享一下吧。萬眾期待！！！
uj5u.com熱心網友回復：
技術是開放的!求分享經驗!uj5u.com熱心網友回復：
樓主：滿足大家的共享需求，結賬發分啊！轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/81134.html