[VB] Applicatie moet externe applicatie starten en wachten

[Toink]

Hoi,

Momenteel ben ik bezig met het maken een applicatie die wat dingetjes doet. 1 Actie die die applicatie doet is het aanroepen van een extern programmatje (installshield-wizard die iets installeert). De hoofdapplicatie moet dan een schermpje weergeven met 'bezig met installeren' tot de externe applicatie is afgesloten. Dat schermpje weergeven is niet zo moeilijk. Echter wat het probleem oplevert is dat ik geen idee heb hoe ik die externe applicatie (naam van die applicatie is niet constant) in de gaten moet houden....

Ik heb via de search gezocht maar het is nogal lastig om hiervoor goede keywords te vinden, dus ik post het maar eens. Hopelijk kan iemand mij vertellen welk stukje code ik mis.

Wie helpt?

[Verwijderd]

weet niet of je het externe programma zelf hebt gemaakt, maar in dat geval kun je natuurlijk gegevens uitwisselen op de gewone manier tussen de progjes

[Toink]

Het externe programma wordt gemaakt onder mijn invloed. Dus daar heb ik wel wat over te zeggen. Maar misschien wil je iets meer vertellen over 'de gewone manier'?

[Sponge]

Zo iets?

code:

Option Explicit
Option Base 0
Option Compare Text

Private Const PROCESS_ALL_ACCESS& = &H1F0FFF
Private Const STILL_ACTIVE& = &H103&
Private Const INFINITE& = &HFFFF

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Sub ShellAndWait(strAppFile As String)
    Dim sCmdLine As String
    Dim idProg As Long, iExit As Long
    
    idProg = Shell(strAppFile, vbNormalFocus)
    iExit = fWait(idProg)
End Sub

Private Function fWait(ByVal lProgID As Long) As Long
    '// Wait until proggie exit code <> STILL_ACTIVE
    Dim lExitCode As Long, hdlProg As Long
    '//Get program handle
    hdlProg = OpenProcess(PROCESS_ALL_ACCESS, False, lProgID)
    '//Get current program exit code
    GetExitCodeProcess hdlProg, lExitCode
    
    Do While lExitCode = STILL_ACTIVE&
        DoEvents
        GetExitCodeProcess hdlProg, lExitCode
    Loop
    
    CloseHandle hdlProg
    fWait = lExitCode
End Function

[Toink]

Cool, ik had inmiddels wel wat gevonden maar die refresht de parent niet.... dus dit is nog beter!

[henkleerssen]

beetje anders dan 41 (en de rest van MAC adres)...
maar onderstaande kan ook (gebruikt ook WaitforSIngleObject API call):

code:

'Structure startup properties for the application to install
Private 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

'structure for info of thread
Private Type PROCESS_INFORMATION 'from MSDN
        hProcess As Long
        hThread As Long
        dwProcessID As Long
        dwThreadID As Long
End Type


Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
        lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
        ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long



Public Sub ExecCmd(cmdline$)
'*******************************************************************************
'Effects:       Starts up the application in the commandline and gives control back to application
'               when application is finished (process based)
'Input:         Command line (path and file with optional parameters
'Output:        NA
'Note:          Changed sample code from MSDN
'*******************************************************************************

    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim ReturnValue As Integer

    ' Initialize the STARTUPINFO structure:
    start.cb = Len(start)
    
    ' Start the shelled application:
    ReturnValue = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

    ' Wait for the shelled application to finish:
    Do
        ReturnValue = WaitForSingleObject(proc.hProcess, 0)
        DoEvents
    Loop Until ReturnValue <> 258

    ReturnValue = CloseHandle(proc.hProcess)
End Sub

sucess .. moet lukken

[Toink]

henkleerssen, die had ik inderdaad ook gevonden maar die wil bij mij de parent niet refreshen.... of is dat ergens instelbaar?