The sample code is given:
Sendemail.frm
VERSION 5.00Begin VB.Form Form1 Caption = "Form1" ClientHeight = 5250 ClientLeft = 60 ClientTop = 345 ClientWidth = 5865 LinkTopic = "Form1" ScaleHeight = 5250 ScaleWidth = 5865 StartUpPosition = 3 'default window Begin VB.TextBox Text5 Height = 2055 Left = 480 MultiLine = -1 'True TabIndex = 8 Top = 2880 Width = 4815 End Begin VB.TextBox Text2 Height = 375 Left = 2040 TabIndex = 7 Top = 720 Width = 2535 End Begin VB.CommandButton Command1 Caption = "send" Height = 375 left = 3600 TabINDEX = 6 TOP = 2160 width = 975 End begin vb.textbox text4 height = 375 left = 1440 TabINDEX = 5 Text = "qaymuic@wocall.com" Top = 2160 Width = 2055 End Begin VB.TextBox Text3 Height = 735 Left = 360 MultiLine = -1 'True TabIndex = 3 Top = 1320 Width = 4215 End Begin VB.TextBox Text1 Height = 375 Left = 1920 TabINDEX = 1 TOP = 120 width =
2655 End Begin VB.Label Label3 Caption = "from" Height = 375 Left = 240 TabIndex = 4 Top = 2160 Width = 975 End Begin VB.Label Label2 Caption = "to:" Height = 375 Left = 360 TabIndex = 2 Top = 720 Width = 1335 End Begin VB.Label Label1 Caption = "smtp server" Height = 375 Left = 360 TabIndex = 0 Top = 120 Width = 1335 EndEndAttribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalsePrivate Declare function socket lib "wsock32.dll" (Byval Af as long, byval s_type as long) As longprivate const AS = 2Private const Sock_Stream = 1Private Declare Function Close socket Lib "wsock32.dll" (ByVal s As Long) As LongPrivate Declare Function WSAStartup Lib "wsock32.dll" (ByVal wversion As Long, lpwsadata As wsadata) As LongPrivate Type wsadatawversion As Integerwhighversion As Integerszdescription (0 To 256) As Byteszsystemstatus ( 0 To 128) As Byteimaxsockets As Integerimaxudpdg As Integerlpvendorinfo As LongEnd TypeDim sendok As BooleanDim rcptok As BooleanPrivate Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wmsg As Long, ByVal levent As Long) As Longprivate const fd_read = &
H1Private Declare Function WSACleanup Lib "wsock32.dll" () As LongDim mailok As BooleanPrivate Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As LongPrivate Type sockaddrsin_family As Integersin_port As Integersin_addr As Longsin_zero As String * 8End TypePrivate Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As LongPrivate Type hostenth_name As Longh_aliases As Longh_addrtype As Integerh_length As Integerh_addr_list As LongEnd TypeDim sll As LongPrivate Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As IntegerPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any BYVAL BUFLEN As Long, BYVAL FLAGS As Long, BYVAL FLAGS As Long, ByVal S, BYVAL BUF AS ANY, BYVAL BUFLES AS Long, BYVAL BUFLEN As Long, BYVAL FLAGS AS LONG As LongPrivate Sub Command1_Click () Dim rc As LongDim xxz As wsadataDim sck As sockaddrmailok = Falsercptok = Falsesendok = FalseText5.Text = "" sll = 0sck.sin_family = AF_INETsck.sin_addr = getipaddress (Text1.Text) sck.sin_port = htons (25 ) sck.sin_zero = String (8, 0) RC = WSAStartup (& H101, XXZ) SLL = Socket (AF_INET, SOCK_STREAM, 0) RC = Connect (SLL, SCK, LEN (SCK)) WSAASYNCSELECT SLL, TEXT5.HWND, & H100 FD_READ
End SubPrivate Function getipaddress (host As String) As LongDim he As LongDim hedesthost As hostentDim addrlist As LongDim rc As Longhe = gethostbyname (host) If he = 0 ThenMsgBox "host name or network problem!" Rc = 0Exit FunctionEnd IfCopyMemory hedesthost, ByVal He, LEN (HEDESTHOST) COPYMEMORY Addrlist, Byval Hedesthost.h_addr_list, 4copyMemory RC, ByVal Addrlist, Hedesthost.h_lengthgetipaddress = RCEND Function
Private Sub Text5_KeyDown (KeyCode As Integer, Shift As Integer) Dim datareceived As StringDim datasend As Stringdatareceived = String $ (255, Chr (0)) rc = recv (sll, datareceived, 255, 0) If rc <= 0 Then Exit SubText5 .Text = text5.text & left (DataReceived, RC) if = "220" Then Datasend = "Helo" & text4.text & vbcrfifLeft (DataReceived, 3) = "250" and mailok = FALSE Thendatasend = "mail from:" & Text4.Text & vbCrLfmailok = TrueElseIf Left (datareceived, 3) = "250" And mailok = True And rcptok = False Thendatasend = "rcpt to:" & Text2.Text & vbCrLfrcptok = TrueElseIf Left ( datareceived, 3) = "250" And rcptok = True And sendok = transmission False Thendatasend = "data" & vbCrLfsendok = TrueElseIf Left (datareceived, 3) = "250" And sendok = True ThenText5.Text = Text5.Text & "Mail success! "closesocket sllWSACleanupExit SubEnd IfIf Left (datareceived, 3) =" 354 "Then datasend = Text3.Text & vbCrLf &". "& vbCrLfIf Left (datareceived, 1) =" 5 "ThenText5.Text = Text5.Text &" Mail delivery failed! "CloseSocket SLLWS Acleanupend IFRC = Send (SLL, BYVAL DATASEND, LEN (DATASEND), 0) End Sub
