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 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
| '--------------------------------------------------------------------------
' Convert to unicode.
' For french language (for example), the text returned by ExecCommandShell
' should be converted to unicode with correct code page to be correct (with accent).
'
' Parameters :
'-------------
' strTextToConvert : Text to convert to unicode
'
' Return :
'---------
' The text converted into unicode string.
'
'--------------------------------------------------------------------------
Function ConvertToUnicode(strTextToConvert)
ConvertToUnicode=g_objConv.ToUnicode(strTextToConvert,g_CodePage)
End Function
' Converter to Unicode (global variable) - Initialisation
Dim g_objConv,g_CodePage
InitCodePage() ' Initialize converter to unicode (make only once)
Sub InitCodePage()
Set g_objConv=CreateObject("OlePrn.OleCvt") ' Converter
g_CodePage=Split(CreateObject("WScript.Shell").Exec("cmd /c chcp").StdOut.ReadAll,":")(1) ' Get Code Page
End Sub
'--------------------------------------------------------------------------
' Execute a shell command.
' Wait the end of command and get the stdout / stderr output.
'
' Parameters :
'-------------
' strCommand : Commande to execute
' objShell : Shell created with CreateObject("WScript.Shell")
' strStdOut : String that will receive Std Out output. If Null, this parameter is ignored.
' strStdErr : String that will receive Std Err output. If Null, this parameter is ignored.
'
' Return :
'---------
' The return value of executed program (generally 0 if all is good).
'
'--------------------------------------------------------------------------
Function ExecCommandShell(strCommand,objShell,strStdOut,strStdErr)
Dim objExec ' Objet permettant de contrôler l'exécution
' Initialiser le StdOut à chaîne vide
If VarType(strStdOut)=vbString Then
strStdOut = ""
End If
' Initialiser le StdErr à chaîne vide
If VarType(strStdErr)=vbString Then
strStdErr = ""
End If
strCommand = strCommand
On Error Resume Next
Set objExec = objShell.Exec(strCommand) ' objExec est de type WshScriptExec
If Err.Number <> 0 Then
' Si la commande n'a pas pu être lancée
ExecCommandShell = Err.Number
If VarType(strStdErr)=vbString Then
strStdErr = Err.Description
End If
On Error Goto 0
Call Err.Clear()
Else
On Error Goto 0
Dim iStatus
Do
Call WScript.Sleep(10) ' Attendre la fin
iStatus = objExec.Status
If VarType(strStdOut)=vbString And Not objExec.StdOut.AtEndOfStream Then
' Lire la sortie standard
strStdOut = strStdOut & objExec.StdOut.ReadAll
End If
If VarType(strStdErr)=vbString And Not objExec.StdErr.AtEndOfStream Then
' Lire la sortie d'erreur
strStdErr = strStdErr & objExec.StdErr.ReadAll
End If
Loop While iStatus = 0 ' => Vaut 1 quand terminé, 0 indique qu'il est en cours
ExecCommandShell = objExec.ExitCode
End If
' Convert to unicode
If VarType(strStdOut)=vbString Then
strStdOut = ConvertToUnicode(strStdOut)
End If
' Convert to unicode
If VarType(strStdErr)=vbString Then
strStdErr = ConvertToUnicode(strStdErr)
End If
Set objExec = Nothing
End Function
'--------------------------------------------------------------------------
' Exécuter une commande.
' Permet d'attendre la fin de la commande et de récupérer en sortie
' le StdErr.
'
' Paramètres :
'-------------
' strCommand : Commande à exécuter
' strStdOut : Chaine de caractère qui va recevoir le Std Out, si vaut Null, ce paramètre est ignoré
' strStdErr : Chaine de caractère qui va recevoir le Std Erreur, si vaut Null, ce paramètre est ignoré
'
' Retour :
'---------
' La valeur de retour de l'exécution du programme (0 en général si
' tout s'est bien passé)
'
'--------------------------------------------------------------------------
Function ExecCommand(strCommand,strStdOut,strStdErr)
ExecCommand = ExecCommandShell(strCommand,CreateObject("WScript.Shell"),strStdOut,strStdErr)
End Function |
Partager