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
__) - (__ -----------------------------·