Solved

VB6 code utilization

Posted on 2006-06-18
31
1,135 Views
Last Modified: 2012-05-05
Sorry if the title makes no sense - what i'm trying to seems quite simple, but I'm not getting the results that I want.

Using a filesystem command in VB6, i am copying a folder of a typical size of 650 - 750 MB of data from a DVD disk to the HDD. I have a progress bar setup to show progress (not exact, but by an estimated time of 1 min 10 secs to copy the folder on a P4 pc) However when I issue the line of code to copy the folder, my prgram doesn't respond to my timer control that updates the progress bar, so it goes from nothing to 100% after doing nothing for a minute (while the files are copied).

How can i keep my vb6 program in control while the files are copied. How could I get the progress bar control more accurate in regards to copying different sized folders on different speed pc's?

Thanx for help in advance
0
Comment
Question by:Ryan_R
  • 12
  • 10
  • 5
  • +2
31 Comments
 
LVL 13

Accepted Solution

by:
Mark_FreeSoftware earned 70 total points
ID: 16929205

if you copy all files with one command, it is (as far as i know) not possible to show the progress in your application.

if you walk trough the files in your code, you can set the progress bar after each file.



but take a look at this:
you can see the progress of a file:

http://www.allapi.net/apilist/578D8A66191323E0F8FFECF588222A33.html
0
 
LVL 9

Expert Comment

by:justchat_1
ID: 16930264
a single command will execute until it is done and not make it possible for other lines of code to execute (like the timer function) until it completes
0
 
LVL 8

Expert Comment

by:wraith821
ID: 16930336
use the windows filecopy dialog
check this url out. it does everything you want for you you just have to set it up

http://vbnet.mvps.org/index.html?code/shell/shfileopadv.htm
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 16932072
mark_FS> does the routine you provided work for copying a folder, not a file? This autorun app is more like a template app, so it will have some unknowns as i use it on different occasions. I'll provide more details on the purpose of my app here:

You may be aware of Virtual CD (i'm running v5, v8 is now available though). You use the program to rip a CD image (typically for game cd's) to the hdd so that yu don't need the physical cd to access the game files and to play the game. This offers advantages such as not damaging the disc (scratches, etc) and faster read/write access (ie a 200x speed cd rom drive in comparison).

I want to burn a selection of vir CDs to a DVD disc so that i can insert about 7 or 8 VCDs off the DVD disc which will save me HDD space and I can copy the VCDs to my HDD quicker if I like without having to make another image if i format my HDD)

My autorun program will offer the functions of installing Virtual CD (working), inserting a VCD into my Virtual CD Drive (working), run Virtual Cd Management programm (working), and copying a VCD to the HDD (where my problem lies)

In a typical VCD folder are the following files: (using NFS UG2 as example)
---
NFSUG2_DISC2.000            .000 file      663.4 MB
".ico
".html
".jpg
".vc4                               --> all below 1 MB each
---
so only the one file takes the longest time to be copied from DVD to HDD
(btw my testing from above is only been from one HDD to another which is probably faster than DVD speeds.

Hope this helps you guys

Ryan R
0
 
LVL 13

Assisted Solution

by:Mark_FreeSoftware
Mark_FreeSoftware earned 70 total points
ID: 16933128


ok, then i advise you to take a look at the example wraith821 provided.

don't use the filelistbox as described, but modify then code so you can select a directory, and place *.* behind it
so your path to copy from looks like this:

c:\documents and crap\youruser\*.*



it does copy all files in the specified dir, and you can see the progress with a default windows dialog
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 16948875
i'll take a look soon - i'll need to sort out what code out of that is really necessary - i doubt that i need to use all of it. any pointers of the minimum code need for the copy routine appreciated. i wonder how windows is able to keep tabs on updating the progressbar control

until next time, Ryan R
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 16951418

>>i wonder how windows is able to keep tabs on updating the progressbar control


i think they open the source and destination file, check the file size,
and then copy chunks of data

than after every chunk of data you can update the progress

somthing like this: (maybey the code isnt functional, it's just an example written straight out my mind)

dim buffer as string, n as long
open "c:\src.txt" for binary as #1
    open "c:\dest.txt" for binary as #2
        for n = 1 to lof(1) step 512
            buffer=space(512)
            get #1,n,buffer
            put #2,n,buffer
            progress=n / lof(1) * 100
        next
    close #2
close #1


0
 
LVL 9

Expert Comment

by:justchat_1
ID: 16954183
Thats actually how most file transfer code works...almost perfect except that you would want to declare the buffer before the loops...and since this is just a file copy you dont even need the buffer

^just another option^
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 16954273

it was just an example ;)
and i do declare the buffer before the loops,
i only make sure really 512 bits are read a time



ps, how should you rewrite this code without buffer?
0
 
LVL 9

Expert Comment

by:justchat_1
ID: 16955344
just loop through the file taking one byte at a time and writing it to the output file...
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 16955440

that adds a little overhead, with a buffer it is slightly faster (if the right buffer size is used)
0
 
LVL 9

Expert Comment

by:justchat_1
ID: 16956304
so reading from a file to a buffer and then from a buffer to a file is faster then just going directly?
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 16956359
yes,

i tested it once

512 was not the optimal size, but with some testing you can very easy find the right size
0
 
LVL 9

Expert Comment

by:justchat_1
ID: 16957006
i think i heard something about 64 for a buffer number but im not positive... thanks for the info-to bad we cant split this into a seperate topic
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 16957796
we can, watch this:

http://Q_21895198.html
;)
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 16957813
//broken link


this one should work:
http:Q_21895198.html
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 16958137
ok so i have used the code from this website:
http://www.allapi.net/apilist/578D8A66191323E0F8FFECF588222A33.html

updating the progress bar works fine now (thanx to Mark_FS), however the actual copying isn't working properly. (I was hoping for a CopyFolder routine).
i'm using another filelistbox and a for-loop to copy the files one by one.

Instead of getting a new folder called NFSUG2 with al the files inside it, i get a file (no extension) named NFSUG2 in the dest path which sizes up to only a few KBs, when it should take up about 700MB.

I'll provide the relevant code here:

-----------frmMain.frm--------------
Private Sub cmdCopy_Click()
'On Error GoTo DispErr

pbr1.Visible = True
lblCopying.Visible = True
cmdCopy.Enabled = False

Dim Ret As Long
Me.AutoRedraw = True

For i = 0 To File2.ListCount - 1
    Ret = CopyFileEx(File2.Path & "\" & File2.List(i), txtCopy.Text & "\" & lstVCD.List_(lstVCD.ListIndex), AddressOf CopyProgressRoutine, ByVal 0&, bCancel,_ COPY_FILE_RESTARTABLE)
    lblCopying.Caption = "VCD Files Copied Successfully" + IIf(Ret =_ 0, "(ERROR/ABORTED).", "successfully.")
Next

If 1 = 2 Then   'old code used before consulting EE, won't run
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFolder File1.Path, txtCopy.Text & "\" & lstVCD.List(lstVCD.ListIndex)
    Set fs = Nothing
End If
MsgBox "Copy Successful", vbInformation, "Autorun"

Exit Sub
DispErr:
    MsgBox Err.Number & Chr(13) & Err.Description, vbCritical, "Error"
    Exit Sub
Resume Next
End Sub
--------------------------------

--------------------mdlCopy.bas---------------------
Public Const PROGRESS_CANCEL = 1
Public Const PROGRESS_CONTINUE = 0
Public Const PROGRESS_QUIET = 3
Public Const PROGRESS_STOP = 2
Public Const COPY_FILE_FAIL_IF_EXISTS = &H1
Public Const COPY_FILE_RESTARTABLE = &H2
Public Declare Function CopyFileEx Lib "kernel32.dll" Alias "CopyFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal lpProgressRoutine As Long, lpData As Any, ByRef pbCancel As Long, ByVal dwCopyFlags As Long) As Long
Public Declare Function CopyFolderEx Lib "kernel32.dll" Alias "CopyFolderExA" (ByVal lpExistingFolderName As String, ByVal lpNewFolderName As String, ByVal lpProgressRoutine As Long, lpData As Any, ByRef pbCancel As Long, ByVal dwCopyFlags As Long) As Long
Public nPCentCopied As Integer
Public bCancel As Long

Public Function CopyProgressRoutine(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, ByVal lpData As Long) As Long
   
    nPCentCopied = Int((TotalBytesTransferred * 10000) / (TotalFileSize * 10000) * 100)
    frmMain.pbr1.SetLevel nPCentCopied
    'adjust the caption
    frmMain.lblCopying.Caption = "Copying Files -- " & CStr(Int((TotalBytesTransferred * 10000) / (TotalFileSize * 10000) * 100)) + "% -- Please Wait"
    'allow user input
    DoEvents
    'continue filecopy
    CopyProgressRoutine = PROGRESS_CONTINUE
End Function
-------------------------------------------------

Hope this helps you all
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 16974458
if you just skip large comments like i sometimes do i'll break it down into the few important lines:

For i = 0 To File2.ListCount - 1
    Ret = CopyFileEx(File2.Path & "\" & File2.List(i), txtCopy.Text & "\" & lstVCD.List_(lstVCD.ListIndex), AddressOf CopyProgressRoutine, ByVal 0&, bCancel,_ COPY_FILE_RESTARTABLE)
    lblCopying.Caption = "VCD Files Copied Successfully" + IIf(Ret =_ 0, "(ERROR/ABORTED).", "successfully.")
Next

----

nPCentCopied = Int((TotalBytesTransferred * 10000) / (TotalFileSize * 10000) * 100)
frmMain.pbr1.SetLevel nPCentCopied

---
0
 
LVL 12

Assisted Solution

by:AmigoJack
AmigoJack earned 70 total points
ID: 17031005
Ret = CopyFileEx(File2.Path & "\" & File2.List(i), txtCopy.Text & "\" & lstVCD.List_(lstVCD.ListIndex), AddressOf CopyProgressRoutine, ByVal 0&, bCancel,_ COPY_FILE_RESTARTABLE)
    lblCopying.Caption = "VCD Files Copied Successfully" + IIf(Ret =_ 0, "(ERROR/ABORTED).", "successfully.")

please mind that the first parameter is the source file and the second one the new filename. so i dont know why youre referencing that with lstVCD.List_(...whatever). for test purposes, use this - that should point you into the right direction:

Ret = CopyFileEx(File2.Path & "\" & File2.List(i), txtCopy.Text & "\" & File2.List(i), AddressOf CopyProgressRoutine, ByVal 0&, bCancel,_ COPY_FILE_RESTARTABLE)
    lblCopying.Caption = "VCD Files Copied Successfully" + IIf(Ret =_ 0, "(ERROR/ABORTED).", "successfully.")

it works provided "File2.Path" is an existing directory and "txtCopy.Text" also holds an EXISTING directory (both of course without a trailing backslash). additionally since youre only copying files here you should also be aware that you have to create any new folder on your own of course.
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 17034055
unfortunately the directory will need to be created, but i think i can get around it using the MkDir command before the loop.

yes i am aware of why i'm using the lstVCD.list in the new dir: the lstVCD contains the names of each VCD found in the VCD folder by using the values of File1.path which has it's path set to app.path & "\VCD's".

however i think i've just found a mistake in my own code as the dest. file in the loop only contains a path when i should also put the filename after it as well.

will try this out soon (like tonight). Thanx A-Jack
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 17054801
in case you think ive desrted you all and won't give out points, you are mistaken. i just keep forgetting to come back 'ere coz theres no reminders in my inbox due to lack of activity here. Haven't completely solved the problems in this project.

the copy part of thisd works (i think - haven't tested multiple copies in the one seesion (haven't copied on VCD after copying one just before))

the problem lies in the MkDir command.

ie the following path exists on c:
C:\Test One
if i go  MkDir C:\Test One\Test Two    it will work
if i go MkDir C:\Test One\Test Two\Test Three\Test Four  i get an error (path not found)

meaning you can only create one level of directories at a time. i do not see using Left$() and InStr() as a good idea in order to accomplish this

so if there are more command co copy files other than fs.CopyFile() then there must be another function in the API out there somehere to create new folders all in one go

i might increase points available so i can split more fairly l8er if i get a good response to this. After i get this to create the path i need i can compile the program, burn the DVD and close this question

Thanks for all your help past present and future
0
 
LVL 12

Expert Comment

by:AmigoJack
ID: 17056607
add this piece of code for creating a folderpath:


Public Sub CreateFolderPath(ByVal sPath As String)
  Dim i1, i2 As Integer
  i2 = 2  ' path could be absolute (first char \ )

  ' absolute path with drive letter? then search later for \  
  If Len(sPath) >= 2 Then
    If Mid$(sPath, 2, 1) = ":" Then i2 = 4
  End If
 
  ' always trailing backslash
  If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
 
  While i2 <= Len(sPath)
    i1 = InStr(i2, sPath, "\", vbTextCompare)
    If i1 > 0 Then
      MkDir Left$(sPath, i1 - 1)
      i2 = i1 + 1
    Else
      i2 = Len(sPath) + 1
    End If
  Wend
End Sub

0
 
LVL 12

Expert Comment

by:AmigoJack
ID: 17056616
sorry. if any folder already exists this procedure of course fails. heres the correction (one half line)

Public Sub CreateFolderPath(ByVal sPath As String)
  Dim i1, i2 As Integer
  i2 = 2
 
  If Len(sPath) >= 2 Then
    If Mid$(sPath, 2, 1) = ":" Then i2 = 4
  End If
 
  If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
 
  While i2 <= Len(sPath)
    i1 = InStr(i2, sPath, "\", vbTextCompare)
    If i1 > 0 Then
      If Dir(Left$(sPath, i1 - 1), vbDirectory) = "" Then MkDir Left$(sPath, i1 - 1)
      i2 = i1 + 1
    Else
      i2 = Len(sPath) + 1
    End If
  Wend
End Sub
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 17064123
thanks for your response (good thing i checked back here, i nearly burnt what i had to dvd)
i'll need to check this repsonse at home before I dish out points, but so far the solution seems like it will work. As i said i was sure you could accomplish this by using Left() and InStr() function but couldn't be bothered wasting time getting it to work. Time = Points, so you can be assured of getting some, AJ.

Will check back here soon in next few days. I have to search for a Vista Beta 2 product key because I think i mistyped my email address after getting it. If anyone knows where you can get working keys that would be great too.
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 17067308
ok so your make_dir routine works (but you already knew that of course)
one error is stopping me from finishing this project and this question
(btw i'll definately increase points available in this question as it has gone a bit further than i imagined at first)

OK here is the problem. When i start the copy, i show a Stop button to stop the copy. In the stop routine it sets bCancel to 1 and attempts to delete all the files already copied followed by the folder.

---------
Private Sub cmdStop_Click()
If MsgBox("Are you sure you want to stop the copy process?", vbQuestion + vbYesNo, "Autorun") = vbYes Then
    bCancel = 1
    'MsgBox "hi"
    lblCopying.Caption = "Copy proccess aborted by user."
    nYellow = 3
    tmr1.Enabled = True
   
End If
End Sub
-------
then we goto tmr1 where after the 2 second delay it does the delete action and hides all the Stop buttons, progress bars, etc
-----
Private Sub tmr1_Timer()
nYellow = nYellow + 1
If nYellow = 5 Then
    pbr1.Visible = False
    lblCopying.Visible = False
    cmdCopy.Enabled = True
    cmdStop.Enabled = True
    txtCopy.Enabled = True
    nYellow = 0
    pbr1.SetLevel 0
    'blnCopying = False
    tmr1.Enabled = False
    cmdStop.Visible = False
    If blnDel = True Then
        On Error Resume Next
        sOldPath = File2.Path
        File2.Path = txtCopy.Text & "\" & sFolder
        For i = 0 To File2.ListCount - 1
            File2.ListIndex = i
            Kill File2.Path & "\" & File2.List(i)
        Next
        RmDir File2.Path
        'MsgBox File2.Path
        File2.Path = sOldPath
    End If
End If
End Sub
------
after i do this i get error saying something like Can't delete,  File in use. (This happens when deleting from Explorer too while app is running)
if i try to copy any other images i will immeaqditely get the error VCD copy unsuccessful.
i have to close the app and restart it again to copy files properly.

Why is it so?
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 17067311
points have been doubled
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 17089310
i'll dish out the points now between MarkFreeSoftware and AmigoJack as they helped me the most. Please feel free to help me with my last post on the cmdStop_Click() process
Thanks
Ryan R
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 17089328
again i would really appreciate it if someone helped me out with that final part of my program. If helped by someone other than MarkFS and AJ then i can give points to you in new post (ie my pointer post to this Q)  http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_21906273.html
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 17089344

thanks for the points, and happy coding!
0
 
LVL 15

Author Comment

by:Ryan_R
ID: 17095201
you're welcome. i can't bring myself to compile and burn this program to disk yet as i want any files copied from DVD to HDD to be deleted when I click the Stop/Cancel button on the form when it appears at the beginning of the copy process.
What do i do with the 20pt pointer question i made apart from sending the points your way?
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 17095219

take a look at this help topic:
http://www.experts-exchange.com/help.jsp#hi302
(Can I delete my question myself?)
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

762 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

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now