Solved

Delphi 2010 Copy 1 file to 15 usb devices at once with progress.

Posted on 2010-11-26
11
2,218 Views
Last Modified: 2012-05-10
I am looking for a way to copy 1 video recording after it's finished to 15 usb devices. I use copyfileex at the moment and it works great but it only copies 1 file at a time.

I am looking for a way to copy the video recording ( about 500mb)  to 15 usb devices simultaneous with progress status..
0
Comment
Question by:wwijnia
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
  • 2
  • +2
11 Comments
 
LVL 13

Expert Comment

by:ThievingSix
ID: 34219232
You would need to do it in a thread.

I don't have the time right now for sample code but this seems good for now: http://stackoverflow.com/questions/1766626/copy-file-in-a-thread
0
 
LVL 32

Expert Comment

by:Ephraim Wangoya
ID: 34219279

Yap, you have to run each copy process in a thread.
The question is, will you get any significant improvements in performance. All threads will have to read from the disk at the same time
0
 
LVL 13

Expert Comment

by:ThievingSix
ID: 34219348
Unless the file to be written is in memory.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:wwijnia
ID: 34219511
Well as the harddisk is fast and the usb device's (cheap ones have a slow write speed ) it should improve.

I have zero experience with threading sadly,

I am using the following code for copying currently which i found om some site:

function CopyFileWithProgressBar2(TotalFileSize,
  TotalBytesTransferred,
  StreamSize,
  StreamBytesTransferred: LARGE_INTEGER;
  dwStreamNumber,
  dwCallbackReason: DWORD;
  hSourceFile,
  hDestinationFile: THandle;
  lpData: Pointer): DWORD; stdcall;
begin
  // just set size at the beginning
  if dwCallbackReason = CALLBACK_STREAM_SWITCH then
    TProgressBar(lpData).Max := (TotalFileSize.QuadPart div 1000);

  TProgressBar(lpData).Position := (TotalBytesTransferred.QuadPart div 1000);
  Application.ProcessMessages;
  Result := PROGRESS_CONTINUE;
end;

function tfrmMain.CopyWithProgress(sSource, sDest: string): Boolean;
begin
  // set this FCancelled to true, if you want to cancel the copy operation
  bCancelCopy := False;
  Result     := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,
    ProgressBar1, @bCancelCopy, 0);
end;

Open in new window


So how do i put this in 15 thread's  (the omnithread library looks promising) and  have them update 15 progress bars on a form, also the user has to be able to cancel the copy progress like they can in the above code.?

The source harddisk will be a solid state disk so it should provide enough read speed to supply 15 usb drives who have a max write speed of 2Mbyte/s.
0
 
LVL 13

Expert Comment

by:ThievingSix
ID: 34220087
If there isn't a working solution by tonight (or tomorrow morning) I'll do some sample code for you.
0
 
LVL 14

Expert Comment

by:systan
ID: 34221674
hi

I have made you simple application that copies source file to destination drives using multi-threading.
 
unit Unit1;

interface

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

type
  TFasterThread = class(TThread)
  private
    FPath: string;
    FProgressBar:TProgressBar;
    FCurrentPosition: integer;
    FCurrentPercent: Integer;
    FMaxPosition: integer;
  protected
  procedure CopyFileToDrives(Source, Destination: string);
  procedure Execute; override;
  procedure DoProgress;
  procedure SetProgress;
  public
    constructor Create(const APath: string; ApgbProgress:TProgressbar);
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    CheckListBox1: TCheckListBox;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Button3: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    procedure ShowDrives;
  private
    FThreadList: TList;
    procedure ThreadTerminated(ASender: TObject);
  public
  end;

var
  Form1: TForm1;
  SourceFile: String;

implementation
{$R *.dfm}


{ Thread }
constructor TFasterThread.Create(const APath: string; ApgbProgress:TProgressbar);
begin
  inherited Create(True);
  FPath:= APath;
  FProgressbar := ApgbProgress;
end;

destructor TFasterThread.Destroy;
begin
  inherited;
end;

procedure TFasterThread.SetProgress;
begin
  FProgressBar.Max := FMaxPosition;
end;

procedure TFasterThread.DoProgress;
begin
  FProgressBar.Position := FCurrentPosition;
end;

procedure TFasterThread.Execute;
var fonly:string;
begin
if SourceFile='' then exit;
fonly:=ExtractFileName(SourceFile);
  try
    CopyFileToDrives(SourceFile, FPath + fonly);
  except
  end;
end;

procedure TFasterThread.CopyFileToDrives(Source, Destination: string);
const
bufSize = 16384;
var
sStream,dStream:TFileStream;
totCnt,strmSize:LongInt;
pBuf: Pointer;
cnt: Integer;
begin
totCnt := 0;
sStream := TFileStream.Create(Source, fmOpenRead or fmShareDenyWrite);
strmSize := sStream.size;
FMaxPosition:= strmSize;
Synchronize(SetProgress);
try
dStream := TFileStream.Create(Destination, fmCreate or fmShareExclusive);
try
GetMem(pBuf, bufSize);
cnt := sStream.Read(pBuf^, bufSize);
cnt := dStream.Write(pBuf^, cnt);
totCnt := totCnt + cnt;
while (cnt > 0) do begin
Application.ProcessMessages;
cnt := sStream.Read(pBuf^, bufSize);
cnt := dStream.Write(pBuf^, cnt);
totcnt := totcnt + cnt;
FCurrentPercent := Round((totCnt / strmSize) * 100);
FCurrentPosition := dStream.Size;
Synchronize(DoProgress);
end;
finally
FreeMem(pBuf, bufSize);
dStream.Free;
end;
finally
sStream.Free;
end;
end;

{ TForm1 }
procedure TForm1.ShowDrives;
var
  Drive: Char;
  i: Integer;
  pgbProgress: TProgressbar;
begin
  for i:= 0 to CheckListBox1.Count-1 do
  begin
    CheckListBox1.Items.Objects[i].Free;
    CheckListBox1.Items.Objects[i]:= nil;
  end;
  CheckListBox1.Clear;
  for Drive := 'A' To 'Z' Do
  begin
    if (GetDriveType(PChar(Drive + ':\'))= DRIVE_FIXED) OR (GetDriveType(PChar(Drive + ':\'))= DRIVE_REMOVABLE) then
    begin
      pgbProgress:= TProgressbar.Create(Self);
      CheckListBox1.Items.AddObject(Format('%s:\',[Drive]),  pgbProgress );
      pgbProgress.Left:= CheckListBox1.Left + CheckListBox1.Width + 1;
      pgbProgress.Top:= CheckListBox1.Top + CheckListBox1.ItemRect( CheckListBox1.Count-1 ).Top;
      Self.InsertControl( pgbProgress );
    end;
 end;
end;


procedure TForm1.ThreadTerminated(ASender: TObject);
begin
  FThreadList.Remove( Pointer(ASender) );
  if FThreadList.Count = 0 then
  begin
    Button1.Enabled:= True;
    Button2.Enabled:= False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FThreadList:= TList.Create;
  ShowDrives;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FThreadList);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var i:integer;
begin
  if FThreadList.Count <= 0 then exit;
  if (MessageBox(0, 'Would you like to close form and break?', 'Not finished Yet', MB_ICONQUESTION or MB_YESNOCANCEL) = idYes) then
  begin
  for i:= 0 to FThreadList.Count-1 do
  begin
  TThread(FThreadList[i]).Terminate;
  end;
  Action:= caFree;
  end
  else
    Action:= caNone;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  Thread: TFasterThread;
  checked:boolean;
begin
if SourceFile='' then exit;
for i:= 0 to CheckListbox1.Count-1 do begin
checked := CheckListbox1.Checked[i];
if Checked then break;
end;
if not Checked then exit;
Button2.Enabled := True;
  if CheckListbox1.Count >=0 then
  begin
    Button1.Enabled:= False;
    for i :=0 to CheckListbox1.count-1  do
    begin
      if CheckListBox1.Checked[i] then
      begin
        Thread:= TFasterThread.Create( CheckListBox1.Items[i], TProgressbar(CheckListBox1.Items.Objects[i]));
        FThreadList.Add( Pointer(Thread) );
        Thread.FProgressBar.Min := 0;
        Thread.FProgressBar.Position := 0;
        Thread.OnTerminate:= ThreadTerminated;
        Thread.FreeOnTerminate:= True;
        Thread.Resume;
      end;
    end;

  end;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
  i: Integer;
begin
if Button2.Caption = 'Pause' then
begin
  if FThreadList.Count <=0 then exit;
  for i:= 0 to FThreadList.Count-1 do TThread(FThreadList[i]).Suspend;
  Button2.Caption := 'Resume';
end
else
begin
  if FThreadList.Count > 0 then
  for i:= 0 to FThreadList.Count-1 do TThread(FThreadList[i]).Resume;
  Button2.Caption := 'Pause';
end;
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
if OpenDialog1.Execute then
SourceFile := OpendiaLog1.FileName;
Form1.Caption  := 'SOURCE filename is: ['+ExtractFileName(SourceFile)+']';
end;

end.

Open in new window


I also attached the file.
 ThreadCopyFiles.zip
0
 
LVL 14

Accepted Solution

by:
systan earned 500 total points
ID: 34221700
copyfilescreenshot
1
 

Author Closing Comment

by:wwijnia
ID: 34222169
Very nice exactly what i needed.
0
 
LVL 14

Expert Comment

by:systan
ID: 34222272
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 35030379
copying multiple files at once is bogus if you have only 1 network card and 1 disc controller

take the smallest number of controllers you have:
1 disc controller
1 network
1 usb

attach all devices to those controllers
2 discs to 1 disc controller
15 servers to a hub to the network controller on the pc
15 usb sticks to the 1 usb controller

copy 15 files simultaneously will all have to done by 1 controller in each section

you need to look at load balancing by the controller ... i don't do such low level programming
0
 
LVL 14

Expert Comment

by:systan
ID: 35301148
>>i don't do such low level programming
were all learning each day, and each day we forgot we don't noticed it.
1

Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Michael from AdRem Software outlines event notifications and Automatic Corrective Actions in network monitoring. Automatic Corrective Actions are scripts, which can automatically run upon discovery of a certain undesirable condition in your network.…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
Suggested Courses
Course of the Month8 days, left to enroll

617 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question