Wait for process to finish before continuing with VB6 code

Hi

I have a code which compresses some folders and then deletes the source directory.  I am struggling on a bit which I have never really understood how it works.  Process Handles - I am trying to wait for the process to finish copying the files before deleting the folder.  I guess this should be done by taking the process handle and I have found I can wait for the process if I give the handle but how do I get this handle?

I'm looking specifically at the stuff on lines 30 and 35.

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Sub CreateZipFileFromFolder(ByVal DestinationFile As String, ByVal SourceFolder As String)

    Dim fso As Object
    Dim ts As Object

    'Build a blank zip file
    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ts = fso.CreateTextFile((DestinationFile), True)
    ts.Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
    ts.Close

    'Get a reference to the "shell" so that you can build the zip files references
    Dim objShell As Object
    Set objShell = CreateObject("Shell.Application")

    'Get an object that represents the folder
    Dim objFolder As Object
    Set objFolder = objShell.Namespace((SourceFolder))

    'Get an object that represents the destination file
    Dim objZipFile As Object
    Set objZipFile = objShell.Namespace((DestinationFile))    'DOUBLE PARENTHESES ARE NECESSARY FOR THIS TO WORK!!!

    'Zip the contents of the folder into the file
    objZipFile.CopyHere (objFolder.Items)
    CopyhHandle = InstanceToWnd(objShell)



    ' Return the window handle for an instance handle and wait.
    WaitForSingleObject CopyhHandle, 99999999

    'Cleanup the source folder (if desired)
    fso.DeleteFolder (SourceFolder)

End Sub
Private Function InstanceToWnd(ByVal target_pid As Long) As _
        Long
    Dim test_hwnd As Long
    Dim test_pid As Long
    Dim test_thread_id As Long

    ' Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)

    ' Loop until we find the target or we run out
    ' of windows.
    Do While test_hwnd <> 0
        ' See if this window has a parent. If not,
        ' it is a top-level window.
        If GetParent(test_hwnd) = 0 Then
            ' This is a top-level window. See if
            ' it has the target instance handle.
            test_thread_id = _
            GetWindowThreadProcessId(test_hwnd, _
                                     test_pid)

            If test_pid = target_pid Then
                ' This is the target.
                InstanceToWnd = test_hwnd
                Exit Do
            End If
        End If

        ' Examine the next window.
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function

Open in new window

LVL 1
simonwaitAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

SStoryCommented:
I think that would give you the instance of the window handle.  That is not the same as process handle.
Would something like this work?

Public Declare Function GetWindowThreadProcessId Lib "user32" _
  (ByVal hwnd As Long, lpdwprocessid As Long) As Long

  ' Get PID for this HWnd
   GetWindowThreadProcessId hwnd, idProc

http://support.microsoft.com/en-us/kb/242308
0
simonwaitAuthor Commented:
Sorry - sent this reply days ago but obviously didnt hit submit.  So what I am still confused about is how I get the handle from the object objZipFile to then get the process id or is the wrong way around?

Thanks for your help so far

 Dim Handle As Long

    Handle = objZipFile.CopyHere(objFolder.Items)
    hwnd = GetWinHandle(Handle)

    GetWindowThreadProcessId hwnd, idProc

Open in new window

0
SStoryCommented:
Hard for me to say because I don't know what objZipfile is. What kind of handle does it return? I think you want a process handle instead of a Window handle.  I could be wrong.  It is easy to do in vb.net. I don't know if I ever did that in vb6 or not.
0
HooKooDooKuCommented:
I've posted the following Code before for a VB6 function I wrote years ago called "WaitShell"...

It utilizes API function calls to start a thread and watch the thread until it terminates.  It's only shortfall I know of is if the Shell command you execute brings up a DOS window... then the thread doesn't actually terminate until the DOS window closes.

'Run a command line program and stay here until execution of command is complete
' Returns the Exit Code from the call Program
'NOTE: If a DOS or BAT Program is executed and the DOS window remains on the
'      screen after the DOS Program has executed, this Function will remain in
'      its loop until the DOS Window is closed
'      (check the 'Close on Exit' Propert for the DOS Program)
Public Function WaitShell(CmdLine$, Optional WindowStyle As VbAppWinStyle = vbMinimizedFocus) As Long
Const Source As String = "WaitShell"
Dim CommandLine As String       'CmdLine is Placed in a different String so that it is not modified by the CreateProccess Function
Dim SUI As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim hProcess As Long
Dim ExitCode As Long

    On Error GoTo CatchError
    
    'Initialize Required Variables
    CommandLine = CmdLine$          'Copy it because CreateProcess Function may try to change it (add a Null to the end)
    With SUI
        .cb = Len(SUI)
        .lpReserved = vbNullString
        .lpDesktop = vbNullString
        .lpTitle = vbNullString
        .cbReserved2 = 0
        .lpReserved2 = 0
        .dwFlags = 1
        .wShowWindow = WindowStyle
    End With
    
    'Create the Thread in a Suspended State
    If CreateProcess(vbNullString, CommandLine, ByVal 0, ByVal 0, 0, CREATE_SUSPENDED, ByVal 0, vbNullString, SUI, pi) = 0 Then
        Call RaiseLastDllError
    End If
    
    'Remember the Process Handle
    hProcess = pi.hProcess
    If hProcess = 0 Then
        Call RaiseLastDllError
    End If
    
    'Release the Thread for Execution
    If ResumeThread(pi.hThread) = -1 Then
        Call RaiseLastDllError
    End If
    
    'Watch for the Exit Code to indicate Process has finished
    Do
        If GetExitCodeProcess(hProcess, ExitCode) = 0 Then
            Debug.Assert Err.LastDllError <> 0
            Call RaiseLastDllError
        End If
        
        DoEvents
        Sleep 100
    Loop While ExitCode = STILL_ACTIVE
    
    WaitShell = ExitCode
        
    Call CloseHandle(pi.hProcess)
    Call CloseHandle(pi.hThread)
    
    Exit Function
    
CatchError:
    Call CloseHandle(pi.hProcess)
    Call CloseHandle(pi.hThread)
    Raise Err.Num
    
End Function

Open in new window

If you don't already have references to the various API functions and structures this code is referencing, here's a part of a file I have that includes the declarations that are needed (and likely more... so you might need to pick thru it if you don't want all the definitions).
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function PostThreadMessage Lib "user32" Alias "PostThreadMessageA" (ByVal idThread As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Public Const WM_CLOSE = &H10
Public Const WM_QUIT = &H12
 
Public Const INVALID_HANDLE_VALUE = -1
 
Public Const CREATE_SUSPENDED = &H4
Public Const CREATE_NEW_CONSOLE = &H10
Public Const CREATE_NEW_PROCESS_GROUP = &H200
Public Const CREATE_NO_WINDOW = &H8000000
Public Const NORMAL_PRIORITY_CLASS = &H20
Public Const IDLE_PRIORITY_CLASS = &H40
Public Const HIGH_PRIORITY_CLASS = &H80
Public Const REALTIME_PRIORITY_CLASS = &H100
 
Public Const STILL_ACTIVE = &H103
Public Const PROCESS_TERMINATE = &H1
Public Const PROCESS_CREATE_THREAD = &H2
Public Const PROCESS_VM_OPERATION = &H8
Public Const PROCESS_VM_READ = &H10
Public Const PROCESS_VM_WRITE = &H20
Public Const PROCESS_DUP_HANDLE = &H40
Public Const PROCESS_CREATE_PROCESS = &H80
Public Const PROCESS_SET_QUOTA = &H100
Public Const PROCESS_SET_INFORMATION = &H200
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
 
Public Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
End Type
 
Public Type STARTUPINFO
        cb As Long
        lpReserved As String
        lpDesktop As String
        lpTitle As String
        dwX As Long
        dwY As Long
        dwXSize As Long
        dwYSize As Long
        dwXCountChars As Long
        dwYCountChars As Long
        dwFillAttribute As Long
        dwFlags As Long
        wShowWindow As Integer
        cbReserved2 As Integer
        lpReserved2 As Long
        hStdInput As Long
        hStdOutput As Long
        hStdError As Long
End Type
 
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
 
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function CreateProcess_API Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, ByRef lpExitCode As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
'Execute a Command Line in a New thread and return the hProcess
Public Sub StartThread(pi As PROCESS_INFORMATION, CommandLine As String, WindowStyle As VbAppWinStyle)
Dim MyCommandLine As String 'CommandLine is Placed in a different String so that it is not modified by the CreateProccess Function
Dim SUI As STARTUPINFO
 
    'Initialize Required Variables
    MyCommandLine = CommandLine     'Copy it because CreateProcess Function may try to change it (add a Null to the end)
    With SUI
        .cb = Len(SUI)
        .lpReserved = vbNullString
        .lpDesktop = vbNullString
        .lpTitle = vbNullString
        .cbReserved2 = 0
        .lpReserved2 = 0
        .dwFlags = 1
        .wShowWindow = WindowStyle
    End With
    
    'Create the Thread in a Suspended State
    If CreateProcess_API(vbNullString, MyCommandLine, ByVal 0, ByVal 0, 0, CREATE_SUSPENDED, ByVal 0, vbNullString, SUI, pi) = 0 Then
        Debug.Print "ERROR"
        'Handle the error listed in Err.LastDllError
    End If
    
    If pi.hProcess = 0 Then
        Debug.Print "ERROR"
        'Handle the error listed in Err.LastDllError
    End If
    
    'Release the Thread for Execution
    If ResumeThread(pi.hThread) = -1 Then
        Debug.Print "ERROR"
        'Handle the error listed in Err.LastDllError
    End If
    
End Sub
'Terminate a thread
Public Sub CloseThread(pi As PROCESS_INFORMATION)
Dim ExitCode As Long
    
    'Send a Quit Message
    Call PostThreadMessage(pi.dwThreadId, WM_QUIT, 0, 0)
    
    'Watch for the Exit Code to indicate Process has finished
    Do
        If GetExitCodeProcess(pi.hProcess, ExitCode) = 0 Then
            Debug.Print "ERROR"
            'Handle the error listed in Err.LastDllError
        End If
        
        DoEvents
        Sleep 100
    Loop While ExitCode = STILL_ACTIVE
    
    'Close Thread Handles
    Call CloseHandle(pi.hProcess)
    Call CloseHandle(pi.hThread)
    
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
simonwaitAuthor Commented:
OK, thanks for that.  Im about to board a long flight but will take a look after I land.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.