Ich denke, jeder Interessierte hat sich schon mal mit dem SMTP-Protokoll beschäftigt um Emails per Winsock zu verschicken. Das klappt auch ganz gut, schließlich ist das Protokoll einfach aufgebaut. Wenn man jedoch Dateien verschicken will, muss man schon ein weniger tiefer forschen. Hier kommt nämlich ein neues Format hinzu, das MIME-Format. Zudem müssen die Dateien vorher kodiert werden.
Es gibt verschiedene Kodierung, ich habe hier einfach mal Base64 gewählt, da diese wohl am gebräuchlichsten ist. Schaut euch einfach den Code an, die Funktion SendFile gibt den Text zurück, der per Winsock an den Server geschickt werden muss.
Kurz noch zur Base64-Kodierung: das eigentliche Prinzip ist, aus 8-Bit- Zeichen 6-Bit-Zeichen zu machen, indem man 3 Bytes über 4 Bytes verteilt. Um dieses Prinzip besser zu verstehen, gibt es eine "langsame" Variante der Kodierung, die mit Strings arbeiten. Für größere Dateien ist das aber zu langsam, dort arbeitet man mit Tabellen und Bitoperationen. Im Projekt sind beide Varianten, die verständliche aber langsame und die schnelle.
History
16.03.2003 Hinzugefügt
Autor: Dominik Auras <Dominik_auf_vbinside.de>
Code aus MainForm.frm
Private Sub Command1_Click()
CommonDialog1.ShowOpen
List1.AddItem CommonDialog1.Filename
End SubPrivate Sub Command2_Click()
Dim Mail As String, Files() As String, i As Long
ReDim Files(List1.ListCount - 1)
For i = 0 To List1.ListCount - 1
Files(i) = List1.List(i)
Next i
Mail = SendFile(Text2.Text, Text3.Text, Text4.Text, _
Text6.Text, Files())
Winsock1.Connect Text1.Text, 25
Do: DoEvents: Loop While Not Winsock1.State >= sckConnected
If Winsock1.State <> sckConnected Then
Exit Sub
End If
Winsock1.SendData Mail
Beep
End Sub
Private Sub Winsock1_Close()
Winsock1.Close
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Buffer As String
Winsock1.GetData Buffer, vbString
Text7.Text = Text7.Text & Buffer
End Sub
Public Function SendFile(From As String, Rcpt As String, Subject _
As String, Mailtext As String, Path() As String) As String
Dim Filename() As String, Boundary() As String, n As Long
Dim File() As String, i As Integer, Mail As String
ReDim Filename(UBound(Path))
ReDim File(UBound(Path))
For n = LBound(Path) To UBound(Path)
Filename(n) = Mid$(Path(n), InStrRev(Path(n), "\") + 1)
File(n) = EncodeFile(Path(n))
Next n
ReDim Boundary(1)
For n = LBound(Boundary) To UBound(Boundary)
Do
Boundary(n) = "--"
For i = 1 To 20
Boundary(n) = Boundary(n) & Chr$(Int(Rnd * 26) + 65)
Next i
Loop While InStr(Mailtext, Boundary(n)) Or InArray(File, _
Boundary(n)) Or InArray(Boundary, Boundary(n), n)
Next n
Mail = "HELO" & vbCrLf & "MAIL FROM:<" & From & ">" & vbCrLf & _
"RCPT TO:<" & Rcpt & ">" & vbCrLf & "Data" & vbCrLf & _
"MIME-Version: 1.0" & vbCrLf & "From: <" & From & ">" & _
vbCrLf & "To: <" & Rcpt & ">" & vbCrLf & "Subject: " & _
Subject & vbCrLf & "Content-Type: multipart/mixed;" & _
vbCrLf & " Boundary=" & Boundary(0) & vbCrLf _
& vbCrLf & "--" & Boundary(0) & vbCrLf & "Content-type: " & _
"text/plain; charset=US-ASCII" & vbCrLf & vbCrLf & _
Mailtext & vbCrLf & vbCrLf & "--" & Boundary(0) & vbCrLf & _
"Content-Type: multipart/parallel; boundary=" & _
Boundary(1) & vbCrLf & vbCrLf
For n = LBound(File) To UBound(File)
Mail = Mail & "--" & Boundary(1) & vbCrLf & "Content-Type: " & _
"application/octet-stream;" & vbCrLf & " Name=" & _
Filename(n) & vbCrLf & "Content-Transfer-Encoding: " & _
"Base64" & vbCrLf & "Content-Disposition: inline;" & _
vbCrLf & " FileName=" & Filename(n) & vbCrLf & vbCrLf & _
File(n) & vbCrLf
Next n
Mail = Mail & "--" & Boundary(1) & "--" & vbCrLf & "--" & _
Boundary(0) & "--" & vbCrLf & "." & vbCrLf & "QUIT" & vbCrLf
SendFile = Mail
End Function
Public Function InArray(arr() As String, Boundary As String, _
Optional LeaveOut As Long = -1) As Long
Dim n As Integer
For n = LBound(arr) To UBound(arr)
If n <> LeaveOut Then
InArray = InStr(arr(n), Boundary)
If InArray Then
Exit For
End If
End If
Next n
End Function
