I have tried multiple versions of code found by my friend Mr Google to do this. They all run the program but none of them wait until it is closed. They work with notepad.exe though. Any ideas as to why this might be and how I can make VB6 wait?
First of all this doesn't seem to be a question specifically about API programming but rather a vb6 question. Having said that you probably will need to use API functions to do what you want to do. Are you saying that all the examples you found work with Notepad.exe? You can't just copy-paste sample code into your program and expect it to work without any modifications. At the very least you would have to replace the text "Notepad.exe" with something else. "autoleveller-0.8.7.exe" in your case. Could you post an example you found using "Mr Google" that works with Notepad.exe here? I might be able to help you to get it to work.
First of all this doesn't seem to be a question specifically about API programming but rather a vb6 question. Having said that you probably will need to use API functions to do what you want to do. Are you saying that all the examples you found work with Notepad.exe? You can't just copy-paste sample code into your program and expect it to work without any modifications. At the very least you would have to replace the text "Notepad.exe" with something else. "autoleveller-0.8.7.exe" in your case. Could you post an example you found using "Mr Google" that works with Notepad.exe here? I might be able to help you to get it to work.
The line I use to call the autoleveller program and the code for ShellExWait is given below. This runs the autoleveller program but it doesn't wait until autoleveller is closed. The msgbox after the call halts the program until 'OK' is clicked
Code:
Rtn = ShellExWait("c:\users\jim\documents\downloads\profiler\autoleveller\autoleveller-0.8.7.exe", "")
MsgBox "Click 'OK' when finished with Autoleveller", vbInformation + vbOKOnly, "Wait for Autoleveller exit"
Code:
Option Explicit
' This code is licensed according to the terms and conditions listed here.
' Declarations and such needed for the example:
' (Copy them to the (declarations) section of a module.)
Public Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SW_SHOWNORMAL = 1
Public Const SW_MAXIMIZE = &H3
Public Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" (lpExecInfo As _
SHELLEXECUTEINFO) As Long
Public Const SE_ERR_FNF = 2
Public Const SE_ERR_NOASSOC = 31
Public Const SE_ERR_ACCESSDENIED = 5
Public Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal _
dwMilliseconds As Long) As Long
Public Const INFINITE = &HFFFF
Public Const WAIT_TIMEOUT = &H102
Public Function ShellExWait(File As String, Parameter As String) As Boolean
Dim sei As SHELLEXECUTEINFO ' structure used by the function
Dim retval As Long ' return value
If Not FileExists(File) Then
ShellExWait = False
Exit Function
End If
' Load the information needed to open the file into the structure.
With sei
' Size of the structure
.cbSize = Len(sei)
' Use the optional hProcess element of the structure.
.fMask = SEE_MASK_NOCLOSEPROCESS
' Handle to the window calling this function.
.hwnd = frmProfiler.hwnd
' The action to perform: open the file.
.lpVerb = "open"
' The file to open.
.lpFile = File
' No additional parameters are needed here.
.lpParameters = Parameter
' The default directory -- not really necessary in this case.
.lpDirectory = PathOfFile(File)
' Simply display the window.
.nShow = SW_MAXIMIZE
' The other elements of the structure are either not used
' or will be set when the function returns.
End With
' Open the file using its associated program.
retval = ShellExecuteEx(sei)
If retval = 0 Then
' The function failed, so report the error.
' Err.LastDllError could also be used instead, if you wish.
Select Case sei.hInstApp
Case SE_ERR_FNF
Debug.Print "The file was not found."
Case SE_ERR_NOASSOC
Debug.Print "No program is associated with this kind of file."
Case SE_ERR_ACCESSDENIED
Debug.Print "Access denied."
Case Else
Debug.Print "An unexpected error occured."
End Select
ShellExWait = False
Else
' Wait for the opened process to close before continuing. Instead
' of waiting once for a time of INFINITE, this example repeatedly checks to see if the
' is still open. This allows the DoEvents VB function to be called, preventing
' our program from appearing to lock up while it waits.
Do
DoEvents
retval = WaitForSingleObject(sei.hProcess, 0)
Loop While retval = WAIT_TIMEOUT
ShellExWait = True
End If
End Function
I see you posted some code. But at the very least the "FileExists" procedure and form appear to be missing. Could you post the entire project?
Thanks.
OK, but it is quite large spread over several files so I have zipped them up.
Unfortunately I can't post the actual problem exe file because you have to pay to get this file.
I quickly threw this module together using parts of the project you posted:
Code:
Option Explicit
Public Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SW_MAXIMIZE = &H3
Public Const SE_ERR_FNF = 2
Public Const SE_ERR_NOASSOC = 31
Public Const SE_ERR_ACCESSDENIED = 5
Public Const INFINITE = &HFFFF
Public Const WAIT_TIMEOUT = &H102
Public Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" (lpExecInfo As SHELLEXECUTEINFO) As Long
Public Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Function FileExists(ByVal sFileName As String) As Boolean
Dim intReturn As Integer
On Error GoTo FileExists_Error
intReturn = GetAttr(sFileName)
FileExists = True
Exit Function
FileExists_Error:
FileExists = False
End Function
Public Sub Main()
Debug.Print ShellExWait("C:\Windows\System32\Calc.exe", vbNullString)
MsgBox "Done."
Unload Form1
End Sub
Public Function PathOfFile(FileName As String) As String
Dim posn As Integer
posn = InStrRev(FileName, "\")
If posn > 0 Then
PathOfFile = Left$(FileName, posn)
Else
PathOfFile = ""
End If
End Function
Public Function ShellExWait(File As String, Parameter As String) As Boolean
Dim sei As SHELLEXECUTEINFO
Dim retval As Long
If Not FileExists(File) Then
ShellExWait = False
Exit Function
End If
With sei
.cbSize = Len(sei)
.fMask = SEE_MASK_NOCLOSEPROCESS
.hwnd = Form1.hwnd
.lpVerb = "open"
.lpFile = File
.lpParameters = Parameter
.lpDirectory = PathOfFile(File)
.nShow = SW_MAXIMIZE
End With
retval = ShellExecuteEx(sei)
If retval = 0 Then
Select Case sei.hInstApp
Case SE_ERR_FNF
Debug.Print "The file was not found."
Case SE_ERR_NOASSOC
Debug.Print "No program is associated with this kind of file."
Case SE_ERR_ACCESSDENIED
Debug.Print "Access denied."
Case Else
Debug.Print "An unexpected error occured."
End Select
ShellExWait = False
Else
Do
DoEvents
retval = WaitForSingleObject(sei.hProcess, 0)
Loop While retval = WAIT_TIMEOUT
ShellExWait = True
End If
End Function
It opens Windows' calculator program and waits for it to finish. Not included is the form that provides the "hwnd" for the "sei" variable. The program starts at the "Sub Main" procedure.
You might want to clean your project files, the file that is supposed to be called "Global.bas" is called "New Global.bas" and your zip file contained another zip file with the same program. Possibly an older/newer version?
I quickly threw this module together using parts of the project you posted:
It opens Windows' calculator program and waits for it to finish. Not included is the form that provides the "hwnd" for the "sei" variable. The program starts at the "Sub Main" procedure.
You might want to clean your project files, the file that is supposed to be called "Global.bas" is called "New Global.bas" and your zip file contained another zip file with the same program. Possibly an older/newer version?
That project has been through a good few iterations so it is getting messy now.
I started a new project (which includes form1) and added a module and copied your code to that module. I set the startup object to Sub Main. It opens calculator but it doesn't wait for it to be closed. The return value from WaitForSingleObject is zero whether calculator is open or closed.
That project has been through a good few iterations so it is getting messy now.
I started a new project (which includes form1) and added a module and copied your code to that module. I set the startup object to Sub Main. It opens calculator but it doesn't wait for it to be closed. The return value from WaitForSingleObject is zero whether calculator is open or closed.
Try setting the timeout for WaitForSingleObject to -1.
Maybe it has to do with Win10 64bit.
I don't have access to 64bit versions of Windows so I can't test it.
Old post on StackOverflow:
If the function's return value is telling you that the process has terminated, then perhaps it really has.
Suppose the program you start comes with 32-bit and 64-bit versions. Maybe the 32-bit version can detect that it's running on a 64-bit platform, start the 64-bit version of itself, and then terminate the 32-bit version. In that case, your program would detect the termination of the 32-bit child, but it would be oblivious to the 64-bit "grandchild" process.
You can use Task Manager or Process Explorer to confirm this hypothesis. Find the program that's still running. Is its pid the same as the pid that CreateProcess returned to you?
The calculator file is in system32, but task manager shows the running program to be a 64 bit.
The autoleveller program in task manager is shown under the 32 bit java platform so that might be something to do with it as well.
Oh, well, it looks like I will have to settle for the msgbox fudge.
Thanks for your time and effort trying to help me with this.