Resumen Lanzador de Aplicaciones en VB

Alguien (no recuerdo quién) había necesitado armar una aplicación que sirva de "lanzadera" para otras aplicaciones.
Las condiciones son:
1- La lanzadera y cualquier otra aplicación sólo se puede ejecutar una vez en cada máquina.
2- La lanzadera no puede parar su ejecución hasta que todas las aplicaciones hijas hayan sido cerradas.

Bueno, creo que pasaron como diez días de esta pregunta, pero acá va la respuesta por si sirve a alguien.

Private Const MAXAPPINDEX = 10

Private bAppsRunning(MAXAPPINDEX) As Boolean
Private AppTaskIds(MAXAPPINDEX) As Long
Private AppProcIds(MAXAPPINDEX) As Long

Private Declare Function OpenProcess Lib "kernel32" (ByVal
dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function ShellExecute Lib _
    "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
    ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

Private Function IsAnyAppRunning() As Boolean
Dim n As Integer
    IsAnyAppRunning = False

    For n = 0 To MAXAPPINDEX - 1
        If AppTaskIds(n) Then
            If IsTaskRunning(AppTaskIds(n)) Then
                IsAnyAppRunning = True
                Exit Function
            End If
        End If
    Next n
End Function

Private Function IsTaskRunning(ByVal hApp As Long) As Boolean
Dim hProc As Long
Dim lExitCode As Long

    IsTaskRunning = False

    hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hApp)
    GetExitCodeProcess hProc, lExitCode
    If lExitCode = STILL_ACTIVE Then
        IsTaskRunning = True
    End If
End Function

Private Sub Initialize()
Dim n As Integer

    ' Inicializa la lista de aplicaciones
    For n = 0 To MAXAPPINDEX - 1
        bAppsRunning(n) = False
        AppTaskIds(n) = 0
    Next n
End Sub

Private Sub Form_Load()
    ' Prueba si existe otra instancia de la aplic. corriendo
    If App.PrevInstance Then
        MsgBox scPREV_INSTANCE_RUNNING
        End
    End If

    Initialize

    Me.Show
    imgLauncher.Left = (Me.Width - imgLauncher.Width) / 2
    imgLauncher.Top = (Me.Height - imgLauncher.Height) / 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If IsAnyAppRunning() Then
        MsgBox "Please shut down all other Duwamish applications before exiting the Launcher."
        Cancel = 1
    Else
        End
    End If
End Sub

Private Sub tmrAppMonitor_Timer()
Dim n As Integer
    For n = 0 To MAXAPPINDEX - 1
        If AppTaskIds(n) Then
            If IsTaskRunning(AppTaskIds(n)) = False Then
                bAppsRunning(n) = False
                AppTaskIds(n) = 0
            End If
        End If
    Next n
End Sub


Private Sub WatchToolbarHotkeys(ByVal KeyPressed As Integer)
Dim sKeyChar As String
Dim iIndex As Integer
Dim btn As Button

    sKeyChar = UCase$(Chr$(KeyPressed))

    For Each btn In Toolbar1.Buttons
        If btn.Enabled Then
            iIndex = InStr(btn.Caption, "&")
            If iIndex Then
                If UCase$(Mid$(btn.Caption, iIndex + 1, 1)) = sKeyChar Then
                    Toolbar1_ButtonClick btn
                    Exit Sub
                End If
            End If
        End If
    Next btn

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    WatchToolbarHotkeys KeyCode
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
    Dim sPgm As String
    Dim oButton As Button
    Dim sOptions As String
    Dim lResult As Long

    bShell = True
    sPgm = ""
    sOptions = "/MIAPLICACION"
'El siguiente code debe ser ubicado al inicio de cada aplicación
' Evita que las aplicaciones puedan correrse por separado
' If InStr(UCase$(Command$), "/MIAPLICACION") <= 0 Then
' Shell App.Path & "\launch.exe", vbNormalFocus
' End
' End If

    If bAppsRunning(Button.Index) Then
        MsgBox Button.Key & " ya está corriendo.Use Alt-TAB para conmutar."
        Exit Sub
    End If

    Select Case Button.Key
    Case "App1"
        sPgm = "App1"
...
      Case "Exit"
        Unload Me
    End Select

    sPgm = App.Path & "\" & sPgm
    If Dir(sPgm) = "" Then
        MsgBox "No se puede encontrar la aplicación " & sPgm, vbCritical, "Aplicacion inexistente"
    Else
        sPgm = sPgm & " " & sOptions
        AppTaskIds(Button.Index) = Shell(sPgm, vbNormalFocus)
        If Err Then
            MsgBox "No se puede ejecutar " & sPgm
        Else
            bAppsRunning(Button.Index) = True
            If bMinimizeLauncher Then
                Me.WindowState = vbMinimized
            End If
        End If
    End If

End Sub

--
    (_\ /_) ----------------------------·
        )) (( María Andrea Vignau
     .-"""""""-.
/^\/ _. _. \/^\ Ingeniera en
\( /__\ /__\ )/ Sistemas de Informacion
 \, \o_/_\o_/ ,/
   \ (_) / E-Mail:
    `-.'==='.-' mavignau@bigfoot.com
__) - (__ -----------------------------·



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com