[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 176
  • Last Modified:

How to run another program "modally"

From inside a program, I want to run another "utility" program (using shell or "createprocess" but I want that this second program is "modal", stopping the execution of the main one. Using the "waitforsingleobject" function with the second parameter set to "INFINITE", the main program always crashes. Perhaps the best way would be to make the "Utility" program a "child" from the main one and displayed as if it would be a modal form of the main one...
0
PhilippeLeclerc
Asked:
PhilippeLeclerc
  • 2
1 Solution
 
mcriderCommented:
You can use the following code to see if program you started is running, Put it in a module:

Global ProgHandle As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long

Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long

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

Declare Function SysSetFocus Lib "user32" Alias "SetFocus" _
    (ByVal hwnd As Long) As Long
Function IsActive(hprog) As Long
    Dim hProc, RetVal As Long
    hProc = OpenProcess(0, False, hprog)
    If hProc <> 0 Then GetExitCodeProcess hProc, RetVal
    IsActive = (RetVal = 259)
    CloseHandle hProc
End Function

------------------------------------------------------------

When you shell the program, do it like this, (remember ProgHandle is a global definition):

ProgHandle = Shell("notepad.exe", vbNormalFocus)

You can then make the following call to see if the shelled process is still running:

    If IsActive(ProgHandle) Then
        'THE SHELLED PROGRAM IS ACTIVE
        'DO WHATEVER YOUR GOING TO DO
    Else
        'THE SHELLED PROGRAM IS NOT ACTIVE
        'DO WHATEVER YOUR GOING TO DO
    End If



If you want your program to "Freeze" until the shelled program is completed, you can add this code to your program:

'-----------------------------------------------------------
Public Const INFINITE = -1&

Private Declare Function OpenProcess Lib "kernel32" (ByVal _
    dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessID As Long) As Long

   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

   Private Type PROCESS_INFORMATION
      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

   Private Declare Function GetExitCodeProcess Lib "kernel32" _
      (ByVal hProcess As Long, lpExitCode As Long) As Long

   Private Const NORMAL_PRIORITY_CLASS = &H20&
   
  Public Function ExecCmd(cmdline$)
      Dim proc As PROCESS_INFORMATION
      Dim start As STARTUPINFO

      ' Initialize the STARTUPINFO structure:
      start.cb = Len(start)

      ' Start the shelled application:
      ret& = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, _
         NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)


      ' Wait for the shelled application to finish:
         ret& = WaitForSingleObject(proc.hProcess, INFINITE)
         Call GetExitCodeProcess(proc.hProcess, ret&)
         Call CloseHandle(proc.hThread)
         Call CloseHandle(proc.hProcess)
         ExecCmd = ret&
    End Function
'-----------------------------------------------------------

You can then use the following anywhere in your program:

   ExecCmd("C:\WINDOWS\CALC.EXE")

instead of:

   Shell("C:\WINDOWS\CALC.EXE",1)


Cheers!
0
 
PhilippeLeclercAuthor Commented:
Good evening,
Thank You very much for your answer.
Despite I'm not a "professional" programer, I had written the same program as yours with the help of MSDN but, unfortunately, it DOESN'T WORK FINE!
Here is what happens :
The second program is well shelled.
But (as soon as the WaitforSingleObject function is called) ...
1> You aren't allowed to move the form of the shelled program on the screen : If You move it, the screen is not refreshed : Besides the "true" moved window, the image of this window at its first location remains on the screen.
2> If You click on the window of the 1st program with the mouse, it's evidently impossible to make it active (OK) but the window of the shelled program becomes deactivated too and it's now impossible to make this shelled program active again ... The whole system is "locked".
Any idea ?
0
 
mcriderCommented:
That's what is "SUPPOSED" to happen when you call WaitforSingleObject.  The calling task freezes and the window will not update until the WaitforSingleObject is satisfied...

The first bit of code I gave you solves this problem.  Put it in a module:

Global ProgHandle As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long

Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long

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

Declare Function SysSetFocus Lib "user32" Alias "SetFocus" _
    (ByVal hwnd As Long) As Long
Function IsActive(hprog) As Long
    Dim hProc, RetVal As Long
    hProc = OpenProcess(0, False, hprog)
    If hProc <> 0 Then GetExitCodeProcess hProc, RetVal
    IsActive = (RetVal = 259)
    CloseHandle hProc
End Function



Then you can call your second program from the first like this:


ProgHandle = Shell("notepad.exe", vbNormalFocus)
Do
    If IsActive(ProgHandle) Then
        'THE SHELLED PROGRAM IS ACTIVE
        'WAIT INSIDE THE LOOP
        DoEvents
    Else
        'THE SHELLED PROGRAM IS NOT ACTIVE
        Exit Do
    End If
Loop



Why did you grade this as a "D" instead of asking for more information??


Cheers!

0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now