[vb6 & API] ShellExecuteEx

zMatteo

2003-09-10 17:10:42 UTC

In un modulo ho il seguente codice che usa l'API ShellExecuteEx per lanciare
un exe con parametri.
La mia chiamata è:
Call Launch("c:\pippo.exe", "/a=2002", LC_OPEN, SW_HIDE, False, True)
L'eseguibile viene chiamato correttamente, ma non riesco ad attendere la
fine del processo.
Vorrei infatti che l'esecuzione della procedura Launch attendesse la fine
dell'esecuzione di pippo.exe, ma questo non avviene.
Credo che il problema stia nell'istruzione RetVal = ShellExecuteEx(sei) la
quale imposta il valore 0 (zero) in sei.hProcess e quindi il ciclo di attesa
non attende.........

Spero di essermi spiegato, grazie ancora!!

Modulo di lancio:
------------------------------------

Option Explicit

Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
'0x00000001 (SEE_MASK_CLASSNAME) lpClass
'0x00000003 (SEE_MASK_CLASSKEY) hkeyClass
'0x00000004 (SEE_MASK_IDLIST) lpIDList
'0x0000000c (SEE_MASK_INVOKEIDLIST)
'0x00000010 (SEE_MASK_ICON) hIcon
'0x00000020 (SEE_MASK_HOTKEY) dwHotKey
'0x00000040 (SEE_MASK_NOCLOSEPROCESS)
'0x00000080 (SEE_MASK_CONNECTNETDRV) lpName
'0x00000100 (SEE_MASK_FLAG_DDEWAIT) DDE
'0x00000200 (SEE_MASK_DOENVSUBST) lpDirectory
'0x00000400 (SEE_MASK_FLAG_NO_UI)
'0x00004000 (SEE_MASK_UNICODE) Unicode
'0x00008000 (SEE_MASK_NO_CONSOLE)
'0x00200000 (SEE_MASK_HMONITOR)
'0x04000000 (SEE_MASK_FLAG_LOG_USAGE)
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
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_NO_CONSOLE = &H8000
Private Const SEE_MASK_CLASSKEY = &H3
Private Const SEE_MASK_IDLIST = &H4
Private Const SEE_MASK_CLASSNAME = &H1
Private Const SEE_MASK_INVOKEIDLIST = &HC

Private Declare Function ShellExecuteEx Lib "shell32.dll" Alias
"ShellExecuteExA" (lpExecInfo As SHELLEXECUTEINFO) As Long
Private Const SE_ERR_FNF = 2&
Private Const SE_ERR_PNF = 3&
Private Const SE_ERR_ACCESSDENIED = 5&
Private Const SE_ERR_OOM = 8&
Private Const SE_ERR_DLLNOTFOUND = 32&
Private Const SE_ERR_SHARE = 26&
Private Const SE_ERR_ASSOCINCOMPLETE = 27&
Private Const SE_ERR_DDETIMEOUT = 28&
Private Const SE_ERR_DDEFAIL = 29&
Private Const SE_ERR_DDEBUSY = 30&
Private Const SE_ERR_NOASSOC = 31&
Private Const ERROR_BAD_FORMAT = 11&

Public Enum LauncherDisplayMode
SW_HIDE = 0
SW_SHOWNORMAL = 1
SW_SHOWMINIMIZED = 2
SW_SHOWMAXIMIZED = 3
SW_SHOW = 5
SW_MINIMIZE = 6
SW_SHOWMINNOACTIVE = 7
SW_SHOWNA = 8
SW_RESTORE = 9
SW_SHOWDEFAULT = 10
End Enum

Public Enum LauncherCommand
LC_OPEN = 0
LC_EDIT = 1
LC_PRINT = 2
LC_PROPERTIES = 3
End Enum

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal
hHandle As Long, ByVal _
dwMilliseconds As Long) As Long
Const INFINITE = &HFFFF
Const WAIT_TIMEOUT = &H102

Public Function Launch(FileName As String, FileOptions As String, COMMAND As
LauncherCommand, DisplayMode As LauncherDisplayMode, ShowMessageError As
Boolean, Optional WaitEndOfProces As Boolean = False) As Boolean
'
' Valori possibili per sCommand:
'
' - "open"
' - "print"
' - "properties"
'
'-- lancia un'applicazione e restituisce un booleano che indica la
' riuscita dell'operazione --
'-- in caso di errore visualizza il relativo messaggio se ShowError è
True --

Dim sei As SHELLEXECUTEINFO
Dim RetVal As Long

With sei
.cbSize = Len(sei)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or
SEE_MASK_NO_CONSOLE
.hwnd = GetDesktopWindow()
Select Case COMMAND
Case LC_OPEN: .lpVerb = "OPEN"
Case LC_EDIT: .lpVerb = "EDIT"
Case LC_PRINT: .lpVerb = "PRINT"
Case LC_PROPERTIES: .lpVerb = "PROPERTIES"
Case Else: .lpVerb = "OPEN"
End Select
.lpFile = FileName
.lpParameters = FileOptions
.lpDirectory = ""
.nShow = DisplayMode
End With

' Open the file using its associated program.
RetVal = ShellExecuteEx(sei)
Launch = (RetVal <> 0)
If RetVal = 0 Then
' The function failed, so report the error. Err.LastDllError
' could also be used instead, if you wish.
Dim msg As String
Select Case sei.hInstApp
Case SE_ERR_FNF: msg = "File not found"
Case SE_ERR_PNF: msg = "Path not found"
Case SE_ERR_ACCESSDENIED: msg = "Access denied"
Case SE_ERR_OOM: msg = "Out of memory"
Case SE_ERR_DLLNOTFOUND: msg = "DLL not found"
Case SE_ERR_SHARE: msg = "A sharing violation occurred"
Case SE_ERR_ASSOCINCOMPLETE: msg = "Incomplete or invalid file
association"
Case SE_ERR_DDETIMEOUT: msg = "DDE Time out"
Case SE_ERR_DDEFAIL: msg = "DDE transaction failed"
Case SE_ERR_DDEBUSY: msg = "DDE busy"
Case SE_ERR_NOASSOC: msg = "No association for file extension"
Case ERROR_BAD_FORMAT: msg = "Invalid EXE file or error in EXE image"
Case Else: msg = "Unknown error"
End Select
If ShowMessageError Then MsgBox "Errore " & sei.hInstApp & ": " & msg,
vbOKOnly + vbExclamation
Else
If WaitEndOfProces Then
'--- attesa ---
' 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
End If
End If

End Function

--
.oOo.oOo.oOo.oOo.oOo.oOo.oOo.oOo.oOo
zMatteo
.oOo.oOo.oOo.oOo.oOo.oOo.oOo.oOo.oOo

AntiSpam: rimuovere i ^ dall'indirizzo di e-mail