mainform.pas

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.