Bonjour,
Existe-t-il une méthode (idéalement une interface OLE avec évenement
et tout le toutim) pour piloter une fenêtre DOS (cmd.exe sous XP) ?
Je voudrais pouvoir passer des commandes, réagir à leur retour,
récupérer les résultats, etc... avec d'autres moyens que des
solutions barbares genre sendkeys ou API Keyb_event.
D'avance merci.
Bonjour,
Existe-t-il une méthode (idéalement une interface OLE avec évenement
et tout le toutim) pour piloter une fenêtre DOS (cmd.exe sous XP) ?
Je voudrais pouvoir passer des commandes, réagir à leur retour,
récupérer les résultats, etc... avec d'autres moyens que des
solutions barbares genre sendkeys ou API Keyb_event.
D'avance merci.
Bonjour,
Existe-t-il une méthode (idéalement une interface OLE avec évenement
et tout le toutim) pour piloter une fenêtre DOS (cmd.exe sous XP) ?
Je voudrais pouvoir passer des commandes, réagir à leur retour,
récupérer les résultats, etc... avec d'autres moyens que des
solutions barbares genre sendkeys ou API Keyb_event.
D'avance merci.
Hello,
Il est effectivement possible de lire/écrire dans commande une fenêtre de
commandes par le code.
Voici un exemple qui lit ce qui est affiché dans la console. Cet exemple
n'a jamais été terminé, donc il est fort possible qu'il reste des bouts de
codes non optimisés/incorrects/....
'A mettre dans une classe:
Option Explicit
Private Const CREATE_NEW_CONSOLE = &H10
Private Const ERROR_BROKEN_PIPE = 109&
Private Const CREATE_NO_WINDOW = &H8000000
Private Const STARTF_USESTDHANDLES = &H100
Private Const DUPLICATE_SAME_ACCESS = &H2
Private Const INFINITE = &HFFFF ' Infinite timeout
Public Enum Priority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
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 SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreatePipe _
Lib "kernel32" _
( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As SECURITY_ATTRIBUTES, _
ByVal nSize As Long _
) _
As Long
Private Declare Function DuplicateHandle _
Lib "kernel32" _
( _
ByVal hSourceProcessHandle As Long, _
ByVal hSourceHandle As Long, _
ByVal hTargetProcessHandle As Long, _
lpTargetHandle As Long, _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwOptions As Long _
) _
As Long
Private Declare Function CloseHandle _
Lib "kernel32" _
( _
ByVal hObject As Long _
) _
As Long
Private Declare Function GetCurrentProcess _
Lib "kernel32" _
( _
) _
As Long
Private Declare Function CreateProcess _
Lib "kernel32" _
Alias "CreateProcessA" _
( _
ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As Any, _
lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION _
) _
As Long
Private Declare Function ReadFile _
Lib "kernel32" _
( _
ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
lpOverlapped As Any _
) _
As Long
'Private Declare Function GetStdHandle _
' Lib "kernel32" _
' ( _
' ByVal nStdHandle As Long _
' ) _
' As Long
Private Declare Function PeekNamedPipe _
Lib "kernel32" _
( _
ByVal hNamedPipe As Long, _
lpBuffer As Any, _
ByVal nBufferSize As Long, _
lpBytesRead As Long, _
lpTotalBytesAvail As Long, _
lpBytesLeftThisMessage As Long _
) _
As Long
Private Declare Function WaitForSingleObject _
Lib "kernel32" _
( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long _
) _
As Long
'Private Const STD_OUTPUT_HANDLE = -11&
Public Event GotText(strText As String)
Public Event GotError(strText As String)
Public Sub ShellRun(Command As String, Optional WorkingDir As String,
Optional Wait As Boolean = True)
Dim pi As PROCESS_INFORMATION
Dim si As STARTUPINFO
si.cb = Len(si)
CreateProcess vbNullString, Command, ByVal 0&, ByVal 0&, 0, 0, ByVal
0&, WorkingDir, si, pi
If Wait Then
WaitForSingleObject pi.hProcess, INFINITE
CloseHandle pi.hThread
CloseHandle pi.hProcess
End If
End Sub
Public Sub Run(Command As String, Optional WorkingDir As String)
Dim hOutputReadTmp As Long, hOutputRead As Long, hOutputWrite As Long
Dim hErrorReadTmp As Long, hErrorRead As Long, hErrorWrite As Long
Dim hThread As Long
Dim ThreadId As Long
Dim sa As SECURITY_ATTRIBUTES
sa.nLength = Len(sa)
sa.lpSecurityDescriptor = 0
sa.bInheritHandle = 1
If (CreatePipe(hOutputReadTmp, hOutputWrite, sa, 0) = 0) Then
MsgBox "Impossible de créer le pipe out!"
End If
If (CreatePipe(hErrorReadTmp, hErrorWrite, sa, 0) = 0) Then
MsgBox "Impossible de créer le pipe erreur!"
End If
If (DuplicateHandle(GetCurrentProcess, hOutputReadTmp,
GetCurrentProcess, hOutputRead, 0, 0, DUPLICATE_SAME_ACCESS) = 0) Then
MsgBox "Impossible de dupliquer le handle out!"
End If
If (DuplicateHandle(GetCurrentProcess, hErrorReadTmp,
GetCurrentProcess, hErrorRead, 0, 0, DUPLICATE_SAME_ACCESS) = 0) Then
MsgBox "Impossible de dupliquer le handle erreur!"
End If
If (CloseHandle(hOutputReadTmp) = 0) Then MsgBox ("échec de
CloseHandle")
If (CloseHandle(hErrorReadTmp) = 0) Then MsgBox ("échec de
CloseHandle")
Dim pi As PROCESS_INFORMATION
Dim si As STARTUPINFO
si.cb = Len(si)
si.dwFlags = STARTF_USESTDHANDLES
si.hStdOutput = hOutputWrite
si.hStdError = hErrorWrite
If (CreateProcess(vbNullString, Command, _
ByVal 0&, ByVal 0&, 1&, CREATE_NO_WINDOW Or NORMAL_PRIORITY_CLASS,
ByVal 0&, WorkingDir, si, pi) = 0) Then
MsgBox "Impossible de créer le process"
End If
If (CloseHandle(hOutputWrite) = 0) Then MsgBox ("CloseHandle")
If (CloseHandle(hErrorWrite) = 0) Then MsgBox ("CloseHandle")
ReadAndHandleOutput hOutputRead, hErrorRead
If (CloseHandle(hOutputRead) = 0) Then MsgBox ("CloseHandle")
If (CloseHandle(hErrorRead) = 0) Then MsgBox ("CloseHandle")
CloseHandle pi.hThread
CloseHandle pi.hProcess
End Sub
Private Sub ReadAndHandleOutput(hPipeRead As Long, hPipeErrorRead As Long)
Dim lpBuffer As String * 255
Dim nBytesRead As Long
Dim nBytesAvail As Long
Dim nErrBytesAvail As Long
Dim lngRC As Long, lngRCErr As Long
Do
lngRC = PeekNamedPipe(hPipeRead, ByVal 0&, 0, ByVal 0&,
nBytesAvail, ByVal 0&)
lngRCErr = PeekNamedPipe(hPipeErrorRead, ByVal 0&, 0, ByVal 0&,
nErrBytesAvail, ByVal 0&)
Do Until nBytesAvail Or nErrBytesAvail
If lngRC = 0 Or lngRCErr = 0 Then Exit Sub
DoEvents
lngRC = PeekNamedPipe(hPipeRead, ByVal 0&, 0, ByVal 0&,
nBytesAvail, ByVal 0&)
lngRCErr = PeekNamedPipe(hPipeErrorRead, ByVal 0&, 0, ByVal 0&,
nErrBytesAvail, ByVal 0&)
Loop
If lngRC = 0 Then Exit Sub
If nBytesAvail Then
DoEvents
'lpBuffer = String$(lpBuffer, vbNullChar)
If ReadFile(hPipeRead, ByVal lpBuffer, Len(lpBuffer),
nBytesRead, ByVal 0&) = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
If nBytesRead = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
DoEvents
RaiseEvent GotText(VBA.Left$(lpBuffer, nBytesRead))
DoEvents
ElseIf nErrBytesAvail Then
DoEvents
'lpBuffer = String$(lpBuffer, vbNullChar)
If ReadFile(hPipeErrorRead, ByVal lpBuffer, Len(lpBuffer),
nBytesRead, ByVal 0&) = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
If nBytesRead = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
DoEvents
RaiseEvent GotError(VBA.Left$(lpBuffer, nBytesRead))
DoEvents
End If
Loop
End Sub
'Pour l'utiliser:
Private WithEvents Console As CConsoleRun
Private Sub Console_GotText(strText As String)
Debug.Print Texte : strText
End Sub
Private Sub Toto()
Console.Run "toto.exe", "c:toto"
End Sub
On peut employer une autre méthode employant des API plus haut niveau
(AllocConsole, AttachConsole, ...) mais celles ci, si je me souviens bien,
ne permettent pas de savoir quand du texte a été écrit.
--
François Picalausa
"Patrice Ongla" a écrit dans le message de news:
41d4fde3$0$16257$Bonjour,
Existe-t-il une méthode (idéalement une interface OLE avec évenement
et tout le toutim) pour piloter une fenêtre DOS (cmd.exe sous XP) ?
Je voudrais pouvoir passer des commandes, réagir à leur retour,
récupérer les résultats, etc... avec d'autres moyens que des
solutions barbares genre sendkeys ou API Keyb_event.
D'avance merci.
Hello,
Il est effectivement possible de lire/écrire dans commande une fenêtre de
commandes par le code.
Voici un exemple qui lit ce qui est affiché dans la console. Cet exemple
n'a jamais été terminé, donc il est fort possible qu'il reste des bouts de
codes non optimisés/incorrects/....
'A mettre dans une classe:
Option Explicit
Private Const CREATE_NEW_CONSOLE = &H10
Private Const ERROR_BROKEN_PIPE = 109&
Private Const CREATE_NO_WINDOW = &H8000000
Private Const STARTF_USESTDHANDLES = &H100
Private Const DUPLICATE_SAME_ACCESS = &H2
Private Const INFINITE = &HFFFF ' Infinite timeout
Public Enum Priority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
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 SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreatePipe _
Lib "kernel32" _
( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As SECURITY_ATTRIBUTES, _
ByVal nSize As Long _
) _
As Long
Private Declare Function DuplicateHandle _
Lib "kernel32" _
( _
ByVal hSourceProcessHandle As Long, _
ByVal hSourceHandle As Long, _
ByVal hTargetProcessHandle As Long, _
lpTargetHandle As Long, _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwOptions As Long _
) _
As Long
Private Declare Function CloseHandle _
Lib "kernel32" _
( _
ByVal hObject As Long _
) _
As Long
Private Declare Function GetCurrentProcess _
Lib "kernel32" _
( _
) _
As Long
Private Declare Function CreateProcess _
Lib "kernel32" _
Alias "CreateProcessA" _
( _
ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As Any, _
lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION _
) _
As Long
Private Declare Function ReadFile _
Lib "kernel32" _
( _
ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
lpOverlapped As Any _
) _
As Long
'Private Declare Function GetStdHandle _
' Lib "kernel32" _
' ( _
' ByVal nStdHandle As Long _
' ) _
' As Long
Private Declare Function PeekNamedPipe _
Lib "kernel32" _
( _
ByVal hNamedPipe As Long, _
lpBuffer As Any, _
ByVal nBufferSize As Long, _
lpBytesRead As Long, _
lpTotalBytesAvail As Long, _
lpBytesLeftThisMessage As Long _
) _
As Long
Private Declare Function WaitForSingleObject _
Lib "kernel32" _
( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long _
) _
As Long
'Private Const STD_OUTPUT_HANDLE = -11&
Public Event GotText(strText As String)
Public Event GotError(strText As String)
Public Sub ShellRun(Command As String, Optional WorkingDir As String,
Optional Wait As Boolean = True)
Dim pi As PROCESS_INFORMATION
Dim si As STARTUPINFO
si.cb = Len(si)
CreateProcess vbNullString, Command, ByVal 0&, ByVal 0&, 0, 0, ByVal
0&, WorkingDir, si, pi
If Wait Then
WaitForSingleObject pi.hProcess, INFINITE
CloseHandle pi.hThread
CloseHandle pi.hProcess
End If
End Sub
Public Sub Run(Command As String, Optional WorkingDir As String)
Dim hOutputReadTmp As Long, hOutputRead As Long, hOutputWrite As Long
Dim hErrorReadTmp As Long, hErrorRead As Long, hErrorWrite As Long
Dim hThread As Long
Dim ThreadId As Long
Dim sa As SECURITY_ATTRIBUTES
sa.nLength = Len(sa)
sa.lpSecurityDescriptor = 0
sa.bInheritHandle = 1
If (CreatePipe(hOutputReadTmp, hOutputWrite, sa, 0) = 0) Then
MsgBox "Impossible de créer le pipe out!"
End If
If (CreatePipe(hErrorReadTmp, hErrorWrite, sa, 0) = 0) Then
MsgBox "Impossible de créer le pipe erreur!"
End If
If (DuplicateHandle(GetCurrentProcess, hOutputReadTmp,
GetCurrentProcess, hOutputRead, 0, 0, DUPLICATE_SAME_ACCESS) = 0) Then
MsgBox "Impossible de dupliquer le handle out!"
End If
If (DuplicateHandle(GetCurrentProcess, hErrorReadTmp,
GetCurrentProcess, hErrorRead, 0, 0, DUPLICATE_SAME_ACCESS) = 0) Then
MsgBox "Impossible de dupliquer le handle erreur!"
End If
If (CloseHandle(hOutputReadTmp) = 0) Then MsgBox ("échec de
CloseHandle")
If (CloseHandle(hErrorReadTmp) = 0) Then MsgBox ("échec de
CloseHandle")
Dim pi As PROCESS_INFORMATION
Dim si As STARTUPINFO
si.cb = Len(si)
si.dwFlags = STARTF_USESTDHANDLES
si.hStdOutput = hOutputWrite
si.hStdError = hErrorWrite
If (CreateProcess(vbNullString, Command, _
ByVal 0&, ByVal 0&, 1&, CREATE_NO_WINDOW Or NORMAL_PRIORITY_CLASS,
ByVal 0&, WorkingDir, si, pi) = 0) Then
MsgBox "Impossible de créer le process"
End If
If (CloseHandle(hOutputWrite) = 0) Then MsgBox ("CloseHandle")
If (CloseHandle(hErrorWrite) = 0) Then MsgBox ("CloseHandle")
ReadAndHandleOutput hOutputRead, hErrorRead
If (CloseHandle(hOutputRead) = 0) Then MsgBox ("CloseHandle")
If (CloseHandle(hErrorRead) = 0) Then MsgBox ("CloseHandle")
CloseHandle pi.hThread
CloseHandle pi.hProcess
End Sub
Private Sub ReadAndHandleOutput(hPipeRead As Long, hPipeErrorRead As Long)
Dim lpBuffer As String * 255
Dim nBytesRead As Long
Dim nBytesAvail As Long
Dim nErrBytesAvail As Long
Dim lngRC As Long, lngRCErr As Long
Do
lngRC = PeekNamedPipe(hPipeRead, ByVal 0&, 0, ByVal 0&,
nBytesAvail, ByVal 0&)
lngRCErr = PeekNamedPipe(hPipeErrorRead, ByVal 0&, 0, ByVal 0&,
nErrBytesAvail, ByVal 0&)
Do Until nBytesAvail Or nErrBytesAvail
If lngRC = 0 Or lngRCErr = 0 Then Exit Sub
DoEvents
lngRC = PeekNamedPipe(hPipeRead, ByVal 0&, 0, ByVal 0&,
nBytesAvail, ByVal 0&)
lngRCErr = PeekNamedPipe(hPipeErrorRead, ByVal 0&, 0, ByVal 0&,
nErrBytesAvail, ByVal 0&)
Loop
If lngRC = 0 Then Exit Sub
If nBytesAvail Then
DoEvents
'lpBuffer = String$(lpBuffer, vbNullChar)
If ReadFile(hPipeRead, ByVal lpBuffer, Len(lpBuffer),
nBytesRead, ByVal 0&) = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
If nBytesRead = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
DoEvents
RaiseEvent GotText(VBA.Left$(lpBuffer, nBytesRead))
DoEvents
ElseIf nErrBytesAvail Then
DoEvents
'lpBuffer = String$(lpBuffer, vbNullChar)
If ReadFile(hPipeErrorRead, ByVal lpBuffer, Len(lpBuffer),
nBytesRead, ByVal 0&) = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
If nBytesRead = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
DoEvents
RaiseEvent GotError(VBA.Left$(lpBuffer, nBytesRead))
DoEvents
End If
Loop
End Sub
'Pour l'utiliser:
Private WithEvents Console As CConsoleRun
Private Sub Console_GotText(strText As String)
Debug.Print Texte : strText
End Sub
Private Sub Toto()
Console.Run "toto.exe", "c:toto"
End Sub
On peut employer une autre méthode employant des API plus haut niveau
(AllocConsole, AttachConsole, ...) mais celles ci, si je me souviens bien,
ne permettent pas de savoir quand du texte a été écrit.
--
François Picalausa
"Patrice Ongla" <ongla@free.fr> a écrit dans le message de news:
41d4fde3$0$16257$636a15ce@news.free.fr
Bonjour,
Existe-t-il une méthode (idéalement une interface OLE avec évenement
et tout le toutim) pour piloter une fenêtre DOS (cmd.exe sous XP) ?
Je voudrais pouvoir passer des commandes, réagir à leur retour,
récupérer les résultats, etc... avec d'autres moyens que des
solutions barbares genre sendkeys ou API Keyb_event.
D'avance merci.
Hello,
Il est effectivement possible de lire/écrire dans commande une fenêtre de
commandes par le code.
Voici un exemple qui lit ce qui est affiché dans la console. Cet exemple
n'a jamais été terminé, donc il est fort possible qu'il reste des bouts de
codes non optimisés/incorrects/....
'A mettre dans une classe:
Option Explicit
Private Const CREATE_NEW_CONSOLE = &H10
Private Const ERROR_BROKEN_PIPE = 109&
Private Const CREATE_NO_WINDOW = &H8000000
Private Const STARTF_USESTDHANDLES = &H100
Private Const DUPLICATE_SAME_ACCESS = &H2
Private Const INFINITE = &HFFFF ' Infinite timeout
Public Enum Priority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
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 SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreatePipe _
Lib "kernel32" _
( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As SECURITY_ATTRIBUTES, _
ByVal nSize As Long _
) _
As Long
Private Declare Function DuplicateHandle _
Lib "kernel32" _
( _
ByVal hSourceProcessHandle As Long, _
ByVal hSourceHandle As Long, _
ByVal hTargetProcessHandle As Long, _
lpTargetHandle As Long, _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwOptions As Long _
) _
As Long
Private Declare Function CloseHandle _
Lib "kernel32" _
( _
ByVal hObject As Long _
) _
As Long
Private Declare Function GetCurrentProcess _
Lib "kernel32" _
( _
) _
As Long
Private Declare Function CreateProcess _
Lib "kernel32" _
Alias "CreateProcessA" _
( _
ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As Any, _
lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION _
) _
As Long
Private Declare Function ReadFile _
Lib "kernel32" _
( _
ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
lpOverlapped As Any _
) _
As Long
'Private Declare Function GetStdHandle _
' Lib "kernel32" _
' ( _
' ByVal nStdHandle As Long _
' ) _
' As Long
Private Declare Function PeekNamedPipe _
Lib "kernel32" _
( _
ByVal hNamedPipe As Long, _
lpBuffer As Any, _
ByVal nBufferSize As Long, _
lpBytesRead As Long, _
lpTotalBytesAvail As Long, _
lpBytesLeftThisMessage As Long _
) _
As Long
Private Declare Function WaitForSingleObject _
Lib "kernel32" _
( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long _
) _
As Long
'Private Const STD_OUTPUT_HANDLE = -11&
Public Event GotText(strText As String)
Public Event GotError(strText As String)
Public Sub ShellRun(Command As String, Optional WorkingDir As String,
Optional Wait As Boolean = True)
Dim pi As PROCESS_INFORMATION
Dim si As STARTUPINFO
si.cb = Len(si)
CreateProcess vbNullString, Command, ByVal 0&, ByVal 0&, 0, 0, ByVal
0&, WorkingDir, si, pi
If Wait Then
WaitForSingleObject pi.hProcess, INFINITE
CloseHandle pi.hThread
CloseHandle pi.hProcess
End If
End Sub
Public Sub Run(Command As String, Optional WorkingDir As String)
Dim hOutputReadTmp As Long, hOutputRead As Long, hOutputWrite As Long
Dim hErrorReadTmp As Long, hErrorRead As Long, hErrorWrite As Long
Dim hThread As Long
Dim ThreadId As Long
Dim sa As SECURITY_ATTRIBUTES
sa.nLength = Len(sa)
sa.lpSecurityDescriptor = 0
sa.bInheritHandle = 1
If (CreatePipe(hOutputReadTmp, hOutputWrite, sa, 0) = 0) Then
MsgBox "Impossible de créer le pipe out!"
End If
If (CreatePipe(hErrorReadTmp, hErrorWrite, sa, 0) = 0) Then
MsgBox "Impossible de créer le pipe erreur!"
End If
If (DuplicateHandle(GetCurrentProcess, hOutputReadTmp,
GetCurrentProcess, hOutputRead, 0, 0, DUPLICATE_SAME_ACCESS) = 0) Then
MsgBox "Impossible de dupliquer le handle out!"
End If
If (DuplicateHandle(GetCurrentProcess, hErrorReadTmp,
GetCurrentProcess, hErrorRead, 0, 0, DUPLICATE_SAME_ACCESS) = 0) Then
MsgBox "Impossible de dupliquer le handle erreur!"
End If
If (CloseHandle(hOutputReadTmp) = 0) Then MsgBox ("échec de
CloseHandle")
If (CloseHandle(hErrorReadTmp) = 0) Then MsgBox ("échec de
CloseHandle")
Dim pi As PROCESS_INFORMATION
Dim si As STARTUPINFO
si.cb = Len(si)
si.dwFlags = STARTF_USESTDHANDLES
si.hStdOutput = hOutputWrite
si.hStdError = hErrorWrite
If (CreateProcess(vbNullString, Command, _
ByVal 0&, ByVal 0&, 1&, CREATE_NO_WINDOW Or NORMAL_PRIORITY_CLASS,
ByVal 0&, WorkingDir, si, pi) = 0) Then
MsgBox "Impossible de créer le process"
End If
If (CloseHandle(hOutputWrite) = 0) Then MsgBox ("CloseHandle")
If (CloseHandle(hErrorWrite) = 0) Then MsgBox ("CloseHandle")
ReadAndHandleOutput hOutputRead, hErrorRead
If (CloseHandle(hOutputRead) = 0) Then MsgBox ("CloseHandle")
If (CloseHandle(hErrorRead) = 0) Then MsgBox ("CloseHandle")
CloseHandle pi.hThread
CloseHandle pi.hProcess
End Sub
Private Sub ReadAndHandleOutput(hPipeRead As Long, hPipeErrorRead As Long)
Dim lpBuffer As String * 255
Dim nBytesRead As Long
Dim nBytesAvail As Long
Dim nErrBytesAvail As Long
Dim lngRC As Long, lngRCErr As Long
Do
lngRC = PeekNamedPipe(hPipeRead, ByVal 0&, 0, ByVal 0&,
nBytesAvail, ByVal 0&)
lngRCErr = PeekNamedPipe(hPipeErrorRead, ByVal 0&, 0, ByVal 0&,
nErrBytesAvail, ByVal 0&)
Do Until nBytesAvail Or nErrBytesAvail
If lngRC = 0 Or lngRCErr = 0 Then Exit Sub
DoEvents
lngRC = PeekNamedPipe(hPipeRead, ByVal 0&, 0, ByVal 0&,
nBytesAvail, ByVal 0&)
lngRCErr = PeekNamedPipe(hPipeErrorRead, ByVal 0&, 0, ByVal 0&,
nErrBytesAvail, ByVal 0&)
Loop
If lngRC = 0 Then Exit Sub
If nBytesAvail Then
DoEvents
'lpBuffer = String$(lpBuffer, vbNullChar)
If ReadFile(hPipeRead, ByVal lpBuffer, Len(lpBuffer),
nBytesRead, ByVal 0&) = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
If nBytesRead = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
DoEvents
RaiseEvent GotText(VBA.Left$(lpBuffer, nBytesRead))
DoEvents
ElseIf nErrBytesAvail Then
DoEvents
'lpBuffer = String$(lpBuffer, vbNullChar)
If ReadFile(hPipeErrorRead, ByVal lpBuffer, Len(lpBuffer),
nBytesRead, ByVal 0&) = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
If nBytesRead = 0 Then
If Err.LastDllError = ERROR_BROKEN_PIPE Then
Exit Sub
Else
MsgBox "Erreur à la lecture!"
Exit Sub
End If
End If
DoEvents
RaiseEvent GotError(VBA.Left$(lpBuffer, nBytesRead))
DoEvents
End If
Loop
End Sub
'Pour l'utiliser:
Private WithEvents Console As CConsoleRun
Private Sub Console_GotText(strText As String)
Debug.Print Texte : strText
End Sub
Private Sub Toto()
Console.Run "toto.exe", "c:toto"
End Sub
On peut employer une autre méthode employant des API plus haut niveau
(AllocConsole, AttachConsole, ...) mais celles ci, si je me souviens bien,
ne permettent pas de savoir quand du texte a été écrit.
--
François Picalausa
"Patrice Ongla" a écrit dans le message de news:
41d4fde3$0$16257$Bonjour,
Existe-t-il une méthode (idéalement une interface OLE avec évenement
et tout le toutim) pour piloter une fenêtre DOS (cmd.exe sous XP) ?
Je voudrais pouvoir passer des commandes, réagir à leur retour,
récupérer les résultats, etc... avec d'autres moyens que des
solutions barbares genre sendkeys ou API Keyb_event.
D'avance merci.
