FileCopy (Resolved - great solution provided) problems

[A441OTA]

Good afternoon,

I was using a FileCopy function with great success, except that the screen made it appear that the program crashed... I tried adding a form that would appear and let the user know to wait, however that form also just stacked itself ontop and was actually transparent except the title bar. I have tried hourglasses also - they never appeared.

I am using commondialogues to obtain the file information.

I was researching solutions earlier on the forums and tried using the Windows Copy File animation but am obviously missing something. I edited from an example and obviously edited out something important!!

If anyone wants to take a crack at reading this to see if you have any suggestions please feel free!!! Or if you have any other suggestions on what to do about the "crashed" appearance on the screen that would be good too!!

I am copying a file that is identified through an Open dialogue, and the destination is obtained through a SaveAs dialogue.

I also think that I need the .avi on the form but when I tried that it crashed VB (not just my program!).

I am very new so I may also be missing references or something silly like that! I did reference the lib from the code (shell32.dll)

Thanks,
Mary

*********** My attempt at the code VB 6 **************

Option Explicit

Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
SourceFile As String
DestinationFile As String
End Type

Private Enum FO_OPS
FO_MOVE = &H1
FO_COPY = &H2
FO_DELETE = &H3
FO_RENAME = &H4
End Enum

Private Enum FO_FLAGS
FOF_CREATEPROGRESSDLG = &H0
FOF_NOCONFIRMMKDIR = &H200
End Enum

Private Declare Function SHFileOperation Lib "Shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As Any) As Long

Private Sub cmdCancel_Click()
'unload form and return to main screen
Unload Me
FrmMain.Show
End Sub

Private Sub cmdExit_Click()
'Close and exit program
End
End Sub

Private Sub cmdFindShellDB_Click()
'Locate SRT Shell Database
On Error GoTo ErrHandler

diaFindShell.ShowOpen
txtShellDBName.Text = diaFindShell.FileTitle
ErrHandler:
'MsgBox "Unexplained error, please try again"
Exit Sub

End Sub

Private Sub cmdSaveSurveyDB_Click()

'Save Shell as new survey database
'On Error GoTo ErrHandler

diaSaveSurveyDB.FileName = txtDatasetName.Text & ".mdb"
diaSaveSurveyDB.ShowSave
txtSurveyDBName.Text = diaSaveSurveyDB.FileTitle
'SurveyDB = diaSaveSurveyDB.FileName
'copy shell file to create survey specific database and show
'Windows copy progress dialogue

Dim fileop As SHFILEOPSTRUCT
Dim lRet As Long
Dim SourceFile, DestinationFile
DestinationFile = diaSaveSurveyDB.FileName 'I have also tried
'with 2 vbNull added
SourceFile = diaFindShell.FileName 'I have also tried with
'2 vbNull added
With fileop
.hwnd = Me.hwnd
.SourceFile = SourceFile
.DestinationFile = DestinationFile
.wFunc = FO_COPY
.fFlags = FOF_CREATEPROGRESSDLG
'FileCopy SourceFile, DestinationFile
End With

lRet = SHFileOperation(fileop)

cmdNext.Enabled = True


'ErrHandler:
'MsgBox "Unexplained error, please try again"
' Exit Sub

End Sub


Private Sub txtDatasetName_LostFocus()
'ensure that user only entered an 8-character name and format for uppercase -- this name will include letters and numbers
' maybe add naming convention rules to help files later
If Len(txtDatasetName.Text) <> 8 Then
MsgBox "The dataset name should be 8 characters long
and should match the name of your final SAS dataset. " _
& vbCrLf & "Please try again."
txtDatasetName.SetFocus
Exit Sub
End If

End Sub

[phinds]

you probably just needed doevents in your original code

[NOTSOSURE]

What are you trying to copy?????????????

[A441OTA]

Hi Phinds --

I don't understand DoEvents quite yet, don't they need to go into a loop?

Hi Notsosure --

I am copying an Access database "shell" from an unknown place on a user's machine to an unknown place on the user's machine. The "open" dialogue has the user identify where the database is on their machine, and the "SaveAs" dialogue puts it where it should go... if you know of a better way then please feel free to tell me -- I am in a state of mind-boggle right now with the requirements that are being thrown at me!! When I was presented this job I was initially under the impression it would be simply taking raw data and making it look "pretty" through Word and Excel macros (which I have done before without a problem) -- it has now turned into full blown software development and everything is dynamic (everything imagineable!!!). I won't even get into the "stinky" database (and I'm using that term very loosely!) that I have to work with!!.

Using "filecopy" worked great it just didn't look good!! Since there is only the one file a progress bar probably wouldn't work from what I understand? I thought about trying to figure out how to emulate Microsoft's progress bar that just bounces back and forth (Windows XP does this on load -- no steady progress denoted, just that it is working). I think in the meantime I'll just move the code to the command button instead of where the SaveAs dialogue comes up that might help a little (they don't won't much user-intervention so I was trying to aviod another "click").

Please help if you can think of something better... I know enough VB to get me into trouble (like taking this job!! LOL) but not enough to get me out of trouble!!!!!

Thanks,
Mary

[nemaroller]

You were probably on the right track with just playin an animation clip... it would be alot easier than..

To use the progress bar, you would have to keep track (via an API call, http://216.26.168.92/vbapi/ref/w/writefile.html perhaps) of how many bytes have been transferred (progressbar.value) versus how many bytes need to be transferred(progressbar.max). But you would have to use http://216.26.168.92/vbapi/ref/r/readfile.html to read the access database in bytes to memory. Then just readfile 1024 bytes, update the progress bar, then writefile 1024 bytes..

[nemaroller]

Lucky you, I'm still UNemployed...

Put the below code in a module, call it from anywhere using

Call CopyAFile(Progressbar1, "C:\mysourcefile","C:\mydestfile")

Pass the progressbar as the first parameter, source file as second, destination file as third.

Of course, using a wide yet short progressbar makes it look
like more progress is being done.

Be sure to remove the Debug.print 's from the module code below when you distribute the app..

'declarations section
Option Explicit
 
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const CREATE_NEW = 1
Private Const OPEN_EXISTING = 3
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
 
'create file handle
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
'flushes buffer to force writing to disk
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hSource As Long) As Long
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
 
'reads the file
Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hSource As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
 
'gets file size
Private Declare Function GetFileSize Lib "kernel32.dll" (ByVal hSource As Long, lpFileSizeHigh As Long) As Long
 
'writes the file
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hSource As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
 
Public Sub CopyAFile(progress As Object, sourceFile As String, destFile As String)
Dim hSource As Long   'file handle to source file
Dim hDest As Long  'file handle to destination file
Dim retVal As Long  'holder for returned values from the above api calls
Dim numBytesRead As Long 'bytes read on each ReadFile call
Dim numBytesWritten As Long  'bytes written on read WriteFile call
Dim numBytesWrittenTotal As Long 'bytes written total as of current
Dim loworder As Long    'filesize related
Dim highorder As Long   'filesize related
Dim donereading As Boolean  'indicates no more bytes to read, exit loop
Dim byte1() As Byte  ' the Long value to write to the file
Dim f As Long        ' size of byte1()
 
'initialize variables
ReDim byte1(10240)
f = UBound(byte1)
donereading = False
progress.Value = 0
'create a handle to source file
hSource = CreateFile(sourceFile, GENERIC_READ, FILE_SHARE_READ, ByVal CLng(0), OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, ByVal CLng(0))
If hSource = -1 Then  ' the file could not be opened
  Debug.Print "Unable to open the file - it may not exist, or improper flags"
  Exit Sub  ' abort the program
End If
 
'create a handle to destination file
hDest = CreateFile(destFile, GENERIC_WRITE, FILE_SHARE_READ, ByVal CLng(0), CREATE_NEW, FILE_ATTRIBUTE_ARCHIVE, ByVal CLng(0))
If hDest = -1 Then  ' the file could not be opened
  Debug.Print "Unable to open the file - it may already exist, or improper flags"
  End  ' abort the program
End If
 
'retrieve file size in bytes to store as MAX parameter for progressbar
highorder = 0
loworder = GetFileSize(hSource, highorder)  ' read the file's size
If highorder < 0 Then                     ' if file is > 2gb we may have problems
highorder = loworder + 2 ^ 32             ' coder might want to investigate further
End If                                    ' since GetFileSize is only correct <4gb
 
'the maximum size of file to be transfered reflected in max size of progressbar
progress.Max = loworder / 10240 '.Max only takes integer values to 32,7Xx..
                                    'an error may occur if low/1024 >32,000
 
'*********************************begin loop
Do While (donereading = False)
'read in  bytes from the source file
retVal = ReadFile(hSource, byte1(0), f, numBytesRead, ByVal CLng(0))
If numBytesRead < f Then  'we have read less than byte array bounds (near end of file)
   ReDim Preserve byte1(numBytesRead) 'change the byte array to reflect
   f = UBound(byte1)             'only the amount of bytes read
   donereading = True            'signify done reading to loop
End If
 
' Write out bytes to the destination file
 
retVal = WriteFile(hDest, byte1(0), f, numBytesWritten, ByVal CLng(0))
If retVal = 0 Then
   retVal = GetLastError
   Debug.Print "Error: " & retVal
   End If
 
numBytesWrittenTotal = numBytesWrittenTotal + numBytesWritten
 
'update the progress value
progress.Value = numBytesWrittenTotal / 10240
Loop
'**********************************end loop
 
 
' Close the file handles.
ReDim byte1(0)
progress.Value = 0
retVal = CloseHandle(hDest)
retVal = CloseHandle(hSource)
End Sub

[nemaroller]

Thanks for the appreciation...

This code was slapped together so, there should be some changes if you are going to implement it in a program...

As you found out, if the destination file already exists, it will exit the program...

'create a handle to destination file
If hDest = -1 Then  ' the file could not be opened
  Debug.Print "Unable to open the file - it may already exist, or improper flags"
[b]  End  ' abort the program[/b]
End If

code in bold should be...

Exit Sub

You could change that whole code to a function, and have it return a number depending on the error... so the Exit Sub could be changed to

CopyAFile = 7  'error code #
Exit Function

Or, you could check for the source/destination files exitence before calling the sub/function...

Btw
you don't need the follow declaration, I forgot to take it out.

Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hSource As Long) As Long

[nemaroller]

Just use this revised code instead.. it returns a string "Success" if sucessful, and others if not... so make sure to have a call similiar to
mystring = CopyAFile(progressbar1, "C:\sourcefile", "C:\destfile")

I also changed the filesize code, (higlighted in bold)to make it usable for a file from 10 bytes to file of 2gigabytes...
and to make sure your program won't crash... if anyone wants to add to it, make suggestion revisions, please do so...

'declarations section
Option Explicit
 
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const CREATE_NEW = 1
Private Const OPEN_EXISTING = 3
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
 
'create file handle
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
'allow return of errors encountered while writing destination file
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
'closes file handles
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
'reads the file
Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hSource As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
 
'gets file size
Private Declare Function GetFileSize Lib "kernel32.dll" (ByVal hSource As Long, lpFileSizeHigh As Long) As Long
 
'writes the file
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hSource As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
 
Public Function CopyAFile(progress As Object, sourceFile As String, destFile As String) As String
Dim hSource As Long   'file handle to source file
Dim hDest As Long  'file handle to destination file
Dim retVal As Long  'holder for returned values from the above api calls
Dim numBytesRead As Long 'bytes read on each ReadFile call
Dim numBytesWritten As Long  'bytes written on read WriteFile call
Dim numBytesWrittenTotal As Long 'bytes written total as of current
Dim loworder As Long    'filesize related
Dim highorder As Long   'filesize related
Dim donereading As Boolean  'indicates no more bytes to read, exit loop
Dim byte1() As Byte  ' the Long value to write to the file
Dim f As Long        ' size of byte1()
 
'initialize variables
 
donereading = False
progress.Value = 0
'create a handle to source file
hSource = CreateFile(sourceFile, GENERIC_READ, FILE_SHARE_READ, ByVal CLng(0), OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, ByVal CLng(0))
If hSource = -1 Then  ' the file could not be opened
  Debug.Print "Unable to open the file - it may not exist, or improper flags"
  CopyAFile = "Source file may not exist"
  Exit Function ' abort
End If
 
'create a handle to destination file
hDest = CreateFile(destFile, GENERIC_WRITE, FILE_SHARE_READ, ByVal CLng(0), CREATE_NEW, FILE_ATTRIBUTE_ARCHIVE, ByVal CLng(0))
If hDest = -1 Then  ' the file could not be opened
  Debug.Print "Unable to open the file - it may exist, or improper flags"
  retVal = CloseHandle(hSource)
  CopyAFile = "Destination file exists, or improper flags"
  Exit Function ' abort
End If
[b]
'following code needs to be addressed for files >2gigabytes
'retrieve file size in bytes to store as MAX parameter for progressbar
loworder = GetFileSize(hSource, highorder)  ' read the file's size
If loworder > 2000000000 Then  'this code cannot handle files > 2gb
retVal = CloseHandle(hDest)
retVal = CloseHandle(hSource)
CopyAFile = "File too large"
Exit Function
[/b]
If loworder > 3000 Then highorder = (loworder / 1000)
Else
highorder = (loworder / 10)
End If
 
ReDim byte1(highorder)
f = UBound(byte1)
 
'the maximum size of file to be transfered reflected in max size of progressbar
progress.Max = loworder / highorder '.Max only takes integer values to 32,7Xx..
                                    'an error may occur if filesize > 2gb
 
'*********************************begin loop
Do While (donereading = False)
'read in  bytes from the source file
retVal = ReadFile(hSource, byte1(0), f, numBytesRead, ByVal CLng(0))
If numBytesRead < f Then  'we have read less than byte array bounds (near end of file)
   ReDim Preserve byte1(numBytesRead) 'change the byte array to reflect
   f = UBound(byte1)             'only the amount of bytes read
   donereading = True            'signify done reading to loop
End If
 
' Write out bytes to the destination file
 
retVal = WriteFile(hDest, byte1(0), f, numBytesWritten, ByVal CLng(0))
If retVal = 0 Then
   retVal = GetLastError
   Debug.Print "Error: " & retVal
   CopyAFile = "Error writing destination file: " & retVal
   retVal = CloseHandle(hDest)
   retVal = CloseHandle(hSource)
   Exit Function
End If
 
' force the OS to write the data NOW
'retVal = FlushFileBuffers(hDest)'not necessary as such
numBytesWrittenTotal = numBytesWrittenTotal + numBytesWritten
 
'update the progress value
progress.Value = CInt(numBytesWrittenTotal / highorder)
Loop
'**********************************end loop
 
 
' Close the file handles.
ReDim byte1(0)
progress.Value = 0
retVal = CloseHandle(hDest)
retVal = CloseHandle(hSource)
CopyAFile = "Success"
End Function

[nemaroller]

found a bug in the above code...

relating to an invalid property value for PRogress.value,
re-copy the above code, it has been edited, and changed...

progress.Value = [b]CInt[/b](numBytesWrittenTotal / highorder)