Ciuly > How to thread the copy function you provided?

unit threadfunc1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,FileCtrl;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Type
  TBlockRec = Record
    Src,Dest: String;
    L: TStringList;
  End;

var
  Form1: TForm1;
  Block: TBlockRec;

Hi toobjectpascal!

Tested it and it works! Thanks!

Kind regards,

Peter ;-)

well, guess I woke up to late today :D

anyway, here is the threaded version but with visual progress support. BTW: accept tobjectpascals solution since he gave a working one first and you said it's not necessary the visual part ;) (though I see that the copyfiles proc was modified and the forcedirectories was replaced with a includetrainlingpathdelimiter - which is a bug of course :) )

unit2.pas - thread:

unit Unit2;

interface

uses
  Classes, messages, windows;

const WM_START_COUNT = WM_USER + 1;
      WM_COUNT_PROGRESS = WM_START_COUNT + 1;
      WM_FINISH_COUNT = WM_COUNT_PROGRESS + 1;
      WM_START_COPY = WM_FINISH_COUNT + 1;
      WM_COPY_PROGRESS = WM_START_COPY + 1;
      WM_FINISH_COPY = WM_COPY_PROGRESS + 1;
      WM_COPIER_ERROR = WM_FINISH_COPY + 1;

type
  TCopier = class(TThread)
  private
    exclude:TStrings;
    src, dst:string;
    current:int64;
    total:int64;
    window:HWND;
    procedure copyfile(src,dst:string; fie:boolean);
    procedure copyFiles(src, dst:string; doCopy:boolean);
  public
    constructor create(w:HWND; s, d:string; e:TStrings);
  protected
    procedure Execute; override;
  end;

implementation

uses sysutils;

{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TCopier.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ TCopier }

function hasExclude(list:tstrings; name:string):boolean;
var i:integer;
begin
  result:=false;
  if list=nil then
    exit;
  i:=0;
  name:=lowercase(name);
  while (i<list.Count) and (name<>lowercase(list[i])) do
    inc(i);
  result:=i<list.count;
end;

function filesize(s:string):int64;
begin
  try
    with tfilestream.Create(s, fmOpenRead OR fmShareDenyNone) do
    begin
      result:=size;
      free;
    end;
  except
    result:=0;
  end;
end;

procedure TCopier.copyfile(src, dst: string; fie: boolean);// fail if exist
const max=64000;
var s,d:TFileStream; buffer:array[1..max] of byte; read:integer;
begin
  if FileExists(dst) and fie then
    exit;
  s:=TFileStream.Create(src,fmOpenRead OR fmShareDenyNone);
  d:=TFileStream.Create(dst,fmCreate);
  repeat
    read:=s.Read(buffer, max);
    if read>0 then// should assert it maybe
    begin
      d.Write(buffer, read);
      current:=current+read;
      SendMessage(window, WM_COPY_PROGRESS, current mod $FFFFFFFF, current div $FFFFFFFF);
    end;
  until terminated or (read<max) or (s.Position=s.Size);
  s.free;
  d.free;
end;

procedure TCopier.copyFiles(src, dst:string; doCopy:boolean);
var r:tsearchrec;
begin            
  if terminated then
    exit;
  if fileexists(dst) then
  begin
    DeleteFile(dst);// this will overwrite the file
    dst:=ExtractFilePath(dst);
  end;
  dst:=IncludeTrailingPathDelimiter(dst);
  if FileExists(src) then
  begin
    if doCopy then CopyFile(pansichar(src), pansichar(dst), false)
              else
    begin
      total:=total+filesize(src);
      SendMessage(window, WM_COUNT_PROGRESS, total mod $FFFFFFFF, total div $FFFFFFFF);
    end;
    exit;
  end;
  if not DirectoryExists(src) then
    raise exception.create('directory '+src+ ' not found.');
  Src:=IncludeTrailingPathDelimiter(Src);
  ForceDirectories(dst);
  if findfirst(src+'*.*', faanyfile-favolumeid, r)=0 then
  repeat
    if not hasExclude(exclude, src+r.name) then
    begin
      if (r.Attr and fadirectory=fadirectory) then
      begin
        if (r.Name<>'.') and (r.Name<>'..') then
          copyFiles(src+r.name, dst+r.name, doCopy);
      end                                     else
      begin
        if DoCopy then CopyFile(pansichar(src+r.name), pansichar(dst+r.name), false)
                  else
        begin
          total:=total+filesize(src+r.name);
          SendMessage(window, WM_COUNT_PROGRESS, total mod $FFFFFFFF, total div $FFFFFFFF);
        end;
      end;
    end;
  until terminated or (findnext(r)<>0);
  findclose(r);
end;

constructor TCopier.create(w:HWND; s, d: string; e:TStrings);
begin
  inherited create(false);
  src:=s;
  dst:=d;
  exclude:=e;
  window:=w;
  FreeOnTerminate:=true;
end;

procedure TCopier.Execute;
begin
  try
    SendMessage(window, WM_START_COUNT, 0, 0);
    total:=0;
    copyFiles(src, dst, false);
    SendMessage(window, WM_FINISH_COUNT, total mod $FFFFFFFF, total div $FFFFFFFF);
    current:=0;
    SendMessage(window, WM_START_COPY, 0, 0);
    copyFiles(src, dst, true);
    SendMessage(window, WM_FINISH_COPY, 0, 0);
    exclude.Free;
  except
    on e:exception do
      SendMessage(window, WM_COPIER_ERROR, integer(pansichar(e.message)), 0);
  end;
end;

end.


------------------

unit1.pas main app

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, unit2, ComCtrls, Gauges, StdCtrls;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    total:int64;
    copier:TCopier;
    procedure startCount(var msg:TMessage); message WM_START_COUNT;
    procedure countProgress(var msg:TMessage); message WM_COUNT_PROGRESS;
    procedure finishCount(var msg:TMessage); message WM_FINISH_COUNT;
    procedure startCopy(var msg:TMessage); message WM_START_COPY;
    procedure copyProgress(var msg:TMessage); message WM_COPY_PROGRESS;
    procedure finishCopy(var msg:TMessage); message WM_FINISH_COPY;
    procedure copierError(var msg:TMessage); message WM_COPIER_ERROR;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.copyProgress(var msg: TMessage);
var current:int64;
begin
  current:=msg.WParam + msg.LParam * $FFFFFFFF;
  label3.caption:=inttostr(current);
  ProgressBar1.Position:=round(current*100/total);
end;

procedure TForm1.finishCopy(var msg: TMessage);
begin
  label1.caption:='Finished copy.';
  copier:=nil;
end;

procedure TForm1.finishCount(var msg: TMessage);
begin
  label1.caption:='Done counting files.';
  total:=msg.WParam + msg.LParam * $FFFFFFFF;
  ProgressBar1.Max:=100;// max here is integer, doesn't fit the whole int64 so will
  // calculate this for 0..100
end;

procedure TForm1.startCopy(var msg: TMessage);
begin
  label1.caption:=label1.caption + ' Start copy.';
end;

procedure TForm1.startCount(var msg: TMessage);
begin
  label1.caption:='Counting files...';
end;

procedure TForm1.Button1Click(Sender: TObject);
var l:tstringlist;
begin
  l:=tstringlist.create;
  l.Add('c:\test1\testing');
  copier:=TCopier.create(handle, 'c:\test1', 'c:\test2', l);// thread will free itself
end;

procedure TForm1.countProgress(var msg: TMessage);
var t:int64;
begin
  t:=msg.WParam + msg.LParam * $FFFFFFFF;
  label2.caption:=inttostr(t);
end;

procedure TForm1.copierError(var msg: TMessage);
begin
  showmessage('Error during copying: '+PAnsichar(msg.wparam));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if copier<>nil then
    copier.Suspend;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if copier<>nil then
  begin
    copier.Resume;
    copier.Terminate;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  if copier<>nil then
    copier.Resume;
end;

end.


-----------

object Form1: TForm1
  Left = 192
  Top = 114
  Width = 870
  Height = 640
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 48
    Top = 112
    Width = 32
    Height = 13
    Caption = 'Label1'
  end
  object Label2: TLabel
    Left = 48
    Top = 128
    Width = 32
    Height = 13
    Caption = 'Label2'
  end
  object Label3: TLabel
    Left = 48
    Top = 144
    Width = 32
    Height = 13
    Caption = 'Label3'
  end
  object ProgressBar1: TProgressBar
    Left = 48
    Top = 72
    Width = 481
    Height = 17
    TabOrder = 0
  end
  object Button1: TButton
    Left = 232
    Top = 200
    Width = 75
    Height = 25
    Caption = 'copy'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 328
    Top = 208
    Width = 75
    Height = 25
    Caption = 'pause'
    TabOrder = 2
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 528
    Top = 208
    Width = 75
    Height = 25
    Caption = 'stop'
    TabOrder = 3
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 416
    Top = 208
    Width = 75
    Height = 25
    Caption = 'resume'
    TabOrder = 4
    OnClick = Button4Click
  end
end


enjoy :)

one minor adjustment to teh copyfile routine:

procedure TCopier.copyfile(src, dst: string; fie: boolean);// fail if exist
const max=64000;
var s,d:TFileStream; buffer:array[1..max] of byte; read:integer;
    bad:boolean;
begin
  if FileExists(dst) and fie then
    exit;
  s:=TFileStream.Create(src,fmOpenRead OR fmShareDenyNone);
  d:=TFileStream.Create(dst,fmCreate);
  repeat
    read:=s.Read(buffer, max);
    if read>0 then// should assert it maybe
    begin
      d.Write(buffer, read);
      current:=current+read;
      SendMessage(window, WM_COPY_PROGRESS, current mod $FFFFFFFF, current div $FFFFFFFF);
    end;
  until terminated or (s.Position=s.Size);
  bad:= terminated and (s.Position<s.Size);
  s.free;
  d.free;
  if bad then
    deletefile(dst);
end;

in case the file is not copied fully, it must be removed ;)

lol not interested in the points, just being the first to respond lol (that's hard to do these days) :P

> that's hard to do these days
then I guess you didn't know about: http://www.eeqp.com/ :)

I didn't know about that EE Quick Post application either.  Thanks.

=============================
Once you start into threading and performance, I guess I'd be remiss if I didn't opine.  I just love performance and tuning discussions.

1. Optimally, you'd like to use as much RAM as available for your buffering.  This would add an additional Windows API call to get the physical memory snapshot when copying 'large' files.

2. When buffering your copying, you might want to consider employing a multiple of the hard drive's physical block size.

3. This type of process isn't going to be much of a CPU hog, since it is I/O bound.  You might get by shelling a simple asynchronous copy process, rather than a separate thread.

4. Keeping the CD drive spinning and reading will result in the shortest elapsed copy time.  This will probably require you to chain read requests, which may not be implemented in the VCL.

5. Since CDs are written on one long groove, like record albums, you would get optimal read operations if you read the data directly off the track and then output to the appropriate file.  You are limited to 255 simultaneous output files in a thread, but most CDs aren't fragmented to the point where this would pose a problem.  Implementing this reduces the seek repositioning.

6. Make sure your hard drive isn't too fragmented.

good info aikimark :)

Thanks, ciuly.  It isn't really Delphi code-specific, but that seemed to have been covered by you and TObjectPascal.

I did a quick search for an invocable utility or library that might facilitate read sector chaining to no avail. :-(

Unfortunately, most ATA CD-ROM devices are connected to non-sharable serial channels that wouldn't allow a solution of two tasks queuing successive read requests as an alternative to request chaining.

=================================
two more thoughts:
7. Since directory/file listings are frequently presented in alphabetical order, my earlier suggestion about reading at a track level might be modified to read the files in the order they were written to CD.  This does require the application to create the target directory structure prior to the first copy.  This does require the application to glom the FAT data before starting.  In this scenario, I could see some overlap of process as follows:
* glom all FAT information
* start second process to clone the CD's directory structure.  A simple shell of an XCOPY /T command would accomplish this.
* while the directory tree is being cloned, process the FAT data to facilitate the most efficient reading of the files.
* when the cloning finishes, begin the copying process

8. If storing the excluded files in a list, there are faster searching algorithms and methods than the ones suggested.  Perhaps the fastest implementation would require using a dictionary (hash) object if there are a non-trivial number of paths/files to exclude.  In this case, a sorted TStringList object would give your routine a simple (and very fast) .Find/.IndexOf method for matching excluded strings.

Note to future readers:
There is the AKRip project at http://akrip.sourceforge.net

Although it is designed for Audio (CD content) reading, it might also provide a starting point for data file reading at a sector level.

WOW I'm impressed by those replies of you all! Geeez...thanks a lot!

Kind regards,

Peter

@Peter

If you want to see some REALLY impressive stuff, look at the utilities in the mainframe world.  Two of the most impressive are:
* SyncSort
* Innovation Data Processing -- Fast Dump/Restore

Glad you liked our responses.

My friends > I just discovered I had not already accepted tobjectpascals reply though  I clearly recall doing so. Strange. I'll correct that right away!

@aikimark > could you be more specific or link me?

Kind regards,

Peter

@Ciuly > I tested your code and it rockz! Needless to say I would have rewarded you when you had replied first.

Kind regards and thanks a lot!

Peter

Ps what a privilege to get all those replies from the three of you!

I'm just glad to help ;)

@Peter

<<could you be more specific or link me?>>
These two utilities have really optimized their use of the I/O channels and disks as well as the operating system's I/O subsystem.  Since this question is in the Delphi forum, my post was to provide you with a reference to some utilities with really impressive I/O performance profiles.  If you are interested in I/O performance tuning, or want to further your understanding of computer systems, you can search the 'Net for more information about these (and other) utilities/companies.

We've only just begun to give you a start on your problem optimization.  If TObjectPascal's solution keeps the CD drive's light green, you probably won't get much better performance.

============================
<<@Ciuly > I would have rewarded you when you had replied first.>>
If you used code that was partly supplied by Ciuly, you should have split points between him and TObjectPascal.  Responding first should not be your determinant for points awarding.  If you want to change your decision, you can post a question in the Community Support forum, requesting this question be reopened for different points distribution.

@aikimark, thank you for your note on the points :)
@peter: aikimark is correct. I usually tell people the same things now and then. however, I don't tend to encourage them to reopen the quesiton, but I do ask then to keep in mind for future cases. So from my point of view you can leave the question as it is but don't forget aikimarks note ;)

@ciuly, you're welcome.

@peter, I do not deserve and do not expect to receive any points in this discussion thread.  My comments were more theoretical and philosophical than substantive to the Delphi solution you sought.

@aikimark, got the message! Thanks for the info.
@ciuly, got yours too! :-)

@all > I don't regret or doubt my decision. When I get a reply I test it and when it does what it should do, my question is answered. In this particular case both ObjectPascal and Ciuly provided copy&paste solutions...Since ObjectPascal replied first, he got all points. Mind me, at that moment I hadn't noticed Ciuly already replied. Perhaps when I had bumped into their replies at the same time, I would have tested Ciuly's reply first since he answered quite a few questions from me already.

But this is all background info. One more note though > since I tend to ask a lot of questions in yet so little time I prefer them PAQ'd to OPEN'd. I remember I had left one open some time ago which a mod then closed. The people who responed must have felt bad about me suddenly leaving here and not returning. Regardless of what caused me to 'dissappear' I will prevent that from happening again at all costs. So that's why I tend to jump on solutions as soon as possible :-)

Kind regards,

Dweep

Ps @aikimark > apart from the practical solutions people provide, I also value the gesture itself, the will to help someone out. The reason I always mention the working sample thingie is because I get lost too easily otherwise :)

@Dweep

Don't feel bad.  I, too, have lost track of one of my questions.  Fortunately, the mods and cleanup volunteers brought it to my attention so that I might take some action that helps it move to closure (post a linking question, increase points, clarify my question, etc.).  Since you pose questions on a regular basis, one or two lost/abandoned questions aren't going to tarnish your reputation.  You will still get prompt responses and good solutions.

Moreover, that experience shouldn't influence you to prematurely close questions before they've been resolved to your complete satisfaction.  Besides, many implemented solutions are the result of multiple expert posts and questioner evaluation.  Often, the final solution will be an amalgam of ideas, links, and code snippets from several sources/posts.

Despite your desire to have as few OPEN questions at any one time, your rapid closing behavior might also discourage experts from posting ideas/solutions if you are perceived as only awarding points to the first poster.  Remember that your best solutions come from
* clearly defined problems, clearly worded
* multiple expert postings (for non-trivial problems)
* active discussion thread participation by the questioner (you)

Hey my friend! What a nice reply! Thanks a lot!

Kind regards,

Dweep :-)