CopyFile problem

[user5]

The code below copies test1.mpg to the file new1.mpg and the file is copied but then the program hangs up and becomes unresponsive. After pressing button1, I can tell that the CPU is busy doing something but the program remains unresponsive.

There are some other odd things too: Right after I press the button, new1.mpg appears in bin3 with a file size of zero while the CPU is busy with something. If I then end the program, new1.mpg then shows a file size but it's different every time I run the program. new1.mpg does run in Windows Media Player okay.

The file test1.mpg may not be 'legitimate' in some ways and it's large, about 1/2 GB. The end of the button1 procedure is never reached. Is there some way that I could use a TTimer to "time out" and bust out of the button1 procedure?

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2. var newerror:boolean;
3. begin
4.  newerror := false;
5.  application.processmessages;
6.  try
7.   try
8.    begin
9.     copyfile('c:\temp52\test1.mpg','c:\temp15\bin3\new1.mpg');
10.     application.processmessages
11.    end;
12.   except
13.    On E: Exception do
14.     begin
15.      sound(350);
16.      newerror := true;
17.     end;
18.   end;
19.       finally;
20.  end;
21.  
22.  application.processmessages;
23.  sound(350);
24. end;

[Mike.Cornflake]

The code below copies test1.mpg to the file new1.mpg and the file is copied but then the program hangs up and becomes unresponsive

Functionality by design.  There's no callback during the copy process

fileutil.inc, line 626

Code: Pascal  [Select][+][-]

1.     try
2.       repeat
3.         ReadCount:=FileRead(SrcHandle,Buffer[1],High(Buffer));
4.         if ReadCount<=0 then break;
5.         WriteCount:=FileWrite(DestHandle,Buffer[1],ReadCount);
6.         if WriteCount<ReadCount then
7.         begin
8.           if ExceptionOnError then
9.             raise EWriteError.CreateFmt({SFCreateError}'Unable to write to file "%s"',[DestFileName])
10.           else
11.             Exit;
12.         end;
13.       until false;

There are some other odd things too: Right after I press the button, new1.mpg appears in bin3 with a file size of zero while the CPU is busy with something.

Is that odd?  It's the behaviour I'd expect.  The OS knows a new file is being created, doesn't know it's size yet...  During your file copy, open windows explorer to the relevant folder, and just keep hitting F5.  I'd expect the file size to increase each time.

If I then end the program, new1.mpg then shows a file size but it's different every time I run the program.

This is interesting.  I suspect though, it's just a question of explorer needing refreshing.  Hit F5 in explorer when it's finished...

Is there some way that I could use a TTimer to "time out" and bust out of the button1 procedure?

Not with the routine you're calling.  Bet you're not the first with this requirement (and I'm certain there was a topic on here two, three years ago).  You'll need to call a different CopyFile procedure, one with callback functionality.

UPDATE: That historical conversation I was remembering was about copying folders, not files, and there were still no callback's.

The following *hack* works.  careful though.  This is all happening in the main application thread.  I note you're going a little overboard with the application.processmessages, I wouldn't want you to add that in the callback.  (Anything you do in the callblack will slow the copy process, and adding Application.Processmessages will make it look like the copy is happening in a different thread - but it isn't.  Short version - badness can happen if you stick application.processmessages in the callback.  please don't

Code: Pascal  [Select][+][-]

1. Unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. Interface
6.  
7. Uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
9.  
10. Type
11.  
12.   { TForm1 }
13.  
14.   TCopyFileProgress = Procedure(ASize, ATotalBytesRead: Longint) Of Object;
15.  
16.   TForm1 = Class(TForm)
17.     Button1: TButton;
18.     Memo1: TMemo;
19.     Procedure Button1Click(Sender: TObject);
20.     Procedure CopyFileProgress(ASize, ATotalBytesRead: Longint);
21.   Private
22.     { private declarations }
23.   Public
24.     { public declarations }
25.   End;
26.  
27. Var
28.   Form1: TForm1;
29.  
30. Implementation
31.  
32. Uses
33.   LazFileUtils;
34.  
35. {$R *.lfm}
36.  
37. { TForm1 }
38. Function CopyFile(Const SrcFilename, DestFilename: String; FOnCopyFileProgress: TCopyFileProgress;
39.   Flags: TCopyFileFlags = [cffOverwriteFile];
40.   ExceptionOnError: Boolean = False): Boolean;
41. Var
42.   SrcHandle: THandle;
43.   DestHandle: THandle;
44.   Buffer: Array[1..4096] Of Byte;
45.   ReadCount, WriteCount, TryCount: Longint;
46.  
47.   TotalRead, FileSize : LongInt;
48.  
49. Begin
50.   Result := False;
51.   // check overwrite
52.   If (Not (cffOverwriteFile In Flags)) And LazFileUtils.FileExistsUTF8(DestFileName) Then
53.     exit;
54.   // check directory
55.   If (cffCreateDestDirectory In Flags) And
56.     (Not LazFileUtils.DirectoryExistsUTF8(ExtractFilePath(DestFileName))) And
57.     (Not LazFileUtils.ForceDirectoriesUTF8(ExtractFilePath(DestFileName))) Then
58.     exit;
59.   TryCount := 0;
60.   While TryCount <> 3 Do
61.   Begin
62.     SrcHandle := LazFileUtils.FileOpenUTF8(SrcFilename, fmOpenRead Or fmShareDenyWrite);
63.     If (THandle(SrcHandle) = feInvalidHandle) Then
64.     Begin
65.       Inc(TryCount);
66.       Sleep(10);
67.     End
68.     Else
69.     Begin
70.       TryCount := 0;
71.       Break;
72.     End;
73.   End;
74.   If TryCount > 0 Then
75.     If ExceptionOnError Then
76.       Raise EFOpenError.CreateFmt({SFOpenError}'Unable to open file "%s"', [SrcFilename])
77.     Else
78.       exit;
79.   Try
80.     FileSize := LazFileUtils.FileSizeUtf8(SrcFilename);
81.     TotalRead := 0;
82.     DestHandle := LazFileUtils.FileCreateUTF8(DestFileName);
83.     If (THandle(DestHandle) = feInvalidHandle) Then
84.       If ExceptionOnError Then
85.         Raise EFCreateError.CreateFmt({SFCreateError}'Unable to create file "%s"', [DestFileName])
86.       Else
87.         Exit;
88.     Try
89.       Repeat
90.         ReadCount := FileRead(SrcHandle, Buffer[1], High(Buffer));
91.         TotalRead := TotalRead + ReadCount;
92.         If Assigned(FOnCopyFileProgress) Then
93.           FOnCopyFileProgress(FileSize, TotalRead);
94.         If ReadCount <= 0 Then
95.           break;
96.         WriteCount := FileWrite(DestHandle, Buffer[1], ReadCount);
97.         If WriteCount < ReadCount Then
98.           If ExceptionOnError Then
99.             Raise EWriteError.CreateFmt({SFCreateError}'Unable to write to file "%s"',
100.               [DestFileName])
101.           Else
102.             Exit;
103.       Until False;
104.     Finally
105.       FileClose(DestHandle);
106.     End;
107.     If (cffPreserveTime In Flags) Then
108.       LazFileUtils.FileSetDateUTF8(DestFilename, FileGetDate(SrcHandle));
109.     Result := True;
110.   Finally
111.     FileClose(SrcHandle);
112.   End;
113. End;
114.  
115. Procedure TForm1.Button1Click(Sender: TObject);
116. Var
117.   newerror: Boolean;
118. Begin
119.   newerror := False;
120.   Button1.Enabled := False;
121.   Cursor := crHandPoint;
122.   Application.ProcessMessages;
123.   Try
124.     Try
125.       Begin
126.         copyfile('K:\Downloads\Unsorted\DraftSight64.exe', 'K:\Downloads\Unsorted\DraftSight642.exe',
127.           @CopyFileProgress);
128.       End;
129.     Except
130.       On E: Exception Do
131.       Begin
132.         newerror := True;
133.       End;
134.     End;
135.   Finally;
136.     Cursor := crDefault;
137.     Button1.Enabled := True;
138.   End;
139. End;
140.  
141. Procedure TForm1.CopyFileProgress(ASize, ATotalBytesRead: Longint);
142. Begin
143.   Memo1.Lines.Add(Format('Read %d of %d', [ATotalBytesRead, ASize]));
144. End;
145.  
146. End.

UPDATE2: Also, this callback is being called far too many times. After every 4K of copy in fact.  Should really be protected so it's called every 5% or 10% of Filesize. Something like that

[user5]

Mike.Cornflake, thank you for your helpful suggestions. I've been looking at the Windows API and especially CopyFileEx, which can be cancelled but I'm not sure how to use it yet.

I tried unsuccessfully to compile the code you posted but I must be doing something dumb because I get compiler error messages that say the identifiers TCopyFileFlags, cffOverwriteFile etc. can't be found. 

[Mike.Cornflake]

Wild guess - you missed the uses...

Code: Pascal  [Select][+][-]

1. Implementation
2.  
3. Uses
4.   LazFileUtils;

Nope, it's FileUtil you need

Code: Pascal  [Select][+][-]

1. Interface
2.  
3. Uses
4.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

[user5]

I must be missing something here because both LazFileUtils and FileUtil are in the uses clause but it still doesn't compile.

[Mike.Cornflake]

:-)   Post your entire unit here (enclosed in Code tags) and I'll check it out.

UPDATE:  Mind you, your original code shouldn't have compiled if you're having this problem.   Something else might be going on.

Start a new project (or revert to an earlier version of your code).  Press <ctrl> and click on CopyFile.  Which unit do you end up in?  I end up in FileUtil, then when I <ctrl> down, I end up in fileutil.inc.

I'm wondering if your paths are set up differently, and you're using different units all round...

[Jurassic Pork]

hello,
to copy file , you can try also this ( you can remove progressbar code and change the size of the buffer ) :

Code: Pascal  [Select][+][-]

1. procedure NewFileCopy(SourceName,DestName:string);
2.  var
3.    SourceF,DestF:file;
4.    Buf:array [0..4096] of byte;
5.    NumRead,FSize,BytesCopied:int64;
6.  begin
7.    AssignFile(SourceF,SourceName);
8.    AssignFile(DestF,DestName);
9.    FileMode:=0;
10.    Reset(SourceF,1);
11.    Rewrite(DestF,1);
12.    FSize:=FileSize(SourceF);
13.    BytesCopied:=0;
14.    Form1.ProgressBar1.Max := 100;
15.    while not Eof(SourceF) do
16.    begin
17.      Blockread(SourceF,Buf,SizeOf(Buf),NumRead);
18.      Blockwrite(DestF,Buf,NumRead);
19.      Inc(BytesCopied,NumRead);
20.      Form1.ProgressBar1.Position:=(BytesCopied*100) div FSize;
21.      Application.ProcessMessages;
22.    end; (* while *)
23.    CloseFile(SourceF);
24.    CloseFile(DestF);
25.  end;

Friendly, J.P

[Thaddy]

Note that for what you want there is the CopyFileEx windows API with its associated callback function.
It is recently added to the windows unit in trunk.

[user5]

Jurassic Pork, what a coincidence! Before reading your message I came across the same code that you posted at www.experts-exchange.com/...

I changed the code a bit and while the modified code shown probably isn't the best solution, at least it does allow an escape from a copying process that is taking more than a maximum allowed amount of time. It's fast, too.

Thaddy, if it's not too much trouble, could you post a simple example of how to use CopyFileEx with the callback procedure? I always have a hard time adapting Windows API stuff. I can't get the compiler to recognize CopyFileEx even though I have Windows in the uses clause. If it's a bother, don't sweat it.

Thanks again to all for going to the trouble of trying to help me.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   windows, SysUtils, FileUtil,wincrt,
9.   Forms,  Controls, Graphics, LResources, Process, ExtCtrls, Dialogs, StdCtrls,
10.   LCLProc,  ActnList, LCLIntf, LCLType, Interfaces, Buttons, ExtDlgs, Menus,
11.   ComCtrls,  strutils, Classes, GraphType;
12.  
13. type
14.  
15.   { TForm1 }
16.  
17.   TForm1 = class(TForm)
18.     Button1: TButton;
19.     Timer1: TTimer;
20.     procedure Button1Click(Sender: TObject);
21.     procedure Timer1Timer(Sender: TObject);
22.  
23.   private
24.     { private declarations }
25.   public
26.     { public declarations }
27.   end;
28.  
29. var
30.   Form1: TForm1;
31.   escape:boolean;
32.  
33. procedure FileCopy(SourceName,DestName:string);
34.  
35.  
36. implementation
37.  
38. {$R *.lfm}
39.  
40. procedure FileCopy(SourceName,DestName:string);
41. var
42.   SourceF,DestF:file;
43.   Buf:array [0..1023] of byte;
44.   NumRead:integer;
45. begin
46.   AssignFile(SourceF,SourceName);
47.   AssignFile(DestF,DestName);
48.   FileMode:=0;
49.   Reset(SourceF,1);
50.   Rewrite(DestF,1);
51.   escape := false;
52.   form1.Timer1.interval := 10000;
53.   form1.timer1.enabled := true;
54.   while (not Eof(SourceF)) and (escape = false) do
55.   begin
56.     Blockread(SourceF,Buf,SizeOf(Buf),NumRead);
57.     Blockwrite(DestF,Buf,NumRead);
58.     Application.ProcessMessages;
59.   end;
60.   CloseFile(SourceF);
61.   CloseFile(DestF);
62.   sound(350);
63.   form1.timer1.enabled := false;
64. end;
65.  
66. procedure TForm1.Button1Click(Sender: TObject);
67. begin
68.  FileCopy('c:\temp17\movie6.mpg','c:\temp15\bin3\new1.mpg');
69. end;
70.  
71.  
72.  
73. procedure TForm1.Timer1Timer(Sender: TObject);
74. begin
75.  escape := true;
76. end;
77.  
78. { TForm1 }
79.  
80.  
81.  
82.  
83. end.
84.  

[balazsszekely]

I always have a hard time adapting Windows API stuff. I can't get the compiler to recognize CopyFileEx even though I have Windows in the uses clause. If it's a bother, don't sweat it.

If you don't have lazarus trunk, you must add JwaWindows to the uses clauses. Just google CopyFileEx, there are plenty of code out there.

PS: @Mike.Cornflake code also works fine!

[Mike.Cornflake]

[

Code: Pascal  [Select][+][-]

1. procedure FileCopy(SourceName,DestName:string);
2. ...
3.     Application.ProcessMessages;
4. ...
5. end;
6.  
7. procedure TForm1.Button1Click(Sender: TObject);
8. begin
9.  FileCopy('c:\temp17\movie6.mpg','c:\temp15\bin3\new1.mpg');
10. end;

As explained earlier, please be careful with this code - excess Application.ProcessMessages can cause problems.  As this is currently written for instance, there is nothing to stop the user from repeatedly hitting Button1, even when there is an Existing FileCopy going on.  I recommend either changing the Application.ProcessMessage to <controlyouwanttoupdate>.Refresh OR add defensive coding all over.  Have a look at my example - I immediately disabled the button to prevent re-entry...

[Thaddy]

Thaddy, if it's not too much trouble, could you post a simple example of how to use CopyFileEx with the callback procedure?

Code: Pascal  [Select][+][-]

1. program testcopyfileex;
2. {$APPTYPE CONSOLE}
3. uses
4.   Windows,
5.   SysUtils;
6.  
7. function CopyProgressRoutine( TotalFileSize:int64;
8.                               TotalBytesTransferred:int64;
9.                               StreamSize:int64;
10.                               StreamBytesTransferred:Int64;
11.                               dwStreamNumber:Dword;
12.                               dwCallbackReason:Dword;
13.                               hSourceFile:THandle;
14.                               hDestinationFile:THandle;
15.                               lpData:Pointer):dword;stdcall;
16. begin
17.   writeln(TotalbytesTransferred * 100 div TotalFileSize,'% ',StreamBytesTransferred,' bytes');
18.   result := 0;
19. end;
20.  
21. var
22.   Old,New:AnsiString;
23.   Cancel:Boolean;
24. begin
25.   Old := 'C:\Users\Thaddy\OneDrive\Openbaar\fpctrunk-r33121.zip';  // actual file is not there any more, replace it with some file you have
26.   New := 'd:\fpctrunk-r33121.zip'; // And change this line too.
27.   Cancel := false;
28.   if CopyFileEx(@Old[1],@New[1],@CopyProgressRoutine,nil,@Cancel,0) then
29.     writeln('Succes')
30.   else
31.     writeln(SysErrorMessage(GetLastError));
32.   readln;
33. end.
34.  

Afaik this only works in recent trunk. I don't know if Marco also back-ported it into 3.0.1.
[edit]
more specific:
try a short sleep on a large file copy and set cancel to true: it will do a roll-back....
Note this is windows only.

[user5]

Thank you Thaddy and I'll give your code a try. Thank you Mike.Cornflake also; my overuse of application.processmessages is an old, long story and it's a habit but I don't usually put them where they will cause problems.

Thank you also Jurassic Pork and GetMem. I feel like I hit the jackpot on this thread. You guys have really been a great help and it's a crucial time for me. I'm back on track after this "unresponsive CopyFile" snag.