Link to home
Start Free TrialLog in
Avatar of PeterdeB
PeterdeBFlag for Netherlands

asked on

How to implement a progressbar into this code?

Hi folks, I have this code which searches files for a string replace. I would like it to show progress by means of a progressbar. Does anyone know how to implement that, I'm not sure in which procedure it should be done as well as how it should be done.

Regards Peter
procedure TForm1.Replace_Text(FName, OldText, NewText: string);
var
  B:      Boolean;
  I:      Integer;
  L:      Integer;
  P:      Integer;
  StrList:TStringList;
  S:      string;
  T:      string;
  R:      string;
begin
  StrList := TStringList.Create;
  B := False;
  try
    L := Length(OldText);
    if Load_From_File(FName, StrList) then
    for I := 0 to StrList.Count-1 do
    begin
      S := StrList.Strings[I];
      P := Pos(OldText, S);
      if (P>0) then
      begin
        T := Copy(S, 1, P-1);
        R := Copy(S, P+L, Length(S)-P-L+1);
        S := T + NewText + R;
        StrList.Strings[I] := S;
        B := True;
      end;
    end;
  finally
    if B then
    begin
      StrList.SaveToFile(FName);
      ListBox1.Items.Add(FName);
      Application.ProcessMessages;
    end;
    StrList.Destroy;
  end;
end;
 
procedure TForm1.Replace_File(PathName: string; SL: TStringList);
var
  Found:         Integer;
  Attr:          Integer;
  I:             Integer;
//  P:             Integer;
  S:             string;
  T:             string;
  FName:         string;
  DirName:       string;
  SearchRec:     TSearchRec;
  procedure Prepare_For_Replace(Name: string);
  begin
    if ((FileGetAttr(Name) and faReadOnly) > 0) then
      FileSetAttr(Name, FileGetAttr(Name) xor faReadOnly);
    if ((FileGetAttr(Name) and faHidden) > 0) then
      FileSetAttr(Name, FileGetAttr(Name) xor faHidden);
    if ((FileGetAttr(Name) and faSysFile) > 0) then
      FileSetAttr(Name, FileGetAttr(Name) xor faSysFile);
  end;
begin
  Attr := faDirectory;
  Found := FindFirst(PathName+'*.*', Attr, SearchRec);
  while (Found=0) do
  try
    if (((FileGetAttr(SearchRec.Name) and faArchive) > 0)
    or  ((FileGetAttr(SearchRec.Name) and faAnyFile) > 0)) then
    for I := 0 to SL.Count-1 do
    begin
      FName := PathName + SearchRec.Name; // SL.Strings[I];
      if FileExists(FName) then
      begin
        Prepare_For_Replace(FName);
        S := UpperCase(ExtractFileExt(FName));
        T := UpperCase(SL.Strings[I]);
        {
        P := Pos('.', T);
        Delete(T, 1, P-1);
        }
        T := UpperCase(ExtractFileExt(T));
        if (S=T) then
        begin
          Prepare_For_Replace(FName);
          // Here to be a replacement
          if (edit1.Text<>'') then
            Replace_Text(FName, edit1.Text, Edit2.Text);
        end;
      end;
    end;
    if ((SearchRec.Attr=2064) or (SearchRec.Attr=16))
    and (not (SearchRec.Name[1]='.')) then
    begin
      DirName := PathName + SearchRec.Name + '\';
      Replace_File(DirName, SL);
    end;
  finally
    Found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  C:             Char;
  I:             Integer;
  PCRootPathName:PChar;
  DriveType:     DWORD;
  S:             string;
  SL:            TStringList;
begin
  ListBox1.Clear;
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;
  SL := TStringList.Create;
  try
    for I := 0 to CheckListBox1.Items.Count-1 do  // add extensions to search for
      if (CheckListBox1.Checked[I]) then
        SL.Add(CheckListBox1.Items.Strings[I]);
        // To scan all harddisks uncomment following code and replace
        // Replace_File('c:\bck\', SL) with Replace_File(S, SL);
 
   // for C := 'A' to 'C' do
   // begin
     // S := C + ':\';
     // PCRootPathName := PChar(S);
     // DriveType := GetDriveType(PCRootPathName);
     // if (DriveType=DRIVE_FIXED) then  // DRIVE_FIXED is HDD
      begin
       // ListBox1.Items.Add('Current scanned HDD is ' + S);
        Application.ProcessMessages;
        Replace_File(AddTrailingBackslash(btn1.text), SL); // Replace_File(S, SL);
      end;
   // end;
  finally
    Screen.Cursor := crDefault;
    SL.Destroy;
    ListBox1.Items.Add('Done.');
    ListBox1.Items.Add('Replaced '+ edit1.Text+' in '+ inttostr(listbox1.items.count -1)+' files');
  end;
end;

Open in new window

Avatar of Geert G
Geert G
Flag of Belgium image

it looks like you have a list of extensions for files in CheckListBox1
you want to change the text from Edit1 into Edit2 in the files with these extensions

if you want a progressbar, you will need to change some stuff
first consider putting this replace text routine into a thread
next let the the thread find all the files matching the criteria and put them in a list (stringlist)
(you will have a count of matching files then = max progressbar)
next process the files, 1 by 1, and thus updating the progressbar per file processed

need any help with threads ?
this is a sample using a thread and progressbar :
https://www.experts-exchange.com/questions/23848904/How-to-perform-regular-screen-refresh-while-processing.html

need any more help converting ?
The problem with proper progress information is that you need to know up front how much work you have to do. In this you don't really know that, unless you first do a run to find all files you need to replace, and then doing the actual replacing. This will take some more time though, so you'll first have to choose if you think it's worth that.
i modified the code (not a little) and got to this:


unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst;
 
type
  TForm1 = class(TForm)
    CheckListBox1: TCheckListBox;
    btn1: TEdit;
    Edit1: TEdit;
    Edit2: TEdit;
    ListBox1: TListBox;
  private
    fFileChanged: boolean;
    procedure Button1Click(Sender: TObject);
    procedure Replace_Text(FName, OldText, NewText: string);
    procedure StrListChanged(Sender: TObject);
    procedure ProcessMatchingFiles(FindText, ReplaceText: string; FileList: TStrings);
    procedure FindMatchingFiles(PathName: string; Extensions, FileList: TStrings);
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.StrListChanged(Sender: TObject);
begin
  fFileChanged := True;
end;
 
procedure TForm1.Replace_Text(FName, OldText, NewText: string);
var StrList:TStringList;
begin
  StrList := TStringList.Create;
  try
    StrList.LoadFromFile(fName);
    StrList.OnChange := StrListChanged;
    fFileChanged := False;
    StrList.Text := StringReplace(StrList.Text, OldText, NewText, [rfReplaceAll]);
    if fFileChanged then
      StrList.SaveToFile(fName);
  finally
    FreeAndNil(StrList);
  end;
end;
 
procedure TForm1.ProcessMatchingFiles(FindText, ReplaceText: string; FileList: TStrings);
var I: Integer;
begin
  //Progressbar.Max := FileList.Count;
  //Progressbar.Position := 0;
  for I := 0 to FileList.Count-1 do
  begin
    Replace_Text(FileList[I], FindText, ReplaceText);
    //Progressbar.Step(1);
  end;
end;
 
procedure TForm1.FindMatchingFiles(PathName: string; Extensions, FileList: TStrings);
var
  SearchRec:     TSearchRec;
 
  procedure CheckFile(aFileName: string);
  var I: Integer;
  begin
    if (aFileName[1] <> '.') then
    begin
      if SearchRec.Attr and faDirectory <> 0 then
        FindMatchingFiles(IncludeTrailingPathDelimiter(aFileName), Extensions, FileList)
      else
      begin
        if SearchRec.Attr and faArchive <> 0 then
          for I := 0 to Extensions.Count-1  do
            if SameText(ExtractFileExt(aFileName), Extensions[I]) then
            begin
              FileList.Add(aFileName);
              Break;
            end;
      end;
    end;
  end;
 
begin
  if FindFirst(PathName+'*.*', faAnyFile, SearchRec) = 0 then
  try
    CheckFile(PathName + SearchRec.Name);
    while FindNext(SearchRec) = 0 do
      CheckFile(PathName + SearchRec.Name);
  finally
    FindClose(SearchRec);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  I:             Integer;
  Extensions, FileList: TStringList;
begin
  Screen.Cursor := crHourGlass;
  try
    FileList := TStringList.Create;
    try
      Extensions := TStringList.Create;
      try
        for I := 0 to CheckListBox1.Items.Count-1 do  // add extensions to search for
          if CheckListBox1.Checked[I] then
            Extensions.Add(CheckListBox1.Items.Strings[I]);
        FindMatchingFiles(IncludeTrailingPathDelimiter(btn1.text), Extensions, FileList);
      finally
        FreeAndNil(Extensions);
      end;
      if ((Edit1.Text <> '') or (Edit2.Text <> '')) and (FileList.Count > 0) then
        ProcessMatchingFiles(Edit1.Text, Edit2.Text, FileList);
      ListBox1.Items.Add('Done.');
      ListBox1.Items.Add('Replaced '+ edit1.Text+' in '+ IntToStr(FileList.Count)+' files');
    finally
      FreeAndNil(FileList);
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;
 
end.

Open in new window

A simpler option if you can live with it is to just show progress bar that restarts as needed until the job is done.  This way you don't have to know the "Max" value.

Just set Max to 100, and increment value by one for each file. Of course if value > 100, you reset value to 1.  not a perfect solution, but works, if your intent is to give some visual clue of progress.




> A simpler option if you can live with it is to just show progress bar that restarts as needed until the job is done.

I find this always a very annoying solution :)
In that case try something like this: http://www.torry.net/vcl/indicat/meters/imgauge.zip

This is a progress gauge like you saw in netscape, it kind of swipes right and left, indicating activity but not saying anything about how far it is.
This is an old component, but I don't think you'd have much trouble using it in a recent version of Delphi.
it's like looking at the led display from the kit car from knight rider ...
for completenessity you should try and add that sound too  :)
Avatar of PeterdeB

ASKER

@Geert > When I tried your code Delphi nagged about an EReadError concerning an invalid property value when reading button1.onClick.

When I moved the button1.onClick procedure outside the private section Delphi stopped nagging but then I had to reset the program because it kept showing the hourglass.

@others > if it will be too complex to implement this, I will forget about the progressbar but perhaps Geerts code will work ;-)

Greets Peter

One thing more > the original code would not search entire directories. For instance if I have a folder structure like this:

c:\blah1\blah2\blah3

And I would enter c:\blah1 as path it would only search files which reside in the folder blah1. and not dig deeper into the other folders.  


changing the name of the procedure would have solved it too ...
procedure TForm1.Btn1Click(Sender: TObject);

The name for Button1 got changed to Btn1.

And I would enter c:\blah1 as path it would only search files which reside in the folder blah1. and not dig deeper into the other folders.  
my guess is you need to use c:\blah1\ as path
Hi geert,

Well I can't get it to work it keeps nagging about the invalid property value no matter what and how I try.

But alas.....regarding the other issue > you mean adding the slash would instruct it to dig deeper?

Regards Peter
No it does not ;-) But can you tell me how to change the code to let it dig deeper?

Peter
did you try my code ?
if you ommit (= weglaten) the Replace_text instruction you should get a list of files
this way you could test the procedure
and see what files you get :
actually to make the button onclick work:
delete the Button1Click procedure (using the Ctrl-X feature, copy to clipboard)
double click the Button, thus adding a event handler for onClick
past the code back in remove the old header


if that still fails, show the line where the compiler complains
procedure TForm1.ProcessMatchingFiles(FindText, ReplaceText: string; FileList: TStrings);
var I: Integer;
begin
  //Progressbar.Max := FileList.Count;
  //Progressbar.Position := 0;
  for I := 0 to FileList.Count-1 do
  begin
    //Replace_Text(FileList[I], FindText, ReplaceText);
    ListBox1.Items.Add(FileList[I]);
    //Progressbar.Step(1);
  end;
end;
 
procedure TForm1.FindMatchingFiles(PathName: string; Extensions, FileList: TStrings);
var
  SearchRec:     TSearchRec;
 
  procedure CheckFile(aFileName: string);
  var I: Integer;
  begin
    if (aFileName[1] <> '.') then
    begin
      if SearchRec.Attr and faDirectory <> 0 then
        FindMatchingFiles(IncludeTrailingPathDelimiter(aFileName), Extensions, FileList)
      else
      begin
        if SearchRec.Attr and faArchive <> 0 then
          for I := 0 to Extensions.Count-1  do
            if SameText(ExtractFileExt(aFileName), Extensions[I]) then
            begin
              FileList.Add(aFileName);
              Break;
            end;
      end;
    end;
  end;
 
begin
  if FindFirst(PathName+'*.*', faAnyFile, SearchRec) = 0 then
  try
    CheckFile(PathName + SearchRec.Name);
    while FindNext(SearchRec) = 0 do
      CheckFile(PathName + SearchRec.Name);
  finally
    FindClose(SearchRec);
  end;
end;
 
procedure TForm1.Btn1Click(Sender: TObject);
var
  I:             Integer;
  Extensions, FileList: TStringList;
begin
  Screen.Cursor := crHourGlass;
  try
    FileList := TStringList.Create;
    try
      Extensions := TStringList.Create;
      try
        for I := 0 to CheckListBox1.Items.Count-1 do  // add extensions to search for
          if CheckListBox1.Checked[I] then
            Extensions.Add(CheckListBox1.Items.Strings[I]);
        FindMatchingFiles(IncludeTrailingPathDelimiter(btn1.text), Extensions, FileList);
      finally
        FreeAndNil(Extensions);
      end;
      if ((Edit1.Text <> '') or (Edit2.Text <> '')) and (FileList.Count > 0) then
        ProcessMatchingFiles(Edit1.Text, Edit2.Text, FileList);
      ListBox1.Items.Add('Done.');
      ListBox1.Items.Add('Replaced '+ edit1.Text+' in '+ IntToStr(FileList.Count)+' files');
    finally
      FreeAndNil(FileList);
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;
 
end.

Open in new window

Hi Geert,

Delphi still stumbles upon the invalid prop value but it doesn't show a line number, so I used Eurekalog but that didnt help a thing.

Regards Peter

Exception:
-------------------------------------------------------------------------------
  2.1 Date          : Wed, 18 Feb 2009 19:23:29 +0100
  2.2 Address       : 0041DC9E
  2.3 Module Name   : MCR.exe
  2.4 Module Version:
  2.5 Type          : EReadError
  2.6 Message       : Error reading btnReplace.OnClick: Invalid property value.
  2.7 ID            : 555A
  2.8 Count         : 1
  2.9 Status        : New
  2.10 Note         :


It works now, that is no compiler errors anymore. However it seems to hang right after the button click it keeps showing the hourglass.

Peter
ASKER CERTIFIED SOLUTION
Avatar of Geert G
Geert G
Flag of Belgium image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks geert,

Peter