daily pastebin goal
49%
SHARE
TWEET

[VBS] Hackoo VIRUS Cleaner.vbs

hackoo May 23rd, 2014 307 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
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top