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
| Option Explicit
Dim ws,MyApplication,MyProcess,LOG_FILE_PATH,LogFile
Set ws = CreateObject("WScript.Shell")
LogFile = Left(Wscript.ScriptName,InstrRev(Wscript.ScriptName, ".")) & "log"
LOG_FILE_PATH = ws.ExpandEnvironmentStrings("%AppData%") & "\" & LogFile
MyApplication = "%Programfiles%\WinRAR\WinRAR.exe"
MyProcess = "WinRAR.exe"
Do
'vérifions si le processus ne fonctionne pas,alors on l'exécute
If Not CheckProcess(MyProcess) Then
Call Log(LOG_FILE_PATH,String(10,"*") & Now & String(10,"*") & vbCrLf & "Lancement du Processus : "& DblQuote(MyProcess) & vbCrLf & String(70,"*"))
Call Executer(DblQuote(MyApplication),0)'0 to Hide the console
'On fait 10 minutes de pause et on continue dans notre boucle pour vérifier
'si notre processus existe ou non (dans notre cas = WinRAR.exe)
Pause(10) 'pause de 10 minutes
End if
Loop
'***********************************************************************************************
Function CheckProcess(MyProcess)
Dim strComputer,objWMIService,colProcessList
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select Name from Win32_Process WHERE Name LIKE '" & MyProcess & "%'")
If colProcessList.count > 0 then
CheckProcess = MyProcess & " is running"
CheckProcess = True
else
CheckProcess = MyProcess & " is not running"
CheckProcess = False
End if
Set objWMIService = Nothing
Set colProcessList = Nothing
End Function
'***********************************************************************************************
Sub Pause(NMins)
Wscript.Sleep(NMins*1000*60)
End Sub
'***********************************************************************************************
Function Executer(StrCmd,Console)
Dim ws,MyCmd,Resultat
Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
If Console = 0 Then
MyCmd = "CMD /C " & StrCmd & " "
Resultat = ws.run(MyCmd,Console,False)
If Resultat = 0 Then
Else
MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
End If
End If
'La valeur 1 pour montrer la console MS-DOS
If Console = 1 Then
MyCmd = "CMD /K " & StrCmd & " "
Resultat = ws.run(MyCmd,Console,False)
If Resultat = 0 Then
Else
MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
End If
End If
Executer = Resultat
End Function
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Log(strLogFilePath,strLogContent)
Const APPEND = 8
Dim objFso,objLogFile
Set objFso = CreateObject("Scripting.FileSystemObject")
If Not objFso.FileExists(strLogFilePath) Then objFso.CreateTextFile(strLogFilePath, True).Close
Set objLogFile = objFso.OpenTextFile(strLogFilePath,APPEND)
objLogFile.WriteLine strLogContent
objLogFile.Close
End Sub
'********************************************************************************************** |
Partager