[RESOLVED] Application is freezing while copying (DoEvents doesn't work) !!!
Hi everyone,
My below statement copies file from source to destination perfectly ...but when I try to test it with a file of 425 MB,
the App freezes, even if I add "DoEvents".
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Do events is useless there as it ill not do anything until the copy is complete.
Your copy method must be taking a long time. You could use a loop and copy files one by one, there a doevents would help as it could fire between files and you could add a progress bar to show the progress of the copy.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Well you don't NEED to go to the levels Trick mentioned (as fun as they may be), you can just use an API like CopyFileEx, which has a callback that reports progress, and a DoEvents statement can check for a cancel and then you can return PROGRESS_CANCEL.
The downside of CopyFileEx is that it doesn't support directories.
Code:
Public Declare Function CopyFileEx Lib "kernel32" Alias "CopyFileExA" (ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal lpProgressRoutine As Long, _
lpData As Any, _
pbCancel As Long, _
ByVal dwCopyFlags As Long) As Long
Public Declare Function MoveFileWithProgressW Lib "kernel32.dll" Alias "MoveFileWithProgressW" (ByVal lpExistingFileName As Long, _
ByVal lpNewFileName As Long, _
ByVal lpProgressRoutine As Long, _
lpData As Any, _
ByVal dwFlags As Long) As Long
Public Const PROGRESS_CONTINUE As Long = 0
Public Const PROGRESS_CANCEL As Long = 1
Public Const PROGRESS_STOP As Long = 2
Public Const PROGRESS_QUIET As Long = 3
'CopyFileEx callback routine state change values
Public Const CALLBACK_CHUNK_FINISHED As Long = &H0
Public Const CALLBACK_STREAM_SWITCH As Long = &H1
'CopyFileEx option flags
Public Const COPY_FILE_FAIL_IF_EXISTS As Long = &H1
Public Const COPY_FILE_RESTARTABLE As Long = &H2
Public Const COPY_FILE_OPEN_SOURCE_FOR_WRITE As Long = &H4
Public Const MOVEFILE_COPY_ALLOWED As Long = 2
Public Const MOVEFILE_REPLACE_EXISTING As Long = 1
Public Const MOVEFILE_WRITE_THROUGH As Long = 8
Public Const MOVEFILE_DELAY_UNTIL_REBOOT As Long = 4
Public bCancelCopy As Long
Public bAbortOp As Boolean 'Set to true to cancel.
Public Function FileCopyProgress(sSourceFile As String, _
sTargetFile As String) As Long
Dim lpCallback As Long
Dim lRtn As Long
Dim dwFlags As Long
bAbortOp = False 'reset cancel status
'if callback/progressbar specified, pass the
'addressof the callback procedure to the
'CopyFileEx lpCallback member. Because AddressOf
'can not be assigned directly, use a roundabout
'means by passing the address to a function
'that returns the same.
lpCallback = FARPROC(AddressOf CopyProgressCallback)
lRtn = CopyFileEx(sSourceFile, _
sTargetFile, _
lpCallback, _
0&, _
bCancelCopy, _
COPY_FILE_RESTARTABLE)
If lRtn = 0 Then
'function failed, return error code
FileCopyProgress = Err.LastDllError
Else
FileCopyProgress = 1
End If
End Function
Public Function CopyProgressCallback(ByVal TotalFileSize As Currency, _
ByVal TotalBytesTransferred As Currency, _
ByVal StreamSize As Currency, _
ByVal StreamBytesTransferred As Currency, _
ByVal dwStreamNumber As Long, _
ByVal dwCallbackReason As Long, _
ByVal hSourceFile As Long, _
ByVal hDestinationFile As Long, _
lpData As Long) As Long
Static dtC As Currency
Dim dTC2 As Currency
Dim dTCs As Currency
Dim dTCd As Currency
Dim dTotal As Currency 'time remaining
'I've left some things in as examples of how you can report progress back
'If it's commented out it's part of that and not mandatory
Select Case dwCallbackReason
Case CALLBACK_STREAM_SWITCH:
'this value is passed whenever the
'callback is initialized for each file.
'Form1.ProgressBar2.Value = 0
'Form1.ProgressBar2.Min = 0
'Form1.ProgressBar2.Max = (TotalFileSize * 10000)
If bAbortOp Then
CopyProgressCallback = PROGRESS_CANCEL
Else
CopyProgressCallback = PROGRESS_CONTINUE
End If
'dtC = GetTickCount64 * 10000
Case CALLBACK_CHUNK_FINISHED
'called when a block has been copied
' Form1.ProgressBar2.Value = (TotalBytesTransferred * 10000)
'dTC2 = GetTickCount64 * 10000
'dTCd = dTC2 - dtC
'dTCd = dTCd / 1000
'If dTCd <> 0 Then
' dTCs = (TotalBytesTransferred * 10000) / dTCd
' dTotal = ((TotalFileSize * 10000) - (TotalBytesTransferred * 10000)) / dTCs 'total bytes / bytes/s = remaining seconds
'Form1.StatusBar1.Panels(1).Text = "Transferring file... Elapsed: " & Round(dTCd, 0) & ", Rate=" & FormatFileSizeCurStd(dTCs, True) & ", " & FormatHMS(dTotal) & " remaining."
End If
'optional. While the app is copying it
'will not respond to input for canceling.
DoEvents
If bAbortOp Then
CopyProgressCallback = PROGRESS_CANCEL
Else
CopyProgressCallback = PROGRESS_CONTINUE
End If
End Select
End Function
Public Function FARPROC(pfn As Long) As Long
FARPROC = pfn
End Function
I included the declare for MoveFileWithProgress... if you're copying to another volume (e.g. C:\ to D:\), then MOVEFILE_COPY_ALLOWED will turn it into a copy operation, and directories are supported.
But to support copying folders on the same volume, you're left with only two options:
-Recreate the directory structure and copy the files individually with CopyFileEx, or
-Let Windows the copy with the shell, with SHFileOperation, or if you're not supporting XP, IFileOperation (on Vista+ this is the one with the full details; SHFileOperation will have fewer details). It can be done silently without confirmation/progress display, or with normal prompts and progress. Obviously my position is forget XP, and use IFileOperation.
However there is no way to do it with FSO.
Last edited by fafalone; Apr 30th, 2016 at 05:13 PM.
Reason: Use MoveFileWithProgress for directory copy support
Re: Application is freezing while copying (DoEvents doesn't work) !!!
I have two questions.
1) OP is using .CopyFolder so I am asking if fafalone's code which uses CopyFileEx can also copy folder
2) Why does OP's code not exit even after the entire folder was copied to another folder?
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Originally Posted by jmsrickland
I have two questions.
1) OP is using .CopyFolder so I am asking if fafalone's code which uses CopyFileEx can also copy folder
2) Why does OP's code not exit even after the entire folder was copied to another folder?
It probably does but if the folder selected has a bunch of large files it could take along time to complete, during which time the program will be unresponsive. I know I have some folders on my PC that could take an hour or more to copy.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
I'm sure OP just meant the app "freezes" until the copy is done, which is expected since FSO isn't asychronous and doesn't have a callback.
With CopyFileEx yeah it has to be files.. I'll update it later on with MoveFileWithProgress, which allows directories and is virtually identical with the MOVEFILE_COPY_ALLOWED flag.
Edit: I added the declare, flags, and notes... but note that it only allows copying if you're moving across volumes. If you don't want to copy files individually and re-create the directory structure, you pretty much have to go through the shell. IFileOperation is the modern way to do it, and is the only way to get the extended details you see when doing it in Explorer, but if XP support is a requirement, SHFileOperation can be used. The progress window lets the user cancel without any code in your app needed (although I did just update the IFileOperation demo I made to show how to cancel through code, if you wanted to hide the Windows progress dialog and still allow cancelling from your app)
Last edited by fafalone; Apr 30th, 2016 at 06:32 PM.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
you could use a shell namespace to copy folders asynchronously
Code:
set sh = createobject("shell.application")
set dest = shell.namespace(destination)
dest.copyhere source
but of course if you are using multiple namespace objects to copy many folders at once, as new copy operation, could start before the previous copy operation has finished, the whole machine may become slow
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Hi guys, thanks for your responses.
@ The Trick :
I checked the class you suggested, seems like it interfaces with Assembly language (ASM)!!!
Can you please write a Tuto how to interface ASM with VB 6.
I'd like to interface my old ASM programs built in NASM and MASM with VB6.
I also browsed vbforums and realized that you're doing many tricks with Low-Level Prog.
(Thanks 4 ur Low-Level MP3 Player.!!! I like it... but I didn't see where to load my mp3 file ???) Can you please help !
-) Looking forward to hearing you about that Tuto !!!
I looked at your class, but it doesn't copy folders and its structure.
it DOES only copy files, I need something to copy directories as well and its structures.
@fafalone :
I also wanted to use it first time, but when I checked in API list, I realized that it doesn't support directories.
That's why I dropped and chose 'FSO' instead.
According to your say, it DOES support directories ! adding 'MOVEFILE_COPY_ALLOWED'
But to support copying folders on the same volume, you're left with only two options:
-Recreate the directory structure and copy the files individually with CopyFileEx, or
-Let Windows the copy with the shell, with SHFileOperation, or if you're not supporting XP,
IFileOperation (on Vista+ this is the one with the full details; SHFileOperation will have fewer details).
It can be done silently without confirmation/progress display, or with normal prompts and progress. Obviously my position is forget XP, and use IFileOperation.
I don't know !!! I'm getting confused... which one should I use now ???
In brief, my App should be able to copy the entire folder (including sub-folders and their files)
from one source to one destination / or two differents destinations on the same and different Volume.
---
Suggestions : What if we use "MoveFileEx" or "MoveFile" function. both are APIs.
Their description state that : - The MoveFileEx function renames an existing file or directory.
- and The MoveFile function renames an existing file or a directory (including all its children).
We can go the Linux way : I mean in Linux there's no really an appropiate command to rename a file (in MSDOS we use 'rename')
we use an idiot trick to do so using 'mv' command that is a commnd to move files.
'mv myfile.txt myfilechanged.txt'
So, in our case, we also can use 'MoveFileEx' or 'MoveFile' their full description say that they also can move files.
That's just a suggestion !!!
---
@jmsrickland :
What does 'OP' mean ???
and who's OP ???
2) Why does OP's code not exit even after the entire folder was copied to another folder?
There's no a Loop iteration there to stack in.
My code DOES exit !!!
I just posted the statement (line) that does the copy operation instead of posting the whole function.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Originally Posted by freesix
@jmsrickland :
What does 'OP' mean ???
and who's OP ???
You are OP. OP = Original Poster
Originally Posted by freesix
My code DOES exit !!!
I just posted the statement (line) that does the copy operation instead of posting the whole function.
Yes, I realize that now. What was happening to me was the application was still running even though when I looked at the file in the copy-to folder the file was shown to have to total number of bytes of the file size so I assumed that the file was completely copied and the application was still running without exiting the sub
Anything I post is an example only and is not intended to be the only solution, the total solution nor the final solution to your request nor do I claim that it is. If you find it useful then it is entirely up to you to make whatever changes necessary you feel are adequate for your purposes.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Originally Posted by freesix
I checked the class you suggested, seems like it interfaces with Assembly language (ASM)!!!
Yes. This class copies a file in the separate thread.
Originally Posted by freesix
Can you please write a Tuto how to interface ASM with VB 6.
There are few approach:
You can use an assembly code immediately. You should translate an asm code to binary data and write it to execute allowed memory. Usually i make an code through NASM with the -bin and -l parameters.
You can link an assembly code to EXE (it works only in compiled form).
You can use my add-in.
Further you should call this code. You can use any method either DispCallFunc or ImmediateCall. If you use my add-in you will just call function as is.
Originally Posted by freesix
I'd like to interface my old ASM programs built in NASM and MASM with VB6.
It will better if you use my add-in because it is quite stable and quckly.
Originally Posted by freesix
I also browsed vbforums and realized that you're doing many tricks with Low-Level Prog.
(Thanks 4 ur Low-Level MP3 Player.!!! I like it... but I didn't see where to load my mp3 file ???) Can you please help !
You should load a file to array entirely and pass pointer to the first array element as first parameter in Initialize function. Second parameter take the size of array in bytes and third determines whether class should make a copy of the array respectively.
Originally Posted by freesix
I looked at your class, but it doesn't copy folders and its structure.
it DOES only copy files, I need something to copy directories as well and its structures.
I can suggest you to use multithreading. In this case you can use your old code.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
This example shows how can you use multithreading in your objective.
Create a form with two textboxes and single button then add some code:
Code:
Option Explicit
Private Declare Function vbCreateThread Lib "TrickMultithreading" ( _
ByVal lpThreadAttributes As Long, _
ByVal dwStackSize As Long, _
ByVal lpStartAddress As Long, _
ByVal lpParameter As Long, _
ByVal dwCreationFlags As Long, _
ByRef lpThreadId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" ( _
ByVal hThread As Long, _
ByRef lpExitCode As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function SysAllocString Lib "oleaut32.dll" ( _
Optional ByVal pszStrPtr As Long) As Long
Private Declare Function SysFreeString Lib "oleaut32.dll" ( _
ByVal bstr As Long) As Long
Private Const STILL_ACTIVE = &H103&
Dim td As ThreadData
Dim hThread As Long
Private Sub cmdCopy_Click()
td.pszSourceFolder = txtSrcFolder.Text
td.pszDestinationFolder = txtDstFolder.Text
hThread = vbCreateThread(0, 0, AddressOf ThreadProc, VarPtr(td), 0, 0)
cmdCopy.Enabled = False
tmrUpdate.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
If tmrUpdate.Enabled Then
WaitForSingleObject hThread, -1
End If
End Sub
Private Sub tmrUpdate_Timer()
Dim ret As Long
GetExitCodeThread hThread, ret
If ret <> STILL_ACTIVE Then
cmdCopy.Enabled = True
tmrUpdate.Enabled = False
CloseHandle hThread
End If
End Sub
Now on add a module with the following code:
Code:
Option Explicit
Public Type ThreadData
pszSourceFolder As String
pszDestinationFolder As String
End Type
Public Sub ThreadProc( _
ByRef td As ThreadData)
Dim fso As FileSystemObject
Set fso = New FileSystemObject
fso.CopyFolder td.pszSourceFolder, td.pszDestinationFolder
Set fso = Nothing
End Sub
You should use either DLL or Module with TLB from there.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Originally Posted by freesix
But I still have my window freezing (Not Responding) Why????
You should compile and run because threading does not work in IDE. I guess you try to close the window during copying. You should wait until copying.
Originally Posted by freesix
What about if I want to use the module instead of the DLL; What should I do??
You should add module modMultiThreading.bas to project and add the EXEInitialize.tlb to references. In addition you should comment API declaration of vbCreateThred in order to use module function instead dll.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
So you mean If I compile it into EXE, I will not have my app freezing (Not Responding)??? Is that what you're trying to say??
Yes.
What should I put as comment ???
What kind of comment should I need to write in order to use it?
I mean like this:
Code:
'Private Declare Function vbCreateThread Lib "TrickMultithreading" ( _
' ByVal lpThreadAttributes As Long, _
' ByVal dwStackSize As Long, _
' ByVal lpStartAddress As Long, _
' ByVal lpParameter As Long, _
' ByVal dwCreationFlags As Long, _
' ByRef lpThreadId As Long) As Long
Re: Application is freezing while copying (DoEvents doesn't work) !!!
'a multi-threaded file copy routine' may sound quite exotic but it could be as simple as;
Code:
Private Sub Command1_Click()
a$ = Dir$("*.*")
q$ = """"
Do While Len(a$)
'Shell works asynchronously; a separate process is started to copy each file
Shell Environ$("COMSPEC") & " /C Copy " & q$ & CurDir & "\" & a$ & q$ & " " & q$ & CurDir & "\Dest\*.*" & q$, vbHide
a$ = Dir$
Loop
End Sub
Dir$ has been used above to supply a list of files to copy but an array holding the file names/ paths would be more useful if copying folders too.
The above could be built upon to detect when each copy process completes (using e.g. WaitforSingleObject) and build a progress bar, halting the loop would also be possible albeit not mid-file copy.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
To avoid the app freezing with IFileOperation you need to use the progress sink (the .Advise with cFileOperationProgressSink) and add DoEvents in the IFileOperationProgressSink_UpdateProgress sub; and the pre- and post- methods wouldn't hurt either. UpdateProgress fires frequently enough that you barely notice any lag while typing in a text box or clicking buttons. To be truly asynchronous of course you need to do the operation (via any method) from another thread, but most people find a DoEvents in the progress updates to be sufficient (you'd get nearly identical results using MoveFile/CopyFile and sticking a DoEvents in CopyProgressCallback).
Last edited by fafalone; May 5th, 2016 at 10:09 PM.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Here's my 0.02$ for vbRichClient5-users, on how start an asynchronous multifile-operation
on a separate thread (needs the latest RC5-version 5.0.45, which now allows to instantiate
any RC5-Dll-internal Class on a separate thread as well...):
Code:
Option Explicit
Private WithEvents ThFSO As cThreadHandler
Private Sub Form_Load()
Set ThFSO = New_c.RegFree.ThreadObjectCreate("CopyThread" & App.ThreadID, "New_c", "FSO")
End Sub
Private Sub Form_Click()
If ThFSO.JobQueueCount > 0 Then MsgBox "a copy-operation is still in progress": Exit Sub
Caption = "Copy-operation in progress..."
ThFSO.CallAsync "MultiFileCopy", "C:\Code\", "E:\Backup\", False, False, False, False
' New_c.FSO.MultiFileCopy "C:\Code\", "E:\Backup\", False, False, False, False '<- that'd be the EarlyBound (but non-threaded) variant of the above call
End Sub
Private Sub ThFSO_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
Caption = MethodName & "=" & Result 'when the method was cancelled in the Progress-Dialog, it will return false here
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If ThFSO.JobQueueCount > 0 Then MsgBox "a copy-operation is still in progress": Cancel = 1
End Sub
Re: Application is freezing while copying (DoEvents doesn't work) !!!
@Schmidt
What is that vbRichClient5-users??
What does it do exactly???
Reading your small comment, seems like using vbRichClient5-users we are no longer forced to write thousand of codes to implement Multi-Thread !!! (I don't know, correct me if I'm wrong).
Can you please be more explicit???
and Is that project stable to use in production???
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Originally Posted by freesix
What is that vbRichClient5-users??
What does it do exactly???
vbRichClient5.dll is a free COM-Dll, which you can check-in over the references-dialogue
into your VB6-projects (the project-site is on vbRichClient.com).
After that, you have a lot of new Classes available, which all can be derived (instantiated)
over the 'New_c' constructor, (you see it used also in the small Demo above).
It's a small framework, which aims to extend the VB6-Runtime with modern functionality
(fast Collection-Classes, XML/JSON/Text-parsers, Encryption/Compression/CoDec-Classes,
connectivity-Classes, Unicode-awareness throughout, etc.).
Its two biggest parts aim to decouple from larger MS-libs by using two OpenSource-libs
(Cairo and SQLite) - which means you can use powerful vector- and pixel-graphics-routines
(instead of GDI+ or DirectX) - and you can also avoid the MS-JET-engine for Desktop-DB-
scenarios (by using SQLite instead).
It's a bit on the larger side (your shipped Apps will increase about 2.4MB in their Zip-package) -
but on the other hand you can leave out quite a few other COM-dependencies, which aren't
necessary anymore.
Its main-advantage is, that it will save you a ton of code in your own Apps, because for nearly
anything a little bit more complex, there's an efficient and fast solution available by using RC5-classes.
Originally Posted by freesix
...we are no longer forced to write thousand of codes to implement Multi-Thread !!! (I don't know, correct me if I'm wrong).
Can you please be more explicit???
The Threading-support of the RC5 requires, that the Code which later on runs on a new thread,
is compiled into an ActiveX-Dll-(Class) - it's that Class, which is instantiated "on its own thread"
(its own 'STA')... You can then call Methods of this class "remotely" from your Main-Thread.
and Is that project stable to use in production???
The "STA-conform" threading-support of the RC5 is quite similar to the one available
in VB6 natively (over ActiveX-Exe-Classes) - it doesn't use any assembler-tricks
and thus plays "by the rules" (of the VB6-runtime).
Of course threading-scenarios (when they get more complex) always bear the chance,
that you mess something up (e.g. when it comes to interaction between threads per
shared memory, when you pass memory-pointers along - or when you "flood the communication-
channels" with an undue amount of "Thread-Events"). Threading works best, when it can run
"as isolated as possible, until the job is finished" (keeping cross-thread communication to a minimum)
and with some care, one can accomplish that of course.
If its any consolation - the threading-approach of the RC5 is used also by the RC5-RPC-Classes
(to implement a socket-based worker-threadpool on the RPCServer-side).
And the RPC-server is in use on hundreds (if not thousands) of Client-installations worldwide, which run
critical business-processes on it 24/7 - on host-machines which ranged from W2K/XP (in the early years)
to current Win-2012-Server installations, so it's quite well-tested "in the wild". http://www.vbforums.com/showthread.p...ement-per-RC5)
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Originally Posted by freesix
Is it possible If I want to add an "Abort" option to you "CopyFolderThread.zip " project?
What should I do exactly??
No. Of course you can terminate the thread, but it is very "dirty" method because all memory allocated by thread is not released. You should use either manual method of creation all the folders and files or use one of suggested method. Of course you can perform all the methods using threading in order to prevent thread freezing.
Originally Posted by freesix
Besides, Is it possible for "Pause" and "Continue" too?
Yes, you can suspend thread and resume it.
Originally Posted by freesix
What should I do exactly??
I would choose one of the suggested method and place it to a different thread. I don't read this thread entirely, i think you can solve your issue using suggested method without multithreading just use DoEvents.
Create a procedure that will be called recursively. Scan all the files and the folders in the this folder and copy each item to needed folder. If you meet a folder you should call this procedure again passing this folder as argument. In order to copy big files without freezing you can use CopyFileEx.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
In case you want to try it without threading (and with full control) - you can of course also
start your Folder-Copying "chunkwise" (at the FileLevel).
This way you can choose a chunksize, which doesn't block the Main-Thread for too long
(e.g. 1MB-4MB - depending on the Disk-Performance) - and after each chunk call a DoEvents.
Here's again a Code-Snippet, how that could look like using the RichClient-lib I've mentioned above:
Code:
Option Explicit
Private Sub Form_Click()
CopyFolderTo "E:\Backup", "C:\Code"
End Sub
Function CopyFolderTo(ByVal DstFolder As String, ByVal SrcFolder As String, Optional Filter As String)
New_c.FSO.EnsurePathEndSep DstFolder
With New_c.FSO.GetDirList(SrcFolder, dlSortNone, Filter, True)
If Not New_c.FSO.FolderExists(DstFolder) Then New_c.FSO.CreateDirectory DstFolder
Dim i As Long
For i = 0 To .FilesCount - 1 'copy the files from the current directory chunkwise
CopyFileChunkWiseTo DstFolder & .FileName(i), .Path & .FileName(i)
Next
For i = 0 To .SubDirsCount - 1 'recursions into Sub-Directories
CopyFolderTo DstFolder & .SubDirName(i), .Path & .SubDirName(i), Filter
Next
End With
End Function
Function CopyFileChunkWiseTo(DstFile As String, SrcFile As String)
Dim Src As cStream, Dst As cStream, i As Long
Set Src = New_c.FSO.OpenFileStream(SrcFile, STRM_READ Or STRM_SHARE_DENY_NONE)
Set Dst = New_c.FSO.CreateFileStream(DstFile, STRM_WRITE Or STRM_SHARE_DENY_NONE)
Const BufSize As Long = 4194304: Static Buf(0 To BufSize - 1) As Byte
Do Until Src.GetPosition = Src.GetSize
Dst.WriteFromPtr VarPtr(Buf(0)), Src.ReadToPtr(VarPtr(Buf(0)), BufSize)
DoEvents 'update a progress-indicator here..., or cancel the Operation using an outside Flag
Loop
End Function
The above code is unicode-aware - and also supports File-Lengths larger than 2 or 4GB.
Feel free, to replace the Dir-Listing with e.g. the Scripting- or the Shell-FilesystemObjects -
and the Stream-Classes with e.g. ADO-Streams.
Edit: Since we're talking about backup-stuff - here's an extended version, which does apply the original File-Attributes to the Destination
(on Files, and Folders as well).
Code:
Option Explicit
Private Sub Form_Click()
CopyFolderTo "E:\Backup", "C:\Code", True
End Sub
Function CopyFolderTo(ByVal DstFolder As String, ByVal SrcFolder As String, Optional ByVal ApplyFileAttributesToDst As Boolean, Optional Filter As String)
New_c.FSO.EnsurePathEndSep DstFolder
With New_c.FSO.GetDirList(SrcFolder, dlSortNone, Filter, True)
If Not New_c.FSO.FolderExists(DstFolder) Then New_c.FSO.CreateDirectory DstFolder
Dim i As Long
For i = 0 To .FilesCount - 1 'copy the files from the current directory chunkwise
CopyFileChunkWiseTo DstFolder & .FileName(i), .Path & .FileName(i)
If ApplyFileAttributesToDst Then New_c.FSO.SetFileAttributesEx DstFolder & .FileName(i), .FileAttributes(i), _
.FileLastAccessTime(i), .FileLastWriteTime(i), .FileCreationTime(i)
Next
For i = 0 To .SubDirsCount - 1 'recursions into Sub-Directories
CopyFolderTo DstFolder & .SubDirName(i), .Path & .SubDirName(i), ApplyFileAttributesToDst, Filter
If ApplyFileAttributesToDst Then New_c.FSO.SetFileAttributesEx DstFolder & .SubDirName(i), .SubDirAttributes(i), _
.SubDirLastAccessTime(i), .SubDirLastWriteTime(i), .SubDirCreationTime(i)
Next
End With
End Function
Function CopyFileChunkWiseTo(DstFile As String, SrcFile As String)
Dim Src As cStream, Dst As cStream
Set Src = New_c.FSO.OpenFileStream(SrcFile, STRM_READ Or STRM_SHARE_DENY_NONE)
Set Dst = New_c.FSO.CreateFileStream(DstFile, STRM_WRITE Or STRM_SHARE_DENY_NONE)
Const BufSize As Long = 4194304: Static Buf(0 To BufSize - 1) As Byte
Do Until Src.GetPosition = Src.GetSize
Dst.WriteFromPtr VarPtr(Buf(0)), Src.ReadToPtr(VarPtr(Buf(0)), BufSize)
DoEvents 'update a progress-indicator here... or cancel the Operation using an outside Flag
Loop
End Function
Olaf
Last edited by Schmidt; May 16th, 2016 at 04:49 PM.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Why isn't it good enough to just use a variation of the common "Shell and wait" technique?
Code:
Option Explicit
'Change these to your source and destination folders:
Private Const SOURCE As String = "H:\Log Files"
Private Const DEST As String = "G:"
Private Sub AsyncShell1_Complete(ByVal DllError As Long, ByVal ExitCode As Long)
mnuTerminate.Enabled = False
If DllError <> 0 Then
Print "Failed with error "; DllError
ElseIf ExitCode <> 666 Then
'Robocopy returns 1 when files have been copied successfully:
Print "Completed with exit code "; ExitCode
Else
Print "Terminated"
End If
End Sub
Private Sub Form_Load()
Dim Result As Long
AutoRedraw = True 'For Print statements.
Result = AsyncShell1.Shell("robocopy """ & SOURCE & """ """ & DEST & """ /E", vbHide)
If Result <> 0 Then
Print "Shell failed, error "; Result
Else
mnuTerminate.Enabled = True
Print "Copying..."
End If
End Sub
Private Sub mnuTerminate_Click()
Dim Result As Long
mnuTerminate.Enabled = False
Result = AsyncShell1.Terminate()
If Result <> 0 Then
Print "Terminate failed, error "; Result
Else
Print "Terminating..."
End If
End Sub
This uses robocopy, which is preinstalled as part of Windows from Vista onward.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Best I can tell OP is really trying to get a level of UI responsiveness and copy cancellation that even CopyFileEx with a progress callback in a separate thread won't achieve. Might have to drop down lower and do the operation yourself block by block with CreateFile et al.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Well if it is necessary to stop and abandon copying within a file then sure, low level block-by-block copying is probably the answer. Of course that can be another mess to clean up too.
All he asked for was a way to avoid locking up his UI thread. Now he also wants pause/continue for some odd reason.
Oh well, by now he has plenty of alternatives and the rest is up to him. That or he should probably hire a programmer he is willing to pay to wheedle the requirements out of him and do the work.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Hi guys, thanks for your comments.
I'm ready to use any kind of copy methods or API... but I have to make sure that the copy operation must keep working while the user is playing around with other Windows (Forms).
I was about to use fafalone project located here, 'cause it's working at 95 % like I wanted.
but the only thing I'm facing is when I add a menu "File" and a sub-menu "Exit", and I launch the copy operation, while the copy is in progress and you just click on "File" to display the sub-menu "Exit", the copy stops until you click on the Main Form then it continues...
even when you add another Form and try to show the second Form from the Main Form using "Form2.show (1)" method while copying, it stops the copy operation.
but apart from that everything working perfect in his project at 95 % as I wanted.
====
I tested The Trick project (CopyFolderThread.zip) he posted above and seems to fit, but only few things that I have to sort out. I need it to have a stop/abort option.
and may be a pause/continue (Not Mandatory) !!!
I can play around other Forms in Modal and the copy still in progress. (That's Fantastic !!!)
I also can display a Msgbox but I don't get my copy stoping. (That's what I want !!!)
Of course you can terminate the thread, but it is very "dirty" method because all memory allocated by thread is not released. You should use either manual method of creation all the folders and files or use one of suggested method.
if you may give me that dirty method to abort/stop that copy operation, please !!!
Assuming you're copying a large file of over 5 Giga, obviously you'll need an abort method.
===
@ Schmidt
Please can you put those codes into a VB project !!!
I'd like to test it too.
Last edited by freesix; May 17th, 2016 at 07:44 AM.
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Originally Posted by freesix
@ Schmidt
Please can you put those codes into a VB project !!!
I'd like to test it too.
The code I've posted (in #28 and #33/second codebox), is already the complete Form-Code
(in both cases, it gets triggered by a Form_Click-Event - just make sure that you adjust the FileCopy-Path's)...
The only thing you need to ensure (after you started up a new, empty VB6-StdExe-Project),
is to include a Project-Reference to 'vbRichClient5' - over the appropriate References-Dialogue).
Before said Project-Reference (to vbRichClient5.dll) becomes available in the References-Dialogue,
you will have to install this little toolkit first into a "fixed Folder-Location" on your Dev-Machine:
- the download is available on vbRichClient.com -> under the Downloads-section -> vbRC5BaseDlls.zip
- unpack the Zips content into a Folder of your choice
- there's a little helper-script included -> RegisterRC5inPlace.vbs ... which ensures the proper Registry-entries
A for deployment (in case you want to ship the 3-Base-Dlls with your Apps) -
the recommended method is, to do it in a regfree manner (in a SubFolder of your Executable).
Here is a Thread which covers this topic: http://www.vbforums.com/showthread.p...rectCOM-Helper
Re: Application is freezing while copying (DoEvents doesn't work) !!!
Hi Schmidt, thanks a lot !!!
It works PERFECT like I wanted it.
Playing around Forms or Displaying a MsgBox while copying doesn't interfere/stop the copy operation.
It's just few codes compared with the regular multi-threading method that requires a lot of codes. I like it !!!
But I still have few questions :
1. Why your multi-threading runs in IDE whereas the regular one or the one for user "The Trick" requires that you only compile in EXE???
2. What are these Four (False, False, False, False) means??
I know that the First one if turned to "True" hide the Windows Progress Bar. and what about the others!
3. How do I cancel that copy operation from Vb 6???
4. I didn't see a real Documentations explaining all of these things!!
In their web-site I only found a lot of vb 6 source code !!! Where's the doc !!
I checked that vbRichClient5 project and I discovered a lot of other interested things like changing the command button style. but I'll get into that later.
Thanks !!!
Last edited by freesix; May 18th, 2016 at 05:31 AM.