unit1.~pas

查找并替换所有文本中的文字

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, FileCtrl, ComCtrls,shellapi,shdocvw,shlObj,wininet,mshtml,
  Menus;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Panel1: TPanel;
    Memo1: TMemo;
    GroupBox2: TGroupBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Label4: TLabel;
    Panel2: TPanel;
    ProgressBar1: TProgressBar;
    edExt: TEdit;
    Button4: TButton;
    Label6: TLabel;
    Label7: TLabel;
    btFind: TButton;
    btSingleRep: TButton;
    btReplace: TButton;
    Button1: TButton;
    Button2: TButton;
    Label8: TLabel;
    GroupBox3: TGroupBox;
    DirectoryListBox2: TDirectoryListBox;
    GroupBox4: TGroupBox;
    FileListBox1: TFileListBox;
    GroupBox5: TGroupBox;
    DriveComboBox1: TDriveComboBox;
    Edit3: TEdit;
    PopupMenu1: TPopupMenu;
    Filtercb: TFilterComboBox;
    Button3: TButton;
    Panel3: TPanel;
    procedure btSingleRepClick(Sender: TObject);
    procedure DirectoryListBox2Change(Sender: TObject);
    procedure DriveComboBox1Change(Sender: TObject);
    procedure btFindClick(Sender: TObject);
    procedure btReplaceClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FileListBox1Click(Sender: TObject);
    procedure FileListBox1DblClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  function replaceStr(sT:string;nSt:string;file1:string):integer;
  function findStr(st:string;file1:string):integer;
  function CheckExt(allExt:string;file1:string):integer;
  procedure getdirlist(dir: string;isrep:integer);
  function findStrandRep(st:string;nSt:string;file1:string):integer;
  function ReadDirectoryNames(const ParentDirectory: string;
  dirList: TStringList; filelist: TStringList): Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btSingleRepClick(Sender: TObject);
var
  file1:string;
begin
  if edit1.text='' then begin
    showmessage('没有需要替换的字符。');
    exit;
  end;
  if MessageDlg('你确定要替换所有文件中的字符:'+#13+'" '+edit1.text+'" 替换成:"'+edit2.text+'" 吗?',
      mtWarning, [mbYes, mbNo], 0) = mrNo then
  begin
    exit;
  end;
   memo1.Lines.Clear;
   file1:=FileListBox1.FileName;
   if file1='' then exit;
   if checkExt(edExt.Text,file1) = 1 then
      if findstr(edit1.Text,file1)=1 then replaceStr(edit1.text,edit2.text,file1)
      else showmessage('没有找到匹配！');

end;
//查找字符
function TForm1.findStr(st:string;file1:string):integer;
var
      sl:TStringList;
      i,j:integer;
begin
  result:=0;
  try
      sl:=TStringList.Create;
      sl.LoadFromFile(file1);
      j:=sl.Count;

      for i:=0 to j-1 do begin
         if Pos(st,sl.Strings[i])>0 then
             result:=1

      end;
      sl.Free;
  except

  end;

end;
//查找字符并且替换
function TForm1.findStrandRep(st:string;nSt:string;file1:string):integer;
var
      sl:TStringList;
      i,j:integer;
begin
      result:=0;
  try
      sl:=TStringList.Create;
      sl.LoadFromFile(file1);
      j:=sl.Count;

      for i:=0 to j-1 do begin
         if Pos(st,sl.Strings[i])>0 then begin
             result:=1;
             replaceStr(st,nst,file1);
         end;
      end;
      sl.Free;
   except

   end;
   
end;
//  替换字符
function TForm1.replaceStr(sT:string;nSt:string;file1:string):integer;
var
      a:TStringList;
      sNew,sOld:String;
      i:integer;
begin
   try
      a:=TStringList.Create;
      a.LoadFromFile(file1);
      sNew:=a.text;
      sOld:=a.text;
      sNew:=StringReplace(sNew,sT,nSt,[rfReplaceAll]);
      a.text:=sNew;

      i := CompareStr(sNew,sOld);
      if i <> 0 then begin
        memo1.Lines.Add('修改了文件：'+file1);
      end;

      a.savetofile(file1);
      a.Free;

      for i:=0 to 100 do begin
        ProgressBar1.Position:=i;
      end;
   except
      result:=0;
      exit;
   end;
   result:=1;
end;

procedure TForm1.DirectoryListBox2Change(Sender: TObject);
begin
   DirectoryListBox2.Drive:=DriveComboBox1.Drive;
   fileListBox1.Directory:=DirectoryListBox2.Directory;
end;

procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
    DirectoryListBox2.Drive:=DriveComboBox1.Drive;
end;

procedure TForm1.btFindClick(Sender: TObject);
var sDrive:string;
begin
   Memo1.Lines.Clear;
   sDrive:= DriveComboBox1.Drive+':';
   //0 不替换1替换
   getdirList(sDrive,0);
   showmessage('查找结束！');
end;
//检查扩展名
function Tform1.CheckExt(allExt:string;file1:string):integer;
var
  ext:string;
  i:integer;
begin
   ext:=file1;
   i:=pos('.',ext);
   while i>0 do begin
    i:=pos('.',ext);
    ext:=copy(ext,i+1,length(ext)-i+1);
   end;
   if pos(ext,allExt)>0 then result:=1 else result:=0;
end;
//获得目录列表
procedure TForm1.getdirlist(dir: string;isrep:integer);

var
  i: integer;
  thedir: TstringList;
  thefiles: TstringList;
begin
  thedir := TstringList.Create;
  thefiles := TstringList.create;
  ReadDirectoryNames(dir, thedir, thefiles);
  ProgressBar1.Max:=thefiles.Count;

  for i := 0 to thefiles.Count - 1 do
  begin
    if checkExt(edExt.Text,thefiles[i]) = 1 then begin
      //Memo1.Lines.Add(dir + '\' + thefiles[i]);

      //showmessage(dir);
      if findstr(edit1.Text,dir + '\' + thefiles[i])=1 then  begin
       //0 不替换1替换
         if isrep=1 then
            replaceStr(edit1.text,edit2.text,dir + '\' + thefiles[i])
         else
            Memo1.Lines.Add(dir + '\' + thefiles[i]);

         // for i:=0 to 100 do begin
          ProgressBar1.Position:=i;
      end else begin
          //Edit3.Text :=dir;
          //Memo1.Lines.Add('查找字符在文件：'+dir + '\' + thefiles[i]);
          ProgressBar1.Position:=i;
      end;

   end;

  end;
  if thedir.count > 0 then
  begin
    for i := 0 to thedir.Count - 1 do
    begin
      getdirlist(dir + '\' + thedir[i],isrep);

      //执行递归调用
    end;
  end;
  thedir.free;
end;
//读目录
function TForm1.ReadDirectoryNames(const ParentDirectory: string;
  dirList: TStringList; filelist: TStringList): Integer;
var
  Status: Integer;
  SearchRec: TSearchRec;
  function SlashSep(const Path, S: string): string;
  begin
    if AnsiLastChar(Path)^ <> '\' then
      Result := Path + '\' + S
    else
      Result := Path + S;
  end;
begin
  Result := 0;
  Status := FindFirst(SlashSep(ParentDirectory, '*.*'), faDirectory, SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory = faDirectory) then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          dirlist.Add(SearchRec.Name);
          Edit3.Text :=SearchRec.Name;
          Inc(Result);
        end;
      end
      else
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          filelist.Add(SearchRec.Name);
          Inc(Result);
        end;
      end;
      Status := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
  end;
end;
procedure TForm1.btReplaceClick(Sender: TObject);
var sDrive:string;
begin
 if edit1.text='' then begin
    showmessage('没有需要替换的字符。');
    exit;
 end;
 if MessageDlg('你确定要替换所有文件中的字符:'+#13+'" '+edit1.text+'" 替换成:"'+edit2.text+'" 吗?',
      mtWarning, [mbYes, mbNo], 0) = mrNo then
  begin
    exit;
  end;
   Memo1.Lines.Clear;
   sDrive:= DriveComboBox1.Drive+':';
   //0 不替换1替换
   getdirList(sDrive,1);
   showmessage('查找结束！');
end;

procedure TForm1.Button4Click(Sender: TObject);
var s,file1:string;
begin
edit2.text:=filtercb.Filter;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
   Memo1.Lines.Clear;
   Edit3.Text:=DirectoryListBox2.Directory;
   getdirList(DirectoryListBox2.Directory,0);
   showmessage('查找结束！');

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if edit1.text='' then begin
    showmessage('没有需要替换的字符。');
    exit;
 end;
 if MessageDlg('你确定要替换所有文件中的字符:'+#13+'" '+edit1.text+'" 替换成:"'+edit2.text+'" 吗?',
      mtWarning, [mbYes, mbNo], 0) = mrNo then
  begin
    exit;
  end;
  Edit3.Text:=DirectoryListBox2.Directory;
  Memo1.Lines.Clear;
  getdirList(DirectoryListBox2.Directory,1);
  showmessage('查找结束！');

end;
procedure TForm1.FileListBox1Click(Sender: TObject);
begin
   Edit3.Text:=FilelistBox1.FileName;
end;
procedure TForm1.FileListBox1DblClick(Sender: TObject);
var filename:string;
begin
 fileName:=FileListBox1.FileName;
if FileExists(FileName) then
  ShellExecute(handle, 'open', PChar(FileName), nil,nil, SW_SHOWNORMAL)
 else Showmessage('  对不起，您打开！');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;

end.