高分！如何取得文件的提示信息？

Question

请找一些关于结构化存储文件方面的书看看。Word文档是以结构化存储文件形式存储的。

Answer 1

我主要是想得到Internet快捷方式的链接地址，没人知道吗？

Answer 2

这个问题很好。文件信息的提取是个很大的题目，windows编程里专门有章节来论述，感觉上是为了很小的事，却非得费老大的力。
internet快捷方式？（超链？）一个读快捷方式的例子，不见得有用。
use shlobj;function ReadLink(AFileName: String):String;
var
  psl: IShellLink;
  ppf: IPersistFile;
  WCLinkName: array[0..Max_Path] of WideChar;
  Buf: array[0..255] of Char;
  Data: TWin32FindData;
begin
  psl:=CreateComObject(CLSID_ShellLink) as IShellLink;  
  ppf:=psl as IPersistFile;  StringToWideChar(AFileName, WCLinkName, MAX_PATH);
  ppf.Load(WCLinkName, STGM_READ);  psl.GetPath(@Buf, Max_Path, Data, SLGP_UNCPRIORITY);
  Result := StrPas(Buf);
end;

Answer 3

先看：http://www.csdn.net/expert/topic/139/139416.shtm属性集的操作组件源代码：unit PropertySet;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
{$IFDEF VER100}
  PropSets,  // For Delphi 3
{$ENDIF}  
  ComObj, ActiveX;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}';type
  TEnumPropertiesEvent = procedure(Sender: TObject; PropertyName: WideString;
    PropertyID: Integer; PropertyVariant: TPropVariant) of object;  TPropertySet = class(TComponent)
  private
    FFileName: WideString;
    FActive: Boolean;
    FStorage: IStorage;
    FPropertySetStorage: IPropertySetStorage;
    FPropertyStorage: IPropertyStorage;
    FStreamGUID: TGUID;
    FOnEnumProperties: TEnumPropertiesEvent;
    procedure SetFileName(const Value: WideString);
    procedure SetActive(const Value: Boolean);
    procedure SetStreamGUID(const Value: TGUID);
    { Private declarations }
  protected
    { Protected declarations }
    procedure InternalOpen; dynamic;
    procedure InternalClose; dynamic;
    procedure DoEnumProperty(PropertyName: WideString; PropertyID: Integer;
      PropertyVariant: TPropVariant); dynamic;
  public
    { Public declarations }
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure Enumerate;
    function GetPropertyByName(APropertyName: WideString): TPropVariant;
    function GetPropertyByID(APropertyID: Integer): TPropVariant;
    procedure SetProperty(APropertyName: WideString; AValue: WideString);
    procedure DeleteProperty(APropertyName: WideString);
  published
    { Published declarations }
    property Active: Boolean read FActive write SetActive;
    property FileName: WideString read FFileName write SetFileName;
    property OnEnumProperties: TEnumPropertiesEvent read FOnEnumProperties write FOnEnumProperties;
    property StreamGUID: TGUID read FStreamGUID write SetStreamGUID;
  end;procedure Register;implementationtype
  TPropSpecArray = array[0 .. 1000] of TPropSpec;
  PPropSpecArray = ^TPropSpecArray;
  TPropVariantArray = array[0 .. 1000] of TPropVariant;
  PPropVariantArray = ^TPropVariantArray;
  TStatPropStgArray = array[0 .. 1000] of TStatPropStg;
  PStatPropStgArray = ^TStatPropStgArray;procedure Register;
begin
  RegisterComponents('DCP', [TPropertySet]);
end;{ TPropertySet }procedure TPropertySet.Close;
begin
  Active := False;
end;procedure TPropertySet.DeleteProperty(APropertyName: WideString);
var
  ps: PPropSpecArray;
begin
  GetMem(ps, sizeof(TPropSpec));
  try
    ps[0].ulKind := PRSPEC_LPWSTR;
    ps[0].lpwstr := PWideChar(APropertyName);    OleCheck(FPropertyStorage.DeleteMultiple(1, @ps[0]));
  finally
    FreeMem(ps);
  end;
end;destructor TPropertySet.Destroy;
begin
  Close;
end;procedure TPropertySet.DoEnumProperty(PropertyName: WideString;
  PropertyID: Integer; PropertyVariant: TPropVariant);
begin
  if Assigned(FOnEnumProperties) then
    FOnEnumProperties(self, PropertyName, PropertyID, PropertyVariant);
end;procedure TPropertySet.Enumerate;
var
  ps: PPropSpecArray;
  pv: PPropVariantArray;
  sps: PStatPropStgArray;
  Enum: IEnumStatPropStg;
  Fetched: LongInt;
  Prop: TPropVariant;
begin
  ps := nil;
  pv := nil;
  sps := nil;
  try
    GetMem(ps, sizeof(TPropSpec));
    GetMem(pv, sizeof(TPropVariant));
    GetMem(sps, sizeof(TStatPropStg));    OleCheck(FPropertyStorage.Enum(Enum));    while Enum.Next(1, sps[0], @Fetched) = S_OK do begin
      Prop := GetPropertyByID(sps[0].propid);
      DoEnumProperty(sps[0].lpwstrName, sps[0].propid, Prop);
    end;
  finally
    if ps <> nil then
      FreeMem(ps);
    if pv <> nil then
      FreeMem(pv);
    if sps <> nil then
      FreeMem(sps);
  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;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;procedure TPropertySet.InternalClose;
begin
  FPropertyStorage := nil;
  FPropertySetStorage := nil;
  FStorage := nil;
end;procedure TPropertySet.InternalOpen;
begin
  FStorage := nil;
  if FFileName = '' then
    raise Exception.Create('File name must be set.');  if StgIsStorageFile(PWideChar(FFileName)) <> S_OK then
    raise Exception.Create('File ' + FFileName + ' is not a structured storage file.');  OleCheck(StgOpenStorage(PWChar(FFileName), nil,
    STGM_READWRITE or STGM_SHARE_EXCLUSIVE, nil, 0, FStorage));  FPropertySetStorage := FStorage as IPropertySetStorage;  OleCheck(FPropertySetStorage.Open(FStreamGUID, STGM_READWRITE or STGM_SHARE_EXCLUSIVE,
    FPropertyStorage));
end;procedure TPropertySet.Open;
begin
  Active := True;
end;procedure TPropertySet.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
    if Value then
      InternalOpen
    else
      InternalClose;
end;procedure TPropertySet.SetFileName(const Value: WideString);
begin
  FFileName := Value;
end;procedure TPropertySet.SetProperty(APropertyName: WideString; AValue: WideString);
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);    pv[0].vt := VT_LPSTR;
    pv[0].pszval := PChar(AValue);    OleCheck(FPropertyStorage.WriteMultiple(1, @ps[0], @pv[0], 2));
  finally
    if ps <> nil then
      FreeMem(ps);
    if pv <> nil then
      FreeMem(pv);
  end;
end;procedure TPropertySet.SetStreamGUID(const Value: TGUID);
begin
  FStreamGUID := Value;
end;end.
演示程序代码：
unit MainForm;interfaceuses
  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.