hackoo

[VBS] Hackoo VIRUS Cleaner.vbs

May 23rd, 2014
350
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2. '************************************************************************************************************************
  3. 'VBScript pour arrêter et supprimer les traces du Virus de type VBS dans la BDR crée le 19/05/2014
  4. 'Mise à jour le 20/05/2014
  5. '=> Ajout de la liste des processus et les tâches planifiés et aussi les valeurs du Winlogon de la BDR dans le LogFile
  6. 'Mise à jour le 23/05/2014
  7. '=> Ajout de la WaitingBar en HTA et création du dossier Quarantaine pour y déplacer dans ce dernier les fichiers suspects
  8. '************************************************************************************************************************
  9. Dim Titre,TitreWaitBar,Copyright,Cle1,Cle2,Cle3,Cle4,oExec,i,MsgAttente
  10. Dim ws,fso,Temp,MyDoc,bf,DossierRapport,Source,NomFichierLog,OutPut,Quarantaine
  11. Titre = " Traces du Virus de type VBS "
  12. Copyright = "© Hackoo © 2014"
  13. Cle1 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run"
  14. Cle2 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices"
  15. Cle3 = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run"
  16. Cle4 = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\RunServices"
  17. Set ws = CreateObject("wscript.Shell")
  18. Set fso = CreateObject("Scripting.FileSystemObject")
  19. Temp = ws.ExpandEnvironmentStrings("%Temp%")
  20. MyDoc = ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
  21. Set bf = fso.GetFolder(MyDoc)
  22. DossierRapport  = "Rapport_VBSRegCleaner"
  23. Source = MyDoc & "\" & DossierRapport
  24. Quarantaine = "Quarantaine"
  25. Call CreateFolder(bf,DossierRapport)
  26. Set bf = fso.GetFolder(Source)
  27. Call CreateFolder(bf,Quarantaine)
  28. NomFichierLog = "RapportScanVBSRegCleaner_"& Day(Now) & "_" & Month(Now) & "_" & Year(Now) & "-" & Hour(Now) & "-" & Minute(Now) &".txt"
  29. Set OutPut = fso.CreateTextFile(Source & "\" & NomFichierLog,2,-1)
  30. TitreWaitBar = Titre & Copyright
  31. MsgAttente = "Veuillez patienter ... Le Scan du Virus de type VBS est en cours ... "
  32. Call CreateProgressBar(TitreWaitBar,MsgAttente)
  33. Call LancerProgressBar()
  34. Call Pause(10)
  35. If FindScript("wscript.exe") = False Then
  36.     ws.popup "Il n'y a aucune instance de " & DblQuote("Wscript.exe") & " trouvée pour le moment !","3",Titre+Copyright,VbInformation
  37. End If
  38. Call ListProcessCmdLine()
  39. Call ListTachesPlanifies()
  40. Call WinLogon()
  41. Call FermerProgressBar()
  42. Call Explorer(DblQuote(Source & "\" & NomFichierLog))
  43. '**********************************************************************************
  44. Sub CreateFolder(bf,name)
  45.     Set fso  = CreateObject("Scripting.FileSystemObject")
  46.     If Not FSO.FolderExists(bf & "\" & name) Then
  47.         bf.subFolders.Add(name)
  48.         Else : Exit Sub
  49.     End If
  50. End Sub
  51. '**********************************************************************************
  52. Function MoveFile2Quarantaine(sFile,Folder)
  53.     Dim  FSO
  54.     Set FSO = CreateObject("Scripting.FileSystemObject")
  55.     If FSO.FolderExists(Folder) Then
  56.         FSO.GetFile(sFile).Move Folder
  57.     End If
  58. End Function
  59. '**********************************************************************************
  60. Function Search(Cle,Processus)
  61.     Dim Tab,NomVirusBDR
  62.     Tab = Split(Processus,"\")
  63.     NomVirusBDR = Tab(UBound(Tab))
  64.     NomVirusBDR = Replace(NomVirusBDR,Chr(34),"")
  65.     NomVirusBDR = Trim(NomVirusBDR)
  66.     Search = NomVirusBDR
  67. End Function
  68. '**************************************************
  69. Sub SupprimVirusBDR(cle,Valeur)
  70.     On Error Resume Next
  71.     Dim Tab,NomVirusBDR,Supprim
  72.     Tab = Split(lit_reg(cle,Valeur),"=")
  73.     NomVirusBDR = Tab(LBound(Tab))
  74.     NomVirusBDR = Replace(NomVirusBDR,Chr(34),"")
  75.     NomVirusBDR = Trim(NomVirusBDR)
  76. 'MsgBox NomVirusBDR
  77.     Supprim = "reg delete "& cle &" /v "& DblQuote(NomVirusBDR) &" /f"
  78. 'MsgBox Supprim
  79.     Call Executer(Supprim,0,False)
  80. End Sub
  81. '**************************************************
  82. function lit_reg(cle,valeur)
  83.     Dim fs,Sh,adr,erro,fich
  84.     Set fs = CreateObject("Scripting.FileSystemObject")
  85.     Set Sh = WScript.CreateObject("WScript.Shell")
  86. 'adresse du fichier dans lequel on inscrit la valeur de la clé
  87. 'adr=replace(wscript.scriptfullname,wscript.scriptname,"Runregistres.txt")
  88.     adr = "%Tmp%\Export.txt"
  89. 'exporter la clé (les guillements évitent les pb avec les adresses completes)
  90.     sh.Run "%comspec% /c REGEDIT /E """ & adr & """ """ & cle & """",0,true
  91. 'ouvrir en lecture
  92. 'attendre que le fichier reg soit créé
  93.     erro = 1
  94.     do while erro <> 0
  95. 'on error resume next
  96. 'le deuxième true pour lire en ANSI, dépend de la version de regedit !
  97.         Set fich = fs.OpenTextFile(adr, 1, False, true)
  98.         erro= Err.Number
  99.     loop
  100. 'on error goto 0
  101. 'lire le fichier ligne par ligne pour chercher valeur
  102.     lit_reg = ""
  103.     do while instr(lit_reg,valeur)=0 and not fich.atendofstream
  104.         lit_reg=fich.readline
  105.     loop
  106. 'prendre en compte les lignes des tableaux
  107.     if lit_reg <> "" then
  108.         do while right(lit_reg,1)="\\" and not fich.atendofstream
  109.             lit_reg = lit_reg & fich.readline
  110.         loop
  111.     end if
  112.     lit_reg = Replace(lit_reg,"\\","\")
  113.     fich.close
  114. end function
  115. '**************************************************************************************************************
  116. Function Executer(StrCmd,Console,bWaitOnReturn)
  117.     Dim ws,MyCmd,Resultat
  118.     Set ws = CreateObject("wscript.Shell")
  119. 'La valeur 0 pour cacher la console MS-DOS
  120.     If Console = 0 Then
  121.         MyCmd = "CMD /C " & StrCmd & ""
  122.         Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
  123.         If Resultat = 0 Then
  124.         Else
  125.             MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
  126.         End If
  127.     End If
  128. 'La valeur 1 pour montrer la console MS-DOS
  129.     If Console = 1 Then
  130.         MyCmd = "CMD /K " & StrCmd & " "
  131.         Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
  132.         If Resultat = 0 Then
  133.         Else
  134.             MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
  135.         End If
  136.     End If
  137.     Executer = Resultat
  138. End Function
  139. '***************************************************************************************************
  140. Function Explorer(File)
  141.     Dim ws
  142.     Set ws = CreateObject("wscript.shell")
  143.     ws.run "Explorer /n,/select,"& File &"",1,True
  144. end Function
  145. '***************************************************************************************************
  146. Function FindScript(MyProcess)
  147.     Dim colItems,objItem,Processus,Question,cles,i,Count,Valeur
  148.     Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
  149.     & "Where Name like '%"& MyProcess &"%' AND NOT commandline like '%" & wsh.scriptname & "%'",,48)
  150.     Count = 0
  151.     FindScript = False
  152.     For Each objItem in colItems
  153.         Count= Count + 1
  154.         Processus = Mid(objItem.CommandLine,InStr(objItem.CommandLine,""" """) + 2) 'Extraction du chemin du script en ligne de commande
  155.         Processus = Replace(Processus,chr(34),"")
  156.         Question = MsgBox ("Voulez-vous arrêter ce script : "& DblQuote(Processus) &" ?" ,VBYesNO+VbQuestion,Titre+Copyright)
  157.         If Question = VbYes then
  158.             objItem.Terminate(0)'Tuer ce processus
  159.             Cles = Array(Cle1,Cle2,Cle3,Cle4)
  160.             For i = LBound(Cles) To UBound(Cles)
  161.                 Valeur = Search(Cles(i),Processus)
  162.                 ws.popup "Recheche et effacement du Virus dans la base de registre : "& DblQuote(Valeur) & " dans la clé " & DblQuote(Cles(i)),"3",Titre+Copyright,VbExclamation
  163.                 Call SupprimVirusBDR(Cles(i),Valeur)
  164.             Next
  165. 'Supprim = "reg delete "& cle &" /v "& Valeur &" /f"
  166. 'MsgBox Supprim
  167. 'Call Executer(Supprim,1,True)
  168.             FindScript = True
  169.             OutPut.WriteLine DblQuote(Processus)
  170.         Else
  171.             Count= Count - 1 'décrementer le compteur de -1
  172. 'MsgBox "Il n'y pas d'instance de Wscript.exe trouvé !",VbInformation,Titre+Copyright
  173.         End if
  174.     Next
  175.     OutPut.WriteLine String(100,"*")
  176.     OutPut.WriteLine count & Titre & "ont été arrêtés" & vbNewline & String(100,"*")
  177. End Function
  178. '**********************************************************************************************
  179. Function DblQuote(Str)
  180.     DblQuote = Chr(34) & Str & Chr(34)
  181. End Function
  182. '**********************************************************************************************
  183. Sub ListTachesPlanifies()
  184.     Dim Macmd
  185.     MaCmd = "schtasks > "& Source & "\MyTmpTasks.txt & Cmd /U /C Type "& Source & "\MyTmpTasks.txt >> "& Source & "\" & NomFichierLog & " & Del "& Source & "\MyTmpTasks.txt"
  186.     Call Executer(MaCmd,0,True)
  187. End Sub
  188. '**********************************************************************************************
  189. Sub WinLogon()
  190.     Dim Macmd
  191.     MaCmd = "reg query ""HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"" > "& Source & "\MyTmpWinlogon.txt & Cmd /U /C Type "& Source & "\MyTmpWinlogon.txt >> "& Source & "\" & NomFichierLog &  "& Del "& Source & "\MyTmpWinlogon.txt"
  192.     Call Executer(MaCmd,0,True)
  193. End Sub
  194. '************************************************************************************************
  195. 'Les éléments à démarrage automatique + ListProcessCmdLine.vbs
  196. '************************************************************************************************
  197. Sub ListProcessCmdLine()
  198.     Dim fso,ws,ProcessEnv,NomMachine,NomUtilisateur,strComputer,objWMIService
  199.     Dim colProcesses,objProcess,ProcessName,ProcessID,CommandLine,count,Texte
  200.     Set fso = CreateObject("Scripting.FileSystemObject")
  201.     Set Ws = CreateObject("WScript.Shell")
  202.     Set ProcessEnv = Ws.Environment("Process")
  203.     NomMachine = ProcessEnv("COMPUTERNAME")
  204.     NomUtilisateur = ProcessEnv("USERNAME")
  205.     strComputer = "."
  206.     Set objWMIService = GetObject("winmgmts:" _
  207.     & "{impersonationLevel=impersonate}!\\" _
  208.     & strComputer & "\root\cimv2")
  209.     Set colProcesses = objWMIService.ExecQuery ("Select * from Win32_Process")
  210.     count=0
  211.     Call Infosys()
  212.     OutPut.WriteLine String(14,"*")& "Liste des Processus en cours d'exécution le " & date & " à " & time & " sur Le PC "& NomMachine &" connecté en tant que " & NomUtilisateur & String(14,"*")& vbNewline & String(80,"*")
  213.     For Each objProcess in colProcesses
  214.         ProcessName = objProcess.Name
  215.         ProcessID = objProcess.ProcessID
  216.         CommandLine = objProcess.CommandLine
  217.         count=count+1
  218.         Texte = "Numéro PID = "& objProcess.ProcessID & VbNewLine & "Nom du Processus = " & objProcess.Name & VbNewLine &"Ligne de Commande = "& objProcess.CommandLine &_
  219.         VbNewLine & String(100,"*")
  220.         OutPut.WriteLine Texte
  221.     Next
  222.     OutPut.WriteLine  "Il y a "& Count &" Processus en cours d'exécution le " & date & " à " & time & " sur Le PC "& NomMachine &" connecté en tant que " & NomUtilisateur & vbNewline
  223.     Call StartupCommand
  224. End Sub
  225. '**********************************************************************************
  226. Function StartupCommand()
  227.     Dim strComputer,resultat,strMessage,objWMIService,objStartupCommand,colStartupCommands
  228.     strComputer = "."
  229.     resultat=""
  230.     Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
  231.     Set colStartupCommands = objWMIService.ExecQuery ("Select * from Win32_StartupCommand")
  232.     For Each objStartupCommand in colStartupCommands
  233.         resultat=resultat & "Nom: " & objStartupCommand.Name & vbNewline
  234.         resultat=resultat & "Description: " & objStartupCommand.Description & vbNewline
  235.         resultat=resultat & "Emplacement: " & objStartupCommand.Location & vbNewline
  236.         resultat=resultat & "Commande: " & objStartupCommand.Command & vbNewline
  237.         resultat=resultat & "Utilisateur: " & objStartupCommand.User & vbNewline
  238.         resultat=resultat & String(100,"*") & vbNewline
  239.     Next
  240.     OutPut.WriteLine String(50,"*") &" Les éléments à démarrage automatique "& String(40,"*")
  241.     OutPut.WriteLine resultat & vbNewline & VbTab & VbTab &"! Liste des Tâches planifiés !" & vbNewline & String(100,"*")
  242.     OutPut.Close
  243. end Function
  244. '**********************************************************************************
  245. Function InfoSys()
  246.     Dim strComputer,strMessage,objWMIService
  247.     Dim objComputer,colSettings,colSettings2,colSettings3,objBIOS,objOperatingSystem
  248.     strComputer = "."
  249.     strMessage=""
  250.     Set objWMIService = GetObject("winmgmts:"  & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  251.     Set colSettings = objWMIService.ExecQuery  ("Select * from Win32_ComputerSystem")
  252.     Set colSettings2 = objWMIService.ExecQuery ("Select * from Win32_BIOS")
  253.     Set colSettings3 = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
  254.     For Each objBIOS in colSettings2
  255.         strMessage=strMessage & "BIOS " & objBIOS.Version & vbNewline & vbNewline
  256.     Next
  257.     For Each objComputer in colSettings
  258.         strMessage=strMessage & "Nom de l'ordinateur : " & objComputer.Name & vbNewline & "Fabriquant: " & objComputer.Manufacturer & vbNewline & "Modèle : " & objComputer.Model & vbNewline & vbNewline
  259.     Next
  260.     For Each objOperatingSystem in colSettings3
  261.         strMessage=strMessage &  objOperatingSystem.Name & vbNewline
  262.         strMessage=strMessage &  "Version " & objOperatingSystem.Version & vbNewline
  263.         strMessage=strMessage &  "Service Pack " & objOperatingSystem.ServicePackMajorVersion & "." & objOperatingSystem.ServicePackMinorVersion &vbNewline
  264.         strMessage=strMessage &  "Dossier de Windows: " & objOperatingSystem.WindowsDirectory &vbNewline
  265.     Next
  266.     OutPut.WriteLine strMessage
  267. end Function
  268. '***************************************************************************************************
  269. '***********************************************************************************************************
  270. Sub CreateProgressBar(Titre,MsgAttente)
  271.     Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
  272.     Set ws = CreateObject("wscript.Shell")
  273.     Set fso = CreateObject("Scripting.FileSystemObject")
  274.     Temp = WS.ExpandEnvironmentStrings("%Temp%")
  275.     PathOutPutHTML = Temp & "\Barre.hta"
  276.     Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
  277.     fhta.WriteLine "<HTML>"
  278.     fhta.WriteLine "<HEAD>"
  279.     fhta.WriteLine "<Title>  " & Titre & "</Title>"
  280.     fhta.WriteLine "<HTA:APPLICATION"
  281.     fhta.WriteLine "ICON = ""magnify.exe"" "
  282.     fhta.WriteLine "BORDER=""THIN"" "
  283.     fhta.WriteLine "INNERBORDER=""NO"" "
  284.     fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
  285.     fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
  286.     fhta.WriteLine "SCROLL=""NO"" "
  287.     fhta.WriteLine "SYSMENU=""NO"" "
  288.     fhta.WriteLine "SELECTION=""NO"" "
  289.     fhta.WriteLine "SINGLEINSTANCE=""YES"">"
  290.     fhta.WriteLine "</HEAD>"
  291.     fhta.WriteLine "<BODY text=""white""><CENTER>"
  292.     fhta.WriteLine "<marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee>"
  293.     fhta.WriteLine "<img src=""data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHonOWBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8PNorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/JiBFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoXyOoqYaBamqBROrqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIphpe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgAAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYBedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGyBROzsrW2tA+5ug68uLbAsxMDxcYDxMfFycrMx87Gv7u5wrfTwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoELHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgSve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwoMR48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipBROqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9DFDr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbBROcm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA"" />"
  294.     fhta.WriteLine "</CENTER></BODY></HTML>"
  295.     fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
  296.     fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
  297.     fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
  298.     fhta.WriteLine "Sub window_onload()"
  299.     fhta.WriteLine "    CenterWindow 490,110"
  300.     fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
  301.     fhta.WriteLine " End Sub"
  302.     fhta.WriteLine " Sub CenterWindow(x,y)"
  303.     fhta.WriteLine "    Dim iLeft,itop"
  304.     fhta.WriteLine "    window.resizeTo x,y"
  305.     fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
  306.     fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
  307.     fhta.WriteLine "    window.moveTo ileft,itop"
  308.     fhta.WriteLine "End Sub"
  309.     fhta.WriteLine "</script>"
  310.     fhta.close
  311. End Sub
  312. '**********************************************************************************************
  313. Sub LancerProgressBar()
  314.     Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
  315. End Sub
  316. '**********************************************************************************************
  317. Sub FermerProgressBar()
  318.     oExec.Terminate
  319. End Sub
  320. '**********************************************************************************************
  321. Sub Pause(NSeconds)
  322.     Wscript.Sleep(NSeconds*1000)
  323. End Sub  
  324. '**********************************************************************************************
RAW Paste Data