umyactions.pas

这是不可多得的源代码

unit uMyActions;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, StdActns;

type
  TFileSearchAction = class(TAction)
  private
    FFile : String;
    FFiles : TStringList;
  protected
    procedure OnSearchFile(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property FileName : String Read FFile write FFile;
    property FoundFiles : TStringList read FFiles;
  end;

  TFileInfoAction = class(TAction)
  private
    FFile : String;
    FFileInfo : TStringList;
  protected
    procedure OnFileInfo(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property FileName : String Read FFile write FFile;
    property FileInfo : TStringList read FFileInfo;
  end;

  TFileMacroAction = class(TAction)
  private
    FMacroInfo : TStringList;
    SFAction : TFileSearchAction;
    FIAction : TFileInfoAction;

    function GetFileName : String;
    function GetFileInfo : TStringList;
    function GetFoundFiles : TStringList;
    procedure SetFileName(const sName : String);
  protected
    procedure OnFileMacro(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property FileName : String Read GetFileName write SetFileName;
    property FileInfo : TStringList read GetFileInfo;
    property FoundFiles : TStringList read GetFoundFiles;
    property FileMacroInfo : TStringList read FMacroInfo;
  end;

implementation

{ TFileSearchAction }

constructor TFileSearchAction.Create(AOwner: TComponent);
begin
  inherited;
  OnExecute := Self.OnSearchFile;
end;

destructor TFileSearchAction.Destroy;
begin
  FreeAndNil(FFiles);
  inherited;
end;

procedure TFileSearchAction.OnSearchFile(Sender: TObject);
var
  sr: TSearchRec;
  FileAttrs: Integer;
begin
  if (FFiles = nil) then
    FFiles := TStringList.Create;
  FFiles.Clear;
  FileAttrs := 0;
  FileAttrs := FileAttrs + faAnyFile + faDirectory + faArchive;
  if FindFirst(FileName, FileAttrs, sr) = 0 then
  begin
    repeat
      if (sr.Attr and FileAttrs) = sr.Attr then
      begin
        FFiles.Add(ExtractFilePath(FileName) + sr.Name);
      end;
      Application.ProcessMessages;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;

{ TFileInfoAction }

constructor TFileInfoAction.Create(AOwner: TComponent);
begin
  inherited;
  OnExecute := Self.OnFileInfo;
end;

destructor TFileInfoAction.Destroy;
begin
  FreeAndNil(FFileInfo);
  inherited;
end;

procedure TFileInfoAction.OnFileInfo(Sender: TObject);
var
  sr: TSearchRec;
  FileAttrs: Integer;
begin
  if (FFileInfo = nil) then
    FFileInfo := TStringList.Create;
  FFileInfo.Clear;
  FileAttrs := FileAttrs + faAnyFile + faDirectory + faArchive;
  if FindFirst(FileName, FileAttrs, sr) = 0 then
  begin
    FFileInfo.Add(ExtractFilePath(FileName) + sr.Name);
    FFileInfo.Add(DateTimeToStr(FileDateToDateTime(sr.Time) ) );
    FFileInfo.Add(IntToStr(sr.Size));
  end;
  FindClose(sr);
end;

{ TMacroAction }

constructor TFileMacroAction.Create(AOwner: TComponent);
begin
  inherited;
  FMacroInfo := TStringList.Create;
  SFAction := TFileSearchAction.Create(AOwner);
  FIAction := TFileInfoAction.Create(AOwner);
  OnExecute := Self.OnFileMacro;
end;

destructor TFileMacroAction.Destroy;
begin
  FreeAndNil(FMacroInfo);
  FreeAndNil(SFAction);
  FreeAndNil(FIAction);
  inherited;
end;

function TFileMacroAction.GetFileInfo: TStringList;
begin
  Result := FIAction.FFileInfo;
end;

function TFileMacroAction.GetFileName: String;
begin
  Result := SFAction.FileName;
end;

function TFileMacroAction.GetFoundFiles: TStringList;
begin
  Result := SFAction.FoundFiles;
end;

procedure TFileMacroAction.OnFileMacro(Sender: TObject);
var
  iCount : Integer;
  sFile : String;
begin
  SFAction.Execute;

  for iCount := 0 to SFAction.FFiles.Count - 1 do    // Iterate
  begin
    sFile := SFAction.FFiles[iCount];
    FIAction.FileName := sFile;
    FIAction.Execute;
    FMacroInfo.Add(sFile + ':' + FIAction.FFileInfo.Text);
  end;    // for
end;

procedure TFileMacroAction.SetFileName(const sName: String);
begin
  SFAction.FileName := sName;
  FIAction.FileName := sName;
end;

end.