Discussion :

[Efpoint]

Bonjour,

J'ai une appli VB6 qui fait appel à des programmes lancés sous DOS.
Comme les résultats des programmes DOS sont nécessaires au déroulement de l'appli VB, j'utilise CreateProcess pour lancer la commande DOS.

Dans ce contexte, comment fait-on pour que la fenêtre DOS reste en arrière-plan ?

Merci d'avance.

[Efpoint]

Bonjour,

A force de recherches (laborieuses) sur le web, j'ai fini par résoudre mon problème. Des fois que ça puisse en aider d'autre, je poste une solution ici.

C'est la première fois que je dois faire autre chose que juste faire un copier-coller avec des API, alors je ne promets pas que ce soit parfait, mais chez moi, ça marche !

Je reprend donc le code de la rubrique "Comment lancer un exécutable et reprendre la main quand il a fini ?" de la FAQ VB en rajoutant en rouge les lignes à ajouter pour que la fenêtre se lance en arrière plan :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
                                      (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
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

'Type pour gérer les lancements de processus
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

'Info sur un processus
Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Public Const NORMAL_PRIORITY_CLASS = &H20&
Public Const STILL_ACTIVE = &H103&
Public Const STARTF_USESHOWWINDOW = &H1
Public Const SW_HIDE = 0

Public Sub AttendreFinProcess(proc As PROCESS_INFORMATION, Optional timeout As Long = 60)

Dim Ret As Long
Dim tms As Single
Dim exitcode As Long
   
'Attendre la fin de la commande
tms = Timer
Ret = GetExitCodeProcess(proc.hProcess, exitcode)
Do While Ret <> 0 And exitcode = STILL_ACTIVE
    Ret = GetExitCodeProcess(proc.hProcess, exitcode)
    DoEvents
    Sleep 100
    If Timer - tms > timeout Then
        Err.Raise STILL_ACTIVE, "AttendreFinProcess", "Timeout sur l'attente de la fin d'un process"
    End If
Loop
If Ret = 0 Then
    Err.Raise Err.LastDllError, "AttendreFinProcess", "Erreur systeme N° " & Err.LastDllError
End If

End Sub

Public Sub LancerProcess(sExe As String, proc As PROCESS_INFORMATION)

Dim start As STARTUPINFO
Dim Ret As Long
   
'StartupInfo pour le processus qui lancera la commande
start.cb = Len(start)
start.dwFlags = STARTF_USESHOWWINDOW
start.wShowWindow = SW_HIDE
'Lancement de la commande
Ret& = CreateProcess(0&, sExe, 0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, 0, start, proc)
If Ret = 0 Then
    Err.Raise Err.LastDllError, "LancerProcess", "Erreur systeme N° " & Err.LastDllError
End If
   
End Sub

A+

Efpoint