Pb redirection stdout dans VB d'un script SHELL ( via cygwin )

elegardien Messages postés 18 Date d'inscription lundi 9 mai 2005 Statut Membre Dernière intervention 20 janvier 2006 - 2 juin 2005 à 07:47
elegardien Messages postés 18 Date d'inscription lundi 9 mai 2005 Statut Membre Dernière intervention 20 janvier 2006 - 2 juin 2005 à 09:00
Bonjour,

J'ai mixé le code d'un lancement externe d'application via VB auquel j'ia ajouté une redirection de la sortie standar du lancement externe vers VB.

Il marche quand il s'agit du lancement d'un .bat mais il plante quant le .bat lance un SHELL via cygwin. En revanche, un lancement sans redirection de la sortie standar du shell vers VB fonctionne.

Est-ce possible de rediriger la sortie standard d'un shell vers VB ?

Ci-dessous mon code:

'================================='
' Défintion des types de variables '
'================================='
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type


Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
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


'================================='
' des constantes '
'================================='
Public Const STILL_ACTIVE& = &H103&
Private Const INFINITE = &HFFFF
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const PROCESS_ALL_ACCESS& = &H1F0FFF



'================================='
' Procédures et fonctions VBA '
'================================='
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


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


Private Declare Function ReadFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long


Private Declare Function GetFileSize Lib "kernel32" (ByVal _
hFile As Long, lpFileSizeHigh As Long) As Long


Private Declare Function CreatePipe Lib "kernel32" ( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long


Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, _
lpProcessAttributes As Any, lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As Any, lpProcessInformation As Any) As Long


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

'================================='
' Décalration des variables '
'================================='
Dim proc As PROCESS_INFORMATION
Dim sa As SECURITY_ATTRIBUTES
Dim start As STARTUPINFO
Dim hReadPipe As Long
Dim hWritePipe As Long

'================================='
' Procédures et fonctions '
'================================='
Public Function LaunchCmd(cmdline$) As Long


Dim ret As Long


sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&


ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "CreatePipe failed. Error: " & Err.LastDllError
End If


start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES
start.hStdOutput = hWritePipe



ret& = CreateProcessA(0&, cmdline, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)


If ret <> 1 Then
MsgBox "CreateProcess failed. Error: " & Err.LastDllError
End If


LaunchCmd = ret


End Function



Public Function RunCmd() As Long


Dim ret As Long
Dim StdOut As String


StdOut = String(256, Chr$(32))


GetExitCodeProcess proc.hProcess, lExitCode
nSize = GetFileSize(hReadPipe, 0)
bSuccess = ReadFile(hReadPipe, StdOut, nSize, bytesread, 0&)
If bSuccess <> 1 Then
MsgBox "ReadFile StdOut failed. Error: "
Else
Call StdOut_Put(StdOut)
End If


RunCmd = lExitCode


End Function



Public Function CloseCmd() As Long


Dim ret As Long


ret& = CloseHandle(proc.hProcess)
ret& = CloseHandle(proc.hThread)
ret& = CloseHandle(hReadPipe)
ret& = CloseHandle(hWritePipe)


CloseCmd = ret


End Function

'================================='
' UserForm '
'================================='
Private Sub CommandButton_LanceExec_Click()

Dim Log as String
Dim ret as Long

lExitCode = STILL_ACTIVE&
ret = LaunchCmd("c:\RUN_SHELL.bat")
Do While lExitCode = STILL_ACTIVE&
lExitCode = RunCmd
Log = Log & StdOut_Get()
TextBox_StdOut.Value = Log
Loop

End Sub


La prise du fort VBA.
Eric.

1 réponse

elegardien Messages postés 18 Date d'inscription lundi 9 mai 2005 Statut Membre Dernière intervention 20 janvier 2006
2 juin 2005 à 09:00
Sleep(500) après ret = LaunchCmd("c:\RUN_SHELL.bat") qui crée le lancement de l'applicatin externe prend un certain temps d'autant plus long que le .bat lançait le shell. Le RunCmd qui lit la sortie du pipe arrivait donc avant que la fin du lancement soit à son terme.


La prise du fort VBA.
Eric.
0
Rejoignez-nous