• Thứ Sáu, 08/04/2005 14:17 (GMT+7)

    Tự viết chương trình gửi mail bằng VB 6.0

     


    Khi phát triển hoặc lập trình một ứng dụng phần mềm, có thể bạn sẽ gặp yêu cầu gửi mẫu ghi (record) hoặc tập tin (file) đến một địa chỉ e-mail nào đó. Với yêu cầu này, nhất thiết bạn phải viết một mô-đun gửi mail chạy trực tiếp trong dự án phần mềm của mình, thay vì mở đường link đến một ứng dụng mail có sẵn (MS Outlook chẳng hạn). Bài viết này chia sẻ kinh nghiệm  giải quyết vấn đề gửi tin hay file đính kèm đến mail server bằng VB.
    Trước hết, bạn hãy khởi động VB phiên bản 6.0. Tại hộp thoại New Project, chọn Standard EXE.
    Một project mới có tên ban đầu là Project1 và form có tên Form1 sẽ được thiết lập. Với Form1, bạn gán các thông số Height – Width phù hợp với cách nhìn của mình, sau đó tạo các TextBox, Label và CommandButton vào Form1 như giao diện Hình.
    Bạn cần bổ sung thêm hai ActiveX có sẵn của Microsoft là Mswinsck.ocx và ComDLG32.ocx vào Project bằng cách mở hộp thoại Component (nhấn Ctrl+T), chọn Microsoft Winsock Control 6.0 và Microsoft Common Dialog Control 6.0.
    Sau khi thiết kế xong phần giao diện người dùng, bạn bắt đầu viết mã ngay trong trang viết code của Form1. Trước hết, khai báo một số biến dùng chung trong phạm vi Form1:

     Option Explicit       

            Private Enum SMTP_State

                MAIL_CONNECT

                MAIL_HELO

                MAIL_FROM

                MAIL_RCPTTO

                MAIL_DATA

                MAIL_DOT

                MAIL_QUIT

          End Enum  

    Private Mail_Signal       As SMTP_State

    Private strFileBase64   As String

     

    Viết mã cho biến cố Form_Load như sau:

     Private Sub Form_Load()

    ‘Làm sạch các TextBox và ‘ListBox dành cho User

        ListFile.Clear

        Dim Ctl As Control

    For Each Ctl In Me.Controls

      If TypeOf Ctl Is TextBox Then

                Ctl.Text = “”

       End If

    Next Ctl

        lblKetQua.Caption = “”

    ‘Gán tên máy chủ phục vụ mail. ‘Ví dụ: smtp.hcm.vnn.vn (với ‘account thuộc Vnn tại ‘TP.HCM)hoặc:  omail.hcm ‘.fpt.vn (với account thuộc FPT tại TP. ‘HCM. Trường hợp bạn dùng Exchange Mail ‘Server thì gán IP Address cía máy chủ ‘cài đặt Exchange Mail Server

    txtMailserver.Text = “smtp.hcm.vnn.vn”

    txtSenderName.Text = “Huynh Thanh Long”      

    ‘Gán tên người gửi   

    txtSenderEmail.Text =

       “Datasoft@hcm.vnn.vn”   

    ‘Gán Email người gửi   

    End Sub

     Viết mã cho nút Chọn …

    Private Sub cmdBrowse_Click()           

                With CommonDialog1

                      .ShowOpen

                            If Len(.FileName) > 0 Then

                           ListFile.AddItem  .FileName

                       End If

                End With       

    End Sub

     Như đã biết, để gửi một file đính kèm trong mail thông qua mail server đến địa chỉ nào đó, bạn cần mã hóa file đó thành chuỗi ký tự ASCII-7 bit. Thay vì sử dụng một ActiveX miễn phí (như Base64.dll đã được giới thiệu trong PC World tháng 6-2002 chẳng hạn) bạn có thể viết một function như sau trong trang viết code của Form1:

     

    Private Function MaHoaFileBase64 (DiaChiFile As String) As String

       Dim KySoFile  As Integer

       Dim ChuoiASCII As String  

      ‘Thu nhận kết quả mã hóa Base64 từ một ‘File

        Dim TenFile  As String  

    ‘Tên File được mã hóa Base64

        Dim KichThuocFile  As Long    

    ‘Nhận kích thước của File được mã hóa

        Dim SoCauMaHoa  As Long     

      ‘Nhận số lượng câu mã hóa của 1 File. ‘Theo đó cứ mỗi 45 byte sẽ tạo thành ‘một câu

       Dim DoanDuLieu As String   

      ‘Một chuỗi thu nhận từng đoạn dữ liệu ‘trong file tương ứng với mỗi câu mã ‘hóa (45 byte)

        Dim CauMaHoa As String

        Dim i As Integer

        Dim j As Integer

    ‘Cắt lấy tên File từ chuỗi DiaChiFile

      TenFile = Mid$(DiaChiFile, InStrRev (DiaChiFile, “\”) + 1)   

    ‘Gán kiểu định dạng cho chuỗi ASCII

      ChuoiASCII = “begin 664 “ + TenFile + vbLf   

     ‘Nhận kích thước của File bằng hàm ‘FileLen()

        KichThuocFile = FileLen(DiaChiFile)

        SoCauMaHoa = KichThuocFile \ 45 + 1   

      ‘Tạo một khoảng trống có thể chứa 45 ‘byte cho mỗi DoanDuLieu

        DoanDuLieu = Space(45) 

        KySoFile = FreeFile       

    Open DiaChiFile For Binary As KySoFile

    For i = 1 To SoCauMaHoa        

    ‘Đọc từng câu dữ liệu 45 byte

    If i = SoCauMaHoa Then

     ‘Thông thường, câu cuối cùng trong ‘SoCauMaHoa có thể ít hoặc nhiều hơn ‘45 byte, do vậy cần định dạng lại ‘Space() cho DoanDuLieu cuối cùng

    DoanDuLieu = Space(KichThuocFile Mod 45)

    End If           

    Get KySoFile, , DoanDuLieu

      ‘Gán một ký tự vào đầu mỗi Câu mã hóa để ‘chương trình giải mã (Decode)nhận ‘biết. Với một DoanDuLieu đủ 45 byte, ‘ký tự đó sẽ là “M”

     CauMaHoa = Chr(Len(DoanDuLieu) + 32)

     If i = SoCauMaHoa And (Len(DoanDuLieu) Mod 3) Then

     ‘Khi xử lý đến Câu Mã Hóa cuối cùng, có ‘thể số byte trong câu không chia hết ‘cho 3 ta cần thêm 1 hoặc 2 ký tự trắng ‘vào Đoạn Dữ Liệu

     DoanDuLieu = DoanDuLieu + Space(3 - (Len(DoanDuLieu) Mod 3))

      End If     

    For j = 1 To Len(DoanDuLieu) Step 3

      ‘Tại vòng lặp này, ta chia mỗi cụm 3 ‘byte (8-bit) thành 4 phần, mỗi phần 6 ‘bit và dùng hàm Asc() để chuyển từng ‘phần thành các ký tự ASCII 7 bit.

    ‘Với phần thứ 1

    CauMaHoa = CauMaHoa + Chr(Asc(Mid (DoanDuLieu, j, 1)) \ 4 + 32)

    ‘Với phần thứ 2

    CauMaHoa = CauMaHoa + Chr((Asc(Mid( DoanDuLieu, j, 1)) Mod 4) * 16 + Asc(Mid( DoanDuLieu, j + 1, 1)) \ 16 + 32)

    ‘Với phần thứ 3

    CauMaHoa = CauMaHoa + Chr((Asc(Mid( DoanDuLieu, j + 1, 1)) Mod 16) * 4+ Asc(Mid(DoanDuLieu, j + 2, 1)) \ 64 + 32)

    ‘Với phần thứ 4

    CauMaHoa = CauMaHoa + Chr(Asc(Mid( DoanDuLieu, j + 2, 1)) Mod 64 + 32)

    Next j

    ‘Tìm kiếm và thay thế các ký tự trắng ‘thành ký tự “`” - Chr(96)

    CauMaHoa = Replace(CauMaHoa, “ “, “`”)

       ‘Lần lượt gán Câu Mã Hóa vào Chuỗi ASCII ‘cùng với dấu ngắt dòng

    ChuoiASCII = ChuoiASCII + CauMaHoa + vbLf

      ‘Trả lại chuỗi rỗng cho Câu Mã Hóa để ‘tiếp tục vòng lặp

    CauMaHoa = “”

    Next i

    Close KySoFile

     ‘Để kết thúc một chuỗi mã hóa File ‘Base64, gán thêm một ký tự 96, ngắt ‘dòng, cuối cùng là từ “end” và ngắt dòng

    ChuoiASCII = ChuoiASCII & “Ụ” & vbLf + “end” + vbLf

    ‘Trả về giá trị cho hàm M·H̉aFileBase64

    MaHoaFileBase64 = ChuoiASCII   

    End Function

    Tiếp tục, viết thủ tục (Sub) nhằm xử lý tín hiệu trả về từ mail server, theo đó chuyển giao dữ liệu cho mail server nếu kết nối thành công.
    Private Sub SendMailData(wsk As Winsock, ByVal TenNguoiGoi As String,ByVal EmailNguoiGoi As String, ByVal EmailNguoiNhan As String, ByVal ChuDe As String, ByVal NoiDung As String, ByVal lblStatus As Label, ByVal cmdEnable As CommandButton)

    Dim strServerResponse As String 

     ‘Biến nhận tín hiệu trả lời từ mail ‘server

    Dim strResponseCode As String 

      ‘Biến nhận ký số trong chuỗi tín hiệu ‘trả lời từ Mail server

    Dim strDataToSend As String

      ‘Biến nhận chuỗi dữ liệu gửi cho mail ‘server Nhận chuỗi tín hiệu trả lời từ ‘Mail server

    wsk.GetData strServerResponse

     ‘Cắt lấy ký số (3 số đầu) trong chuỗi ‘tín hiệu trả lời

    strResponseCode = Left(strServerResponse , 3)

      ‘Các biến cố sau đây sẽ được thực hiện ‘khi có các ký số gồm 220 (nhận yêu cầu ‘kết nối); 250 (chấp nhận kết nối) và ‘354 (chuyển giao dữ liệu) được trả về ‘từ Mail server

    If strResponseCode = “250”

       Or  strResponseCode = “220”

       Or  strResponseCode = “354”

    Then

      Select Case Mail_Signal

      Case MAIL_CONNECT

      Mail_Signal = MAIL_HELO

      strDataToSend =

         Trim$(txtSenderName .Text)

    ‘Gửi tín hiệu HELO cho mail server

    wsk.SendData “HELO “ & strDataToSend & vbCrLf

    lblStatus.Caption = “Đã kết nối thành công với Mail server !”

    Case MAIL_HELO

    Mail_Signal = MAIL_FROM

    ‘Gửi lệnh MAIL FROM cho Mail server

    wsk.SendData “MAIL FROM:” & Trim$( EmailNguoiGoi)& vbCrLf

    lblStatus.Caption = “Đang gửi mail ... Xin chờ.”

    Case MAIL_FROM

    Mail_Signal = MAIL_RCPTTO

    ‘Gửi lệnh RCPT TO cho Mail server

    wsk.SendData “RCPT TO:” & Trim$( EmailNguoiNhan) & vbCrLf

     Case MAIL_RCPTTO

    Mail_Signal = MAIL_DATA

    ‘Gởi lệnh DATA cho Mail server

    wsk.SendData “DATA” & vbCrLf

      Case MAIL_DATA

    Mail_Signal = MAIL_DOT

      ‘Tại Case này, chương trình sẽ bắt đầu ‘gửi toàn văn bức thư

    Dim strHeader  As String

    Dim Data1 As String

    Dim Data2 As String

    Dim Data3 As String

    Dim Data4 As String

    Dim CurrentDate  As String

    CurrentDate = Format(Date,“Ddd”) & “,“ & _

    Format(Date, “dd Mmm YYYY”) & “, “ & _

    Format(Time, “hh:mm:ss”) & “ -200”

    Data1 = “From:” & Chr(32) & TenNguoiGoi & vbLf

    Data2 = “Date:” & Chr(32) & CurrentDate & vbLf

    Data3 = “To:” & Chr(32) & EmailNguoiNhan & vbLf

    Data4 = “Subject:” & Chr(32) & ChuDe & vbLf

    strHeader = Data1 & Data2 & Data3 & Data4 & vbLf & vbCrLf

      wsk.SendData strHeader

    Dim varLines As Variant

    Dim varLine As Variant

    Dim strMessage As String            

       ‘Gửi chuỗi ASCII của File đính kèm (nếu ‘có)

    strMessage = NoiDung & vbCrLf & vbCrLf & strFileBase64

    strFileBase64 = “”

    varLines = Split(strMessage, vbCrLf)

    strMessage = “”

    For Each varLine In varLines

    wsk.SendData CStr(varLine) & vbLf

    Next

      ‘Gửi một dấu chấm câu để báo cho mail ‘server biết rằng toàn văn bức thư đã ‘được gửi hết

    wsk.SendData “.” & vbCrLf

     Case MAIL_DOT

    Mail_Signal = MAIL_QUIT

    ‘Gửi lệnh QUIT đến mail server

    wsk.SendData “QUIT” & vbCrLf

     Case MAIL_QUIT

    wsk.Close

    cmdEnable.Enabled = True

    End Select

    Else

      ‘Nếu Winsock không nhận được tín hiệu ‘chấp nhận kết nối hoặc chuyển giao dữ ‘liệu với mail server

    wsk.Close

    cmdEnable.Enabled = True

     If Not Mail_Signal = MAIL_QUIT Then

      ‘Thông báo không thể gửi thư được trong ‘trường hợp biến Mail_Signal không trả ‘về giá trị MAIL_QUIT

    lblStatus.Caption = “Mail chưa gửi được. Ký số lỗi: ” & strServerResponse

    Else

    lblStatus.Caption = “Mail đã được gửi đi thành công.”

    End If

    End If

    End Sub

     Với biến cố DataArrival của Winsock1, bạn chạy thủ tục SendMailData vừa được tạo ở trên:

     Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)       

    SendMailData Winsock1, txtSenderName .Text, txtSenderEmail.Text, txtTo .Text, txtSubject.Text, txtMessage .Text, lblKetQua, cmdSend   

    End Sub

     Cuối cùng, bạn viết mã xử lý biến cố nhấn chuột khi người dùng nhấn nút Gửi đi (Send):

     Private Sub cmdSend_Click()   

      cmdSend.Enabled = False

      Dim i As Integer

      ‘Kiểm tra File đính kèm trong ListBox ‘và mã hóa Base64 chúng

      If ListFile.ListCount > 0 Then

      For i = 0 To ListFile.ListCount - 1

        strFileBase64 = strFileBase64

        & MaHoaFileBase64(ListFile.List(i))

         & vbCrLf

       Next i

       End If     

      ‘Kết nối Winsock với mail server qua ‘cổng 25

    Winsock1.Connect Trim$(txtMailserver .Text), 25

    Mail_Signal = MAIL_CONNECT

    End Sub

    Private Sub cmdClose_Click()   

        Unload Me   

    End Sub

    Như đã nói ở đầu bài viết, ứng dụng này có thể giúp bạn tự gửi một mẫu ghi (record) đến một địa chỉ e-mail. Để làm được điều này, đơn giản bạn chỉ cần gán giá trị của mẫu ghi lên TextBox txtMessage hoặc một biến chuỗi (As String). Tuyệt vời hơn, hàm MaHoaFileBase64  có thể làm việc ngay cả khi file đính kèm đang mở
    Các bạn có thể liên hệ với tôi qua E-mail: Datasoft@hcm.vnn.vn để được cung cấp miễn phí mã nguồn của ứng dụng trên. Chúc các bạn thành công.ÿ

    Huỳnh Thanh Long
    Chủ tịch HĐTV Công ty Datasoft
    Datasoft@hcm.vnn.vn

    ID: A0207_86