请问如何可以只根据word文件名就可以读取文件中的属性：作者，标题?:)，谢谢：）(20分)

具体请查看 《delphi com 深入编程》
unit MainForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,
{$IFDEF VER100}
PropSets, // For Delphi 3
{$ENDIF}
PropertySet, ActiveX;

type
TfrmMain = class(TForm)
pnlBottom: TPanel;
pnlClient: TPanel;
Label1: TLabel;
cbStream: TComboBox;
Label2: TLabel;
cbPropertyName: TComboBox;
Label3: TLabel;
ecValue: TEdit;
btnFind: TButton;
btnClose: TButton;
Label4: TLabel;
lbFiles: TListBox;
PropertySet1: TPropertySet;
Label5: TLabel;
ecFilePath: TEdit;
procedure btnFindClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure cbStreamClick(Sender: TObject);
private
function Matches(P: TPropVariant): Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.DFM}

const
StreamGUIDs: array[0 .. 2] of TGUID = (
'{F29F85E0-4FF9-1068-AB91-08002B27B3D9}', // SummaryInformation
'{D5CDD502-2E9C-101B-9397-08002B2CF9AE}', // DocumentSummaryInformation
'{D5CDD505-2E9C-101B-9397-08002B2CF9AE}' // UserDefinedProperties
);

procedure TfrmMain.FormCreate(Sender: TObject);
begin
cbStream.ItemIndex := 0;
cbStreamClick(Sender);
end;

procedure TfrmMain.cbStreamClick(Sender: TObject);
begin
cbPropertyName.Items.Clear;

case cbStream.ItemIndex of
0: begin
cbPropertyName.Style := csDropDownList;
cbPropertyName.Items.AddObject('Title', TObject(PIDSI_TITLE));
cbPropertyName.Items.AddObject('Subject', TObject(PIDSI_SUBJECT));
cbPropertyName.Items.AddObject('Author', TObject(PIDSI_AUTHOR));
cbPropertyName.Items.AddObject('Keywords', TObject(PIDSI_KEYWORDS));
cbPropertyName.Items.AddObject('Comments', TObject(PIDSI_COMMENTS));
cbPropertyName.Items.AddObject('Template', TObject(PIDSI_TEMPLATE));
cbPropertyName.Items.AddObject('Last Author', TObject(PIDSI_LASTAUTHOR));
cbPropertyName.Items.AddObject('Revision Number', TObject(PIDSI_REVNUMBER));
cbPropertyName.Items.AddObject('Page Count', TObject(PIDSI_PAGECOUNT));
cbPropertyName.Items.AddObject('Word Count', TObject(PIDSI_WORDCOUNT));
cbPropertyName.Items.AddObject('Character Count', TObject(PIDSI_CHARCOUNT));
cbPropertyName.Items.AddObject('Application Name', TObject(PIDSI_APPNAME));
cbPropertyName.Items.AddObject('Document Security', TObject(PIDSI_DOC_SECURITY));
cbPropertyName.ItemIndex := 0;
end;

1: begin
cbPropertyName.Style := csDropDownList;
end;

2: begin
cbPropertyName.Style := csDropDown;
end;
end;
end;

function TfrmMain.Matches(P: TPropVariant): Boolean;
begin
case P.vt of
VT_LPSTR:
Result := UpperCase(P.pszVal) = UpperCase(ecValue.Text);

VT_I4:
Result := P.lVal = StrToInt(ecValue.Text);

// Handle other property types here...

else
Result := False;
end;
end;

procedure TfrmMain.btnFindClick(Sender: TObject);
var
SR: TSearchRec;
Res: Integer;
P: TPropVariant;
ID: Integer;
FileName: WideString;
begin
lbFiles.Items.Clear;

Res := FindFirst(ecFilePath.Text, faReadOnly or faArchive, SR);
if Res = 0 then
try
while Res = 0 do begin
FileName := ExtractFilePath(ecFilePath.Text) + SR.Name;
if StgIsStorageFile(PWideChar(FileName)) = S_OK then begin
PropertySet1.FileName := FileName;
PropertySet1.StreamGUID := StreamGuids[cbStream.ItemIndex];
PropertySet1.Open;

try
if cbStream.ItemIndex = 2 then begin
P := PropertySet1.GetPropertyByName(cbPropertyName.Text);
end else begin
ID := Integer(cbPropertyName.Items.Objects[cbPropertyName.ItemIndex]);
P := PropertySet1.GetPropertyByID(ID);
end;

if Matches(P) then
lbFiles.Items.Add(FileName);
finally
PropertySet1.Close;
end;
end;

Res := FindNext(SR);
end;
finally
FindClose(SR);
end;

if lbFiles.Items.Count = 0 then
ShowMessage('No matching files found.');
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
Close;
end;

end.

接受答案了.