l'objet WScript.Shell et son exécution

Version imprimable

Bonjour tlm,

Me revoilà en train de trimer sur mon appli VB6... :aie: :marteau:

Je cherche une solution à ce problème:
Dans l'appli que je reprend, une commande DOS est lancé avec l'objet WScript.Shell. Voici le code:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Dim oShell As Object Dim oShellLink As Object Dim sExe As String Set oShell = CreateObject("WScript.Shell") Set oShellLink = oShell.CreateShortcut(sTempPath & "extractor.lnk") oShellLink.targetpath = sPath & "\" & PATH_TO_EXE oShellLink.WorkingDirectory = sTempPath oShellLink.Save Set oShellLink = Nothing If Right$(Environ("comspec"), 7) = "cmd.exe" Then sExe = Environ("comspec") & " /C " & Chr(34) & sTempPath & "extractor.lnk" & Chr(34) Else sExe = Environ("comspec") & " /C start /m " & Chr(34) & sTempPath & "extractor.lnk" & Chr(34) End If oShell.Run sExe, 0, True 'Wait for 100ms subDelay 100 'If FILE_OUT is not yet created, wait 2s If Not funFileExist(sTempPath & FILE_OUT) Then subDelay 2000 End If Set oShell = Nothing
La commande lancée doit créer un fichier texte contenant les valeurs extraites par l'exe.
Ce qui me chiffone et -je pense- provoque une erreur 70 (pb d'accès au fichier), c'est que l'appli regarde après 100ms si le fichier existe.
S'il est absent, on attend 2 secondes et on repart.
:?
Je pense que le fichier est encore ouvert en écriture et
que c'est pour cela que je reçoit une erreur 70 dans la tronche.
Toutes les variables et chemins sont valides, j'ai vérifié pas à pas.
Donc il me semble que le fichier out est créé mais que l'appli lit trop tôt dedans.
Je me tourne donc vers vous pour savoir s'il est possible de "suivre" l'exécution de ma commande ?? :hola:

Merci d'avance.
Bonne journée

bonjour
Moi, j'ai adopté cette solution pour metriser une commande dos.

Code:

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
Private Sub Command1_Click()
Label2 = "": NumFichier = FreeFile
'1° etape, création du fichier .bat (TextPing entrée par l'utilisateur)
Open "c:\Pingeur.bat" For Output As NumFichier 'ouverture du fichier en ecriture
 Print #NumFichier, "ping " & CStr(TextPing) & " > c:\Zresult.txt" ' Écrit le texte.
Close #NumFichier ' Ferme le fichier.
DoEvents
 
'exemple "ping 192.168.0.2 > c:\Zresult.txt"
Label2 = "lancement du fichier .bat": FenetrE = False
ShL = Shell("c:\Pingeur.bat", vbMinimizedFocus)
DoEvents
 
'1° boucle d'attente du demarage du fichier .bat
Do While FenetrE = False
 On Error Resume Next
 AppActivate ShL
 If Err <> 0 Then
  Err.Clear
  Else 'la fenetre DOS du fichier .bat est en cour
  FenetrE = True ': Exit Do
 End If
 DoEvents
Loop
 
'2° boucle d'attente de la fin de l'execution du fichier .bat
Label2 = "fichier .bat en cour"
Do While FenetrE = True
 On Error Resume Next
 AppActivate ShL
 If Err <> 0 Then 'la fenetre DOS n'existe plus, donc le fichier .bat est fini
  Err.Clear: Exit Do
 End If
 DoEvents
Loop
 
'2° ouverture du fichier contenant l'infos généré par le fichier .bat
Label2 = "Analyse": Chaine$ = "": NumFichier = FreeFile
Open "c:\Zresult.txt" For Input As NumFichier
 Do While Not EOF(NumFichier)
  Chaine$ = Chaine$ & Input(1, #NumFichier) 'lit et mémorise le texte.
 Loop
Close #NumFichier ' Ferme le fichier.
 
'3° analyse du fichier contenu dans la variable Chaine$
If InStr(1, Chaine$, "perte 100%") Then
 Label2 = "Connection non possible" 'perte 100%
 Else
 Label2 = "Connection possible"
End If
End Sub

Je construit un .bat qui contient les commandes voulues, je le lance avec la fonction Shell, une premiere boucle attent que le .bat soit en cour, une autre boucle pour attendre la fin du .bat, puis je recupere le resultat dans le fichier Zresult.txt
Une solution que je pense appliquable à ton besoin

Ok merci pour ta réponse.
Cependant je préfère ne pas modifier trop de code, vu que ce déboggage n'est pas prévu dans mes actions en cours (procédure oblige ;) ). De plus, j'ai une légère charge de boulot qui m'attend, genre => :bug:
J'ai donc fait une fonction qui essaye d'ouvrir un fichier en lecture-écriture, avec un gestionnaire d'erreur qui renvoit 'False' qqsoit l'erreur.
Ensuite, j'appelle cette fonction dans une boucle tant qu'elle renvoit 'False'. J'ai limité le risque de deadlock en mettant un compteur de boucles.
Voici la fonction:
Code:

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 Public Function funFileAccess(sFullFileName As String) As Boolean Const BUFFER_LEN As Integer = 32767 Dim iNum As Integer 'Vérifie le nom de fichier If Len(sFullFileName) = 0 Then funFileAccess = False Exit Function End If On Error GoTo funFileAccess_Handler 'Get a free file number iNum = FreeFile 'Tentative d'ouverture du fichier Open sFullFileName For Append Access Read Write Lock Read Write As iNum Len = BUFFER_LEN Close #iNum 'Ouverture réussie, on renvoit True funFileAccess = True Exit Function funFileAccess_Handler: 'Ouverture échouée, on renvoit False funFileAccess = False End Function
Ensuite, je l'utilise comme ceci:
Code:

1 2 3 4 5 6 7 Dim lTries As Long lTries = 0 'Test sur le fichier sFileName au plus 20 fois et attente de 500ms si pas prêt Do While Not funFileAccess(sFileName) And lTries < 20 lTries = lTries + 1 subDelay 500 Loop
Testé et apparemment ça fonctionne correctement.
Le plus bizarre, c'est que ce problème d'accès ne survient que chez moi, un collègue travaillant sur le même projet n'a pas ce problème.

Merci encore et bonne journée à toutes et à tous