CODE TO SHELLWAIT()

I've used this routine before, and it worked well.  Unfortunately, the source was left behind at my last job.  I'm putting 150 points on the question, because I really need to start using it tommorrow (Wednesday, 11/24).  

Thanks!

Dreaming_EagleAsked:
Who is Participating?
 
mcriderConnect With a Mentor Commented:
There are a couple of ways you can do this.  To completely stop your program, you can do this:

This will work in 95/98/NT, Put the following code in a module:

'-----------------------------------------------------------
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("progam_name")

Your program will halt until the command is finised executing.

You can also poll to see if your shelled program is still running.  You can do that this way:

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

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

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

Public Function IsShellTaskActive(ShellID As Variant) As Long
    Dim hProcess As Variant
    Dim lRetVal As Long
    hProcess = OpenProcess(0, False, ShellID)
    If hProcess <> 0 Then GetExitCodeProcess hProcess, lRetVal
    If lRetVal = 259 Then
        IsShellTaskActive = True
    Else
        IsShellTaskActive = False
    End If
    CloseHandle hProcess
End Function

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

Then in your program you can shell your program this way:

Dim ShellID as Variant
ShellID = Shell("ProgB")

then you can check to see if your progb is running by doing this:

if IsShellTaskActive(ShellID) = True then
   'Task is running
else
   'Task is not running
endif


Cheers!

0
 
Dreaming_EagleAuthor Commented:
The routine I'm referring to is from "Visual Basic 5.0
Programmers Guide to the Win32 API" by Dan Appleman.
0
 
Dreaming_EagleAuthor Commented:
The routine I'm referring to is from "Visual Basic 5.0
Programmers Guide to the Win32 API" by Dan Appleman.
0
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.

 
Erick37Commented:
If you are looking to shell an application and wait for it to terminate, here are some code examples:

http://www.thescarms.com/vbasic/Wait.htm
http://vbaccelerator.com/codelib/shell/shelwait.htm
http://www.vb-world.net/tips/tip5.html
0
 
Dreaming_EagleAuthor Commented:
Mcrider, I liked your second approach the best.  Simply using shell then using IsShellActive in a loop as follows:

sTime = time
while IsShellActive(taskHandle)
     doEvents
     if timeout(sTime)
        exit sub
     end if
wend

I added the timeout function just in case the DOS app gets hung on the suggestion of my boss.  If it is still in the while/wend loop after 2 minutes, timeout() returns true.

I like this better than adding all the additional code to the application.  

You've got the points...just wondered if you have any further thoughts.  




0
 
mcriderCommented:
Just remember, when you're in a loop doing a "DoEvents" waiting for the shelled application to terminate... You program's events will still fire.

Make sure that your code doesn't launch the DOS application more than once.

For example, let's say that you launch the looping code by clicking a CommandButton...  Setting the "Enabled" property of the CommandButton to "FALSE" before you enter the loop, and resetting it to "TRUE" after you exit the loop will insure that the user doesn't mistakenly click the button twice and launch 2 copies of the program...  Get the picure??


Cheers!

(Hoping for a "good" grade!)

;-)
0
 
Dreaming_EagleAuthor Commented:
Yes, preventing a second click is an excellent idea and disabling the Send Fax button, in this case, is a good way to do so.  I also think the timeout() is essential in case the Fax utility hangs for some reason.  Of course, you get a good grade, MC, for very good answer.  Thanks.
0
 
mcriderCommented:
Thanks for the points!

Glad I could help.

Cheers!
0
All Courses

From novice to tech pro — start learning today.