unit1.pas

一个很好用的控件

unit Unit1;

{ ENHANCEMENT IDEAS:
  1. Print option
  2. Coordinate memo scroll or have a way to sync positions or use a grid
  3. Allow whole word delimiter chars to be modified
  4. backup option for changed files

  ADDED in VERSION 1.2:
  - command line for file association done
  - don't update files that haven't changed
  - return counts
  - restore/save checkbox
  - updated for text DFM files in Delphi 5

  ADDED IN VERSION 2.0:
  - added feature to fix unit and identifier name mismatch compiler warning.
  - added option to add .pas and .dcu unit names in the matching files dialog
  - added Sort button to sort both find and replace lists.
  - fixed problem with quotes not saved in ini file.
  - added validation of number of files to search/replace.
  - add source directory validation to "Show Matching Files" button.
  - changed file extension from ".REP" to ".rep"
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, abcbtn, ExtCtrls, abcedbtn, abcedtdr, Grids, abcfx,
  Menus, abcpanel, abcsplit, abcversn, abclabel, ImgList, abcmemo;

type

  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    New1: TMenuItem;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    ImageList1: TImageList;
    abcEdgePanel1: TabcEdgePanel;
    pagMain: TPageControl;
    tabStrings: TTabSheet;
    Panel1: TPanel;
    Label6: TLabel;
    abcTriSplit1: TabcTriSplit;
    abcSplitPane1: TabcSplitPane;
    memOldStrings: TabcROMemo;
    abcSplitPane2: TabcSplitPane;
    memNewStrings: TabcROMemo;
    abcSplitPane3: TabcSplitPane;
    memDescription: TMemo;
    tabSource: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label9: TLabel;
    dirSource: TabcDirectoryEdit;
    cboFiletype: TComboBox;
    rdgFileSelect: TRadioGroup;
    lstSelectFiles: TListBox;
    btnShowFiles: TButton;
    tabDest: TTabSheet;
    Label3: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    lblProgress: TLabel;
    dirDest: TabcDirectoryEdit;
    btnGo: TabcPicBtn;
    prgAllFiles: TProgressBar;
    btnStop: TabcPicBtn;
    btnPause: TabcPicBtn;
    prgCurrentFile: TProgressBar;
    chkCaseInsensitive: TCheckBox;
    chkWholeWordsOnly: TCheckBox;
    chkCopyUnchangedFiles: TCheckBox;
    chkFindOnly: TCheckBox;
    tabResults: TTabSheet;
    memResults: TMemo;
    tabHelp: TTabSheet;
    memHelp: TMemo;
    tabAbout: TTabSheet;
    Bevel2: TBevel;
    abcEffectsImage1: TabcEffectsImage;
    abcVersionLabel1: TabcVersionLabel;
    abcURLLabel1: TabcURLLabel;
    Bevel1: TBevel;
    chkFixUnitIdentifiers: TCheckBox;
    btnSort: TButton;
    Label5: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure pagMainChange(Sender: TObject);
    procedure rdgFileSelectClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure memOldStringsChange(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure btnGoClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnShowFilesClick(Sender: TObject);
    procedure dirSourceChange(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure abcSplitPane2Resize(Sender: TObject);
    procedure abcURLLabel1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure chkFixUnitIdentifiersClick(Sender: TObject);
    procedure btnSortClick(Sender: TObject);
  private
    { Private declarations }
    FDataChanged: Boolean;
    FFileName: TFileName;
    FPaused: Boolean;
    FStopped: Boolean;
    FLabelSave: string;
    FNextFileToProcess: Integer;
    FSourceFiles: TStringList;
    FSourceDir, FDestDir: string;
    FCurrentDestSubDir: string;
    FReplacements, FChangedFiles: Integer;
    {UI Methods}
    function PromptToSave: TModalResult;
    function SaveChanges(AlwaysPrompt: Boolean): Boolean;
    procedure DoSaveAs(FileName: TFileName);
    function ValidReplacementCount: Boolean;
    function ValidSourceDir: Boolean;
    function ValidDestDir: Boolean;
    procedure Clear;
    procedure OpenFile(FileName: TFileName);
    procedure FileOpen;
    procedure SetFileName(Value: TFileName);
    procedure ShowMatchingFiles;
    procedure PopulateFileSelectList;
    procedure QuickSortStrings(const lst1, lst2: TStringList; L, R: Integer; SCompare: TStringListSortCompare);
    procedure SortFindReplaceStrings;
    procedure AddUnitNamesFrom(const FileNames: TStrings);
    {String Replace Methods}
    function GetFilesToReplace: Boolean;
    procedure ReplaceAllFiles;
    procedure ReplaceInFile(Source, Dest: TFileName);
    function ReplaceTextStream(Mem: TMemoryStream): Integer;
    function ReplaceAllInString(var S: string): Integer;
    procedure UpdateCurrentFileCount(i: integer);
    procedure UpdateProgressCount(i: integer);
    procedure ResetCurrentFileCount;
    procedure ResetProgressCount;
    procedure InitProgressBars;
    {advertising}
    procedure StartShow;
    procedure StopShow;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

{$R GReplace_img.res}

{$WARN UNIT_PLATFORM OFF}

uses FileCtrl, IniFiles, abcutilf, Unit2;

const
  SEC_GENERAL = 'OST File Replace';

  SEC_DESCRIPTION = 'Description';
  SEC_REPLACE = 'Replace';
  SEC_REPLACE_WITH = 'ReplaceWith';

  ITEM_COUNT = 'ItemCount';
  ITEM_PREFIX = 'Item';
  ITEM_SOURCE = 'SourceDir';
  ITEM_DEST = 'DestDir';
  ITEM_PATTERN = 'FileTypes';
  ITEM_FILE_SELECT = 'FileSelection';
  ITEM_CASE = 'CaseInsensitive';
  ITEM_WHOLE_WORDS = 'WholeWordsOnly';
  ITEM_COPY_UNCHANGED = 'CopyUnchangedFiles';
  ITEM_FIND_ONLY = 'FindOnly';
  ITEM_UNITS = 'FixUnitIdentifiers';
  ITEM_VERSION = 'GReplaceVersion';

  C_CAPTION = 'Global Search & Replace';

{String Replace Methods}

procedure TfrmMain.AddUnitNamesFrom(const FileNames: TStrings);
var
  i, iPos: integer;
  sPasFileName: string;
  strFind, strRepl: TStringList;
begin
  //add all .pas or .dcu file names to replacements
  strFind := TStringList.Create;
  strRepl := TStringList.Create;
  try
    strFind.Assign(memOldStrings.Lines);
    strRepl.Assign(memNewStrings.Lines);
    with FileNames do
      for i := 0 to Count - 1 do
        if (LowerCase(ExtractFileExt(Strings[i])) = '.pas') or
           (LowerCase(ExtractFileExt(Strings[i])) = '.dcu') then
        begin
          sPasFileName := ExtractFileName(Strings[i]);
          iPos := Pos('.', sPasFileName);
          sPasFileName := Copy(sPasFileName, 1, iPos-1);
          if strFind.IndexOf(sPasFileName) = -1 then
          begin
            strFind.Add(sPasFileName);
            strRepl.Add(sPasFileName);
          end;
        end;
    memOldStrings.Lines.Assign(strFind);
    memNewStrings.Lines.Assign(strRepl);
  finally
    strFind.Free;
    strRepl.Free;
  end;
end;

function TfrmMain.GetFilesToReplace: Boolean;
var
  i: integer;
begin
  FSourceDir := dirSource.Text;
  if not abcLastCharInSet(FSourceDir, ['\','/']) then
    FSourceDir := FSourceDir + '\';
  FDestDir := dirDest.Text;
  if not abcLastCharInSet(FDestDir, ['\','/']) then
    FDestDir := FDestDir + '\';
  FSourceFiles.Clear;
  if rdgFileSelect.ItemIndex = 2 then
  begin
    {Selected Files}
    with lstSelectFiles do
      for i := 0 to Items.Count - 1 do
        if Selected[i] then
          FSourceFiles.Add(FSourceDir + Items[i]);
  end
  else
    abcGetFileNames(FSourceDir, cboFileType.Text, True,
      (rdgFileSelect.ItemIndex=0), FSourceFiles);

  if chkFixUnitIdentifiers.Checked then
  begin
    AddUnitNamesFrom(FSourceFiles);
    Result := ValidReplacementCount;
    if not Result then Exit;
  end;
  Result := (FSourceFiles.Count > 0);
  if not Result then
    MessageDlg('Could not find any files to search or replace.',
               mtWarning, [mbOk], 0);
end;

procedure TfrmMain.ReplaceAllFiles;
var
  i: integer;
  TimeStamp: Double;
  TargetFile, TargetDir: string;
begin
  if not FPaused then
  begin
    TimeStamp := GetTickCount;
    if not GetFilesToReplace then Exit;
    FNextFileToProcess := 0;
    FCurrentDestSubDir := '';
    FReplacements := 0;
    FChangedFiles := 0;
    memResults.Lines.Clear;
  end
  else
    TimeStamp := -1;
  if FSourceFiles.Count = 0 then
  begin
    MessageDlg('No files found matching your specification.', mtError, [mbOk], 0);
    pagMain.ActivePage := tabSource;
  end
  else
  begin
    if not FPaused then InitProgressBars;
    FPaused := False;
    FStopped := False;
    {process each file}
    for i := FNextFileToProcess to FSourceFiles.Count - 1 do
    begin
      UpdateProgressCount(i);
      ResetCurrentFileCount;
          FCurrentDestSubDir := '';
      TargetFile := abcReplaceStr(FSourceDir, FDestDir, FSourceFiles[i], True);
      TargetDir := ExtractFilePath(TargetFile);
      if TargetDir <> FCurrentDestSubDir then
      begin
        if not DirectoryExists(TargetDir) and not chkFindOnly.Checked then
          ForceDirectories(TargetDir);
        FCurrentDestSubDir := TargetDir;
      end;
      ReplaceInFile(FSourceFiles[i], TargetFile);
      Application.ProcessMessages;
      if FStopped or FPaused then
        Break
      else
        FNextFileToProcess := i+1;
    end;
  end;
  {total progress}

  if not FPaused then
  begin
    if (TimeStamp <> -1) then
    begin
      TimeStamp := (GetTickCount - TimeStamp) / 1000;
      lblProgress.Caption := 'Processed '
        + InttoStr(FSourceFiles.Count)
        + ' files in '
        + Format('%.3f', [TimeStamp])
        + ' seconds with '
        + InttoStr(FReplacements)
        + ' matches in '
        + InttoStr(FChangedFiles)
        + ' files:';
      memResults.Lines.Insert(0,'');
      memResults.Lines.Insert(0,lblProgress.Caption);
      pagMain.ActivePage := tabResults;
    end;
    ResetProgressCount;
    ResetCurrentFileCount;
  end;
end;

procedure TfrmMain.UpdateCurrentFileCount(i: integer);
begin
  prgCurrentFile.Position := i;
  prgCurrentFile.Repaint;
  Application.ProcessMessages;
end;

procedure TfrmMain.ResetCurrentFileCount;
begin
  prgCurrentFile.Position := 0;
  prgCurrentFile.Repaint;
  Application.ProcessMessages;
end;

procedure TfrmMain.ResetProgressCount;
begin
  prgAllFiles.Position := 0;
  prgAllFiles.Repaint;
  Application.ProcessMessages;
end;

procedure TfrmMain.UpdateProgressCount(i: integer);
begin
  prgAllFiles.Position := i+1;
  prgAllFiles.Repaint;
  lblProgress.Caption := 'File ' + InttoStr(i+1) + FLabelSave;
  Application.ProcessMessages;
end;

procedure TfrmMain.InitProgressBars;
begin
  prgCurrentFile.Max := memOldStrings.Lines.Count;
  prgCurrentFile.Position := 0;
  prgAllFiles.Max := FSourceFiles.Count;
  prgAllFiles.Position := FNextFileToProcess;
  FLabelSave := ' of ' + InttoStr(FSourceFiles.Count);
end;

procedure TfrmMain.ReplaceInFile(Source, Dest: TFileName);
var
  Mem1, Mem2: TMemoryStream;
  reps: integer;
  IsBinaryDFM: Boolean;
begin
  Mem1 := TMemoryStream.Create;
  try
    Mem1.LoadFromFile(Source);
    Mem1.Seek(0,0);
    IsBinaryDFM := (UpperCase(ExtractFileExt(Source)) = '.DFM') and
                   (TestStreamFormat(Mem1) = sofBinary);
    if IsBinaryDFM then
    begin
      Mem2 := TMemoryStream.Create;
      try
        ObjectResourceToText(Mem1, Mem2);
        Mem2.Seek(0,0);
        reps := ReplaceTextStream(Mem2);
        if (reps > 0) and not chkFindOnly.Checked then
        begin
          Mem1.Clear;
          Mem2.Seek(0,0);
          ObjectTextToResource(Mem2, Mem1);
          Mem1.Seek(0,0);
        end;
      finally
        Mem2.Free;
      end;
    end
    else
      reps := ReplaceTextStream(Mem1);

    if reps > 0 then
    begin
      if chkFindOnly.Checked then
        memResults.Lines.Add(Source)
      else
      begin
        Mem1.SaveToFile(Dest);
        memResults.Lines.Add(Dest);
      end;
      FReplacements := FReplacements + reps;
      FChangedFiles := FChangedFiles + 1;
    end
    else
      if chkCopyUnchangedFiles.Checked and (Source <> Dest) and not chkFindOnly.Checked then
        CopyFile(PChar(Source), PChar(Dest), FALSE);

  finally
    Mem1.Free;
  end;
end;

function TfrmMain.ReplaceTextStream(Mem: TMemoryStream): Integer;
var
  sStream: TStringStream;
  sTemp: string;
begin
  sStream := TStringStream.Create('');
  try
    Mem.Seek(0,0);
    sStream.CopyFrom(Mem, Mem.Size);
    sTemp := sStream.DataString;
    Result := ReplaceAllInString(sTemp);
    Mem.Clear;
    if sTemp <> '' then
    begin
      Mem.SetSize(Length(sTemp));
      Mem.Write(sTemp[1], Length(sTemp));
      Mem.Seek(0,0);
    end;
  finally
    sStream.Free;
  end;
end;

function TfrmMain.ReplaceAllInString(var S: string): Integer;
var
  i: integer;
  sTemp: string;
begin
  Result := 0;
  for i := 0 to memOldStrings.Lines.Count - 1 do
  begin
    UpdateCurrentFileCount(i+1);
    Result := Result + abcReplaceAllCount(
      memOldStrings.Lines[i], memNewStrings.Lines[i], S, sTemp,
      not chkCaseInsensitive.Checked, chkWholeWordsOnly.Checked);
    if Result > 0 then
      S := sTemp;
  end;
end;

{UI Methods}

procedure TfrmMain.QuickSortStrings(const lst1, lst2: TStringList; L, R: Integer; SCompare: TStringListSortCompare);
var
  I, J, P: Integer;
begin
  repeat
    I := L;
    J := R;
    P := (L + R) shr 1;
    repeat
      while SCompare(lst1, I, P) < 0 do Inc(I);
      while SCompare(lst1, J, P) > 0 do Dec(J);
      if I <= J then
      begin
        lst1.Exchange(I, J);
        lst2.Exchange(I, J);
        if P = I then
          P := J
        else if P = J then