Sending email

[transparent]

Should I use the mapi object? If so how does the code differ from asp's cdonts object? Does anybody know of a tutorial?

Cheers

 

[Craftor]

Why don't you just use CDO in your code instead of an API? Or do you need to use an API?

 

[MickTheBelgian]

CDO is probably best on a server (asp) but the VB MAPI controls can be easily included in a *.MSI.
WIN98 does not have CDO!

 

[Craftor]

But you could install CDO from the Office 2000 CD - I implemented a solution at a customer where they only had Windows 98 and 95 running .... don't ask ....

Just out of interest - I've never used the MAPI control - performance wise how does it compare to CDO?

 

[transparent]

Cheers, I ended up using cdonts.

 

[thbinh]

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

Private Sub cmdBrowse_Click()

With CommonDialog1
.ShowOpen
If Len(.FileName) > 0 Then
ListFile.AddItem .FileName
End If
End With

End Sub

Private Sub cmdClose_Click()

Unload Me

End Sub

Private Sub cmdSend_Click()

cmdSend.Enabled = False

Dim i As Integer
If ListFile.ListCount > 0 Then
For i = 0 To ListFile.ListCount - 1
strFileBase64 = strFileBase64 & MaHoaFileBase64(ListFile.List(i)) & vbCrLf
Next i
End If

Winsock1.Connect Trim$(txtMailserver.Text), 25
Mail_Signal = MAIL_CONNECT

End Sub

Private Sub Form_Load()
ListFile.Clear
Dim Ctl As Control
For Each Ctl In Me.Controls
If TypeOf Ctl Is TextBox Then
Ctl.Text = ""
End If
Next
lblKetQua.Caption = ""

txtMailserver.Text = "smtp.hcm.vnn.vn"

txtSenderName.Text = "Hoang Thanh Binh - Viet Nam"
txtSenderEmail.Text = "kgg.pt@hcm.vnn.vn"
End Sub

Private Function MaHoaFileBase64(DiaChiFile As String) As String

Dim KySoFile As Integer
Dim ChuoiASCII As String
Dim TenFile As String
Dim KichThuocFile As Long
Dim SoCauMaHoa As Long
Dim DoanDuLieu As tring
Dim CauMaHoa As String
Dim i As Integer
Dim j As Integer

TenFile = Mid$(DiaChiFile, InStrRev(DiaChiFile, "\&quot + 1)

ChuoiASCII = "begin 664 " + TenFile + vbLf

KichThuocFile = FileLen(DiaChiFile)
SoCauMaHoa = KichThuocFile \ 45 + 1

DoanDuLieu = Space(45)
'
KySoFile = FreeFile

Open DiaChiFile For Binary As KySoFile
For i = 1 To SoCauMaHoa
If i = SoCauMaHoa Then
DoanDuLieu = Space(KichThuocFile Mod 45)
End If

Get KySoFile, , DoanDuLieu
CauMaHoa = Chr(Len(DoanDuLieu) + 32)
'
If i = SoCauMaHoa And (Len(DoanDuLieu) Mod 3) Then
DoanDuLieu = DoanDuLieu + Space(3 - (Len(DoanDuLieu) Mod 3))
End If

For j = 1 To Len(DoanDuLieu) Step 3
CauMaHoa = CauMaHoa + Chr(Asc(Mid(DoanDuLieu, j, 1)) \ 4 + 32)
CauMaHoa = CauMaHoa + Chr((Asc(Mid(DoanDuLieu, j, 1)) Mod 4) * 16 _
+ Asc(Mid(DoanDuLieu, j + 1, 1)) \ 16 + 32)
CauMaHoa = CauMaHoa + Chr((Asc(Mid(DoanDuLieu, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(DoanDuLieu, j + 2, 1)) \ 64 + 32)
CauMaHoa = CauMaHoa + Chr(Asc(Mid(DoanDuLieu, j + 2, 1)) Mod 64 + 32)
Next j

CauMaHoa = Replace(CauMaHoa, " ", "`&quot

ChuoiASCII = ChuoiASCII + CauMaHoa + vbLf
CauMaHoa = ""
Next i
Close KySoFile

ChuoiASCII = ChuoiASCII & "`" & vbLf + "end" + vbLf
MaHoaFileBase64 = ChuoiASCII

End Function

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
Dim strResponseCode As String
Dim strDataToSend As String
wsk.GetData strServerResponse

strResponseCode = Left(strServerResponse, 3)

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)

wsk.SendData "HELO " & strDataToSend & vbCrLf
lblStatus.Caption = "Connecting Mail server !"

Case MAIL_HELO
Mail_Signal = MAIL_FROM

wsk.SendData "MAIL FROM:" & Trim$(EmailNguoiGoi) & vbCrLf
lblStatus.Caption = "Send mail ... Please wait !"

Case MAIL_FROM
Mail_Signal = MAIL_RCPTTO

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

Case MAIL_RCPTTO
Mail_Signal = MAIL_DATA

wsk.SendData "DATA" & vbCrLf

Case MAIL_DATA
Mail_Signal = MAIL_DOT

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&quot & ", " & _
Format(Date, "dd Mmm YYYY&quot & ", " & _
Format(Time, "hh:mm:ss&quot & " -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

strMessage = NoiDung & vbCrLf & vbCrLf & strFileBase64
strFileBase64 = ""
varLines = Split(strMessage, vbCrLf)
strMessage = ""
For Each varLine In varLines
wsk.SendData CStr(varLine) & vbLf
Next
wsk.SendData "." & vbCrLf

Case MAIL_DOT
Mail_Signal = MAIL_QUIT
wsk.SendData "QUIT" & vbCrLf

Case MAIL_QUIT
wsk.Close
cmdEnable.Enabled = True
End Select

Else
wsk.Close
cmdEnable.Enabled = True

If Not Mail_Signal = MAIL_QUIT Then
lblStatus.Caption = "Error ... Error number: " & strServerResponse
Else
lblStatus.Caption = "Send OK."
End If

End If

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

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

End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

MsgBox "Winsock Error number " & Number & vbCrLf & _
Description, vbExclamation, "Winsock Error"
End Sub