millerdraft
Level: Scholar
Registered: 01-02-2003
Posts: 41
|
Re: e_mail with vb
otherwise you can use the winsock and here is an example but you have to putit together the way you want...
Option Compare Text
Public strResponse As String
Public strData As String
Public LastResponse As String
Private pbBase64Byt(0 To 63) As Byte ' base 64 encoder byte array (SMTP AUTH)
Private Const BASE64CHR As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" '(SMTP AUTH)
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Sub Command1_Click()
Winsock1.SendData "mail from: " & Text1.Text & vbNewLine 'Where the message is coming from
DoEvents
End Sub
Private Sub Command2_Click()
Winsock1.SendData "auth login " & Encode64(Text2.Text) & vbNewLine 'Only need the encode for (SMTP AUTH)
DoEvents
End Sub
Private Sub Command3_Click()
Winsock1.SendData "pass: " & Encode64(Text3.Text) & vbNewLine 'Only need the encode for (SMTP AUTH)
DoEvents
End Sub
Private Sub Command4_Click()
Winsock1.SendData "rcpt to: " & Text4.Text & vbNewLine 'Who you are sending the message to
DoEvents
End Sub
Private Sub Command5_Click()
Winsock1.SendData _
"From: Your Name" & vbNewLine & _
"date: Mon, 24 Nov 2003 20:00:36 -0600" & vbNewLine & _
"X -Mailer: E-mail Program" & vbNewLine & _
"to: whatever@yourdomain.com" & vbNewLine & _
"subject: Your Subject" & vbNewLine & _
vbNewLine & _
"Body of the message." & vbNewLine & _
vbNewLine & _
"." & vbNewLine
DoEvents
End Sub
Private Sub Command6_Click()
Winsock1.Close
Winsock1.Connect
Dim Timeout As Long 'This is to allow time for it to connect
Timeout = GetTickCount + 10000 '10 seconds
Do Until Winsock1.State = sckConnected
DoEvents
If Timeout <= GetTickCount Then lblStatus.Caption = "Server Timeout"
Loop
lblStatus.Caption = "Connected"
End Sub
Private Sub Command7_Click()
Winsock1.SendData "helo whaterever.com" & vbNewLine 'Telling the server your domain
DoEvents
End Sub
Private Sub Form_Load()
Winsock1.Close
Winsock1.RemoteHost = "mail.yourdomain.com" 'your domain server
Winsock1.RemotePort = "25" 'default smtp port unless otherwise specified
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
Winsock1.GetData strData
txtData.Text = txtData.Text & strData 'Shows the status of sending email
End Sub
'** Only if you need to do SMTP Authentication **
Public Function DecodeBase64String(ByVal str2Decode As String) As String
Dim lPtr As Long
Dim iValue As Integer
Dim iLen As Integer
Dim iCtr As Integer
Dim Bits(1 To 4) As Byte
Dim strDecode As String
' for each 4 character group....
For lPtr = 1 To Len(str2Decode) Step 4
iLen = 4
For iCtr = 0 To 3
' retrive the base 64 value, 4 at a time
iValue = InStr(1, BASE64CHR, Mid$(str2Decode, lPtr + iCtr, 1), vbBinaryCompare)
Select Case iValue
' A~Za~z0~9+/
Case 1 To 64: Bits(iCtr + 1) = iValue - 1
' =
Case 65
iLen = iCtr
Exit For
' not found
Case 0: Exit Function
End Select
Next
' convert the 4, 6 bit values into 3, 8 bit values
Bits(1) = Bits(1) * &H4 + (Bits(2) And &H30) &H10
Bits(2) = (Bits(2) And &HF) * &H10 + (Bits(3) And &H3C) &H4
Bits(3) = (Bits(3) And &H3) * &H40 + Bits(4)
' add the three new characters to the output string
For iCtr = 1 To iLen - 1
strDecode = strDecode & Chr$(Bits(iCtr))
Next
Next
DecodeBase64String = strDecode
End Function
Function Encode64(InputStr As String) As String
Dim State As Integer
Dim i As Integer
Dim Base64
Dim current As Integer
Dim old As Integer
Dim first_new As String
Dim second_new As String
Dim Output As String
Base64 = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
"N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", _
"n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", _
"0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "+", "/")
For i = 1 To Len(InputStr)
State = State + 1
Select Case State
Case 1
current = Asc(Mid(InputStr, i, 1))
first_new = Base64((Int(current / 4) And &H3F))
Output = Output & first_new
Case 2
current = Asc(Mid(InputStr, i, 1))
first_new = Base64((((old * 16) And &H30) Or ((Int(current / 16) And &HF))))
Output = Output & first_new
Case 3:
current = Asc(Mid(InputStr, i, 1))
first_new = Base64((((old * 4) And &H3C) Or ((Int(current / 64) And &H3))))
second_new = Base64((current And &H3F))
Output = Output & first_new & second_new
State = 0
End Select
old = current
Next
Select Case State
Case 1
first_new = Base64(((old * 16) And &H30))
Output = Output & first_new & "=="
Case 2
first_new = Base64(((old * 4) And &H3C))
Output = Output & first_new & "="
End Select
Encode64 = Output
End Function
|
Made a few adjustments and added some comments
[Edited by millerdraft on 09-12-2003 at 09:15 PM GMT]
[Edited by millerdraft on 10-12-2003 at 08:38 PM GMT]
____________________________
Ted Moe
I wish I was real good at this stuff!
|
?
Re: e_mail with vb
