|
| Autor |
Nachricht |
spidertimo
Newbie
Anmeldedatum: 10.07.2008
Beiträge: 14
|
[VB6] Email mit Anhang
Verfasst am: 19.07.2008, 15:27 |
|
|
Hallo,
ich möchte per Vb6 eine Email mit 2 Dateien als Anhang versenden. Text versendet das Programm ohne Probleme, aber ich weiß nicht wie ich es mit dem Anhang hinbekommen könnte. Die Emails werden per Winsock versendet.
Wäre nett, wenn mir einer helfen könnte  |
|
| |
|
 |
igoe
Gast
|
Verfasst am: 19.07.2008, 15:43 |
|
|
(spidertimo;5715) Hallo, ich möchte per Vb6 eine Email mit 2 Dateien als Anhang versenden. Text versendet das Programm ohne Probleme, aber ich weiß nicht wie ich es mit dem Anhang hinbekommen könnte. Die Emails werden per Winsock versendet. Wäre nett, wenn mir einer helfen könnte |
http://www.devguru.com/features/tutorials/CDONTS/cdonts.html
Sollte eigentlich Funktionieren
Mfg Igoe |
|
| |
|
|
spidertimo
Newbie
Anmeldedatum: 10.07.2008
Beiträge: 14
|
Verfasst am: 19.07.2008, 16:03 |
|
|
Tut leide rnicht [img]/ohmy.gif[/img]
der Source sieht so aus:
Form1
Visual Basic: [code]Option Explicit
Private Sub Form_Load()
TimeOut = 20
ProgressBar1.Min = 0
ProgressBar1.Value = 0
ProgressBar1.Max = TimeOut * 5
Text7.MultiLine = True
Text7.ScrollBars = 2 'vertikal
End Sub
Private Sub Command1_Click()
Label7.Caption = "" 'Statusfeld
Label7.BackColor = Form1.BackColor
Server = "mail.gmx.net" '<= eigenen Mailserver eingeben!
Sender_Name = "ABSENDERNAME" '<= angezeigter Absendername
Sender_Mail = "ABSENDERMAIL" '<= Absender Mailadresse
Benutzer = "MEIN BENUTZERNAME" '<= Benutzername des Mailaccounts
Password = "MEIN PASSWORT" '<= Passwort des Mailaccounts
Domain = "Test.org" '<= Inhalt scheint egal, muss aber sein
Receiver_Mail = "EMPFÄNGER MAILADRESSE" '<= Empfänger Mailadresse
Subject = "Mailtest" '<= Betreffzeile
Mailtext = "Das ist nur ein Test!" & vbCrLf & "Mit zweiter Zeile" '<= Inhalt der Mail
sendmail_start
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'im Form stehen lassen, da es sich um eine Eigenschaft des Winsock-Elements handelt!
Form1.Winsock1.GetData Result
'Protokoll:
Form1.Text7.text = Form1.Text7.text & last_Call & Result
last_Call = ""
End Sub
Private Sub Timer1_Timer()
Sec = Sec + 1
Form1.ProgressBar1.Value = Sec - 1
DoEvents
End Sub[/code]
Module1
Visual Basic: [code]Option Explicit
Global Mailing As Boolean
Global Result As String
Global Sec As Integer
Global TimeOut As Integer
Global last_Call As String
Global Server As String
Global Sender_Name As String
Global Sender_Mail As String
Global Domain As String
Global Benutzer As String
Global Password As String
Global Benutzer64 As String 'Benutzername base64-codiert
Global Password64 As String 'Password base64 codiert
Global Receiver_Mail As String
Global Subject As String 'Betreff
Global Mailtext As String 'Mailbody
Global Sourcetext As String
Global var_base64
Global B64() As Byte
Function sendmail_start()
var_base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
'ReDim B64(63)
' Die Austauschtabelle wird in ein Bytearray uebertragen.
B64() = StrConv(var_base64, vbFromUnicode)
Benutzer64 = base64_encode(B64(), Benutzer)
Password64 = base64_encode(B64(), Password)
If Mailing = False Then
If Sendmail Then
ShowStatus ("E-Mail erfolgreich verschickt")
Form1.Label7.BackColor = vbGreen
Else
ShowStatus ("Fehler beim Versenden aufgetreten")
Form1.Label7.BackColor = vbRed
Exit Function
End If
Else
ShowStatus ("Letzte E-Mail wird noch gesendet !")
Form1.Label7.BackColor = vbRed
End If
End Function
Function Sendmail() As Boolean
On Error Goto ERRORMail
If Mailing = True Then Exit Function
Mailing = True
Form1.MousePointer = vbHourglass
Sourcetext = "" 'wichtig bei mehreren Mails nacheinander
If Form1.Winsock1.State = sckClosed Then 'keine bestehende Verbindung
Sourcetext = Sourcetext & "From: " & Sender_Name & " <" & Sender_Mail & ">"
Sourcetext = Sourcetext & vbCrLf & "Date: " & Format(Date, "Ddd")
Sourcetext = Sourcetext & ", " & Format(Date, "dd Mmm YYYY") & " "
Sourcetext = Sourcetext & Format(Time, "hh:mm:ss") & " +0100" & vbCrLf
Sourcetext = Sourcetext & "X-Mailer: Visual Basic Mailing Tester"
Sourcetext = Sourcetext & vbCrLf & "To: <" & Receiver_Mail & ">"
Sourcetext = Sourcetext & vbCrLf & "Subject: " & Subject & vbCrLf
Sourcetext = Sourcetext & vbCrLf & Mailtext & vbCrLf & vbCrLf & "." & vbCrLf
'### Verbindung aufbauen
ShowStatus ("Verbinde...")
'Form1.Winsock1.Protocol = sckTCPProtocol 'TCP ist Standardwert
'Form1.Winsock1.RemoteHost = Server 'wird direkt übergeben
Form1.Winsock1.LocalPort = 0
Form1.Winsock1.RemotePort = 25
Form1.Winsock1.Connect (Server)
last_Call = "Connect" & vbCrLf
If Not Response("220") Then Goto ERRORMail
'### Verbunden
ShowStatus ("Verbunden")
'wenn Auth gewünscht, muss wohl mit
Form1.Winsock1.SendData ("EHLO " & Domain & vbCrLf)
last_Call = "EHLO " & Domain & vbCrLf
'gearbeitet werden
'Form1.Winsock1.SendData ("HELO " & Domain & vbCrLf)
'last_Call = "HELO " & Domain & vbCrLf
'If Not Response("250") Then GoTo ERRORMail
'GoTo var_1: 'einfache Möglichkeit, um ohne Auth. zu arbeiten
'********* Authorisierung Anfang ******************
ShowStatus ("Authorisierung...")
Form1.Winsock1.SendData ("AUTH LOGIN" & vbCrLf)
last_Call = "AUTH LOGIN" & vbCrLf
If Not Response("334") Then Goto ERRORMail
' Zurück kommt "334 VXNlcm5hbWU6" und damit Aufforderung nach Bentz.
'Benutzername wird base64 codiert übergeben. (s.u.)
Form1.Winsock1.SendData (Benutzer64 & vbCrLf)
last_Call = "" & Benutzer64 & vbCrLf
If Not Response("334") Then Goto ERRORMail
'jetzt fordert Server mittels "334 UGFzc3dvcmQ6" das Passwort an
'Passwort wird base64 codiert und übergeben
' Zurück kommt die Antwort "235 ok" als erfolgreich
Form1.Winsock1.SendData (Password64 & vbCrLf)
last_Call = "" & Password64 & vbCrLf
If Not Response("235") Then Goto ERRORMail
' Anzahl & Größe der E-Mails abfragen
'Bei einigen Mailservern müssen vor Versenden vorliegende Mails abgefragt werden
'Hier reicht es im Allg. den Status abzurufen, ohne die Mails herunterzuladen:
'Bei vorheriger Authorisation scheint dies überflüssig zu sein!!
' Form1.Winsock1.SendData "stat" & vbCrLf
' last_Call = "Abfrage Posteingang"
'If Response Then GoTo ERRORMail
'********* Authorisierung Ende ******************
var_1:
'### Mail Senden
Form1.Winsock1.SendData ("MAIL FROM:<" & Sender_Mail & ">" & vbCrLf)
last_Call = "MAIL FROM:<" & Sender_Mail & ">" & vbCrLf
If Not Response("250") Then Goto ERRORMail
Form1.Winsock1.SendData ("RCPT TO:<" & Receiver_Mail & ">" & vbCrLf)
last_Call = "RCPT TO:<" & Receiver_Mail & ">" & vbCrLf
If Not Response("250") Then Goto ERRORMail
Form1.Winsock1.SendData ("DATA" & vbCrLf)
last_Call = "DATA" & vbCrLf
If Not Response("354") Then Goto ERRORMail
' Antwort ' 354 Enter mail, end with CRLF.CRLF
Form1.Winsock1.SendData (Sourcetext)
last_Call = "" & vbCrLf
If Not Response("250") Then Goto ERRORMail
'### Trennen
ShowStatus ("Trennen")
Form1.Winsock1.SendData ("quit" & vbCrLf)
Form1.Text7.text = Form1.Text7.text & "quit" & vbCrLf
'If Not Response("221") Then GoTo ERRORMail
'wenn hier ein Fehler kommt, ist die Nachricht erfahrungsgemäss trotzdem gesendet
ShowStatus ("Nachricht verschickt !")
Sendmail = True
Else
End If
ERRORMail:
Form1.Winsock1.Close
Form1.MousePointer = vbDefault
Mailing = False
End Function
Function Response(RCode$) As Boolean
Sec = 0
Form1.Timer1.Interval = 200
Form1.Timer1.Enabled = True
Response = True
'Do While Left$(Result, 3) <> RCode '<= Prob: einger Server senden mehrere Replys
Do While InStr(1, Result, RCode) = 0 '<= hier nehmen wir aber nur den letzten Reply
DoEvents
If Sec > TimeOut * 5 Then
If Len(Result) Then
ShowStatus ("SMTP Error! Falscher Rückgabewert")
Else
ShowStatus ("SMTP Error! Time out")
End If
Response = False
Exit Do
End If
Loop
Result = ""
Form1.ProgressBar1.Value = 0
Form1.Timer1.Enabled = False
End Function
Function base64_encode(Code2() As Byte, Source As String) As String
On Error Goto base64_encode_Err
Dim n As Long
Dim i As Long
Dim c1 As Integer
Dim c2 As Integer
Dim c3 As Integer
Dim w(4) As Integer
Dim sourceB() As Byte
Dim Result() As Byte
Dim l As Long
Dim k As Long
Dim rest As Long
Dim cnt
l = Len(Source)
If l = 0 Then
Exit Function
End If
sourceB() = StrConv(Source, vbFromUnicode)
rest = l Mod 3
If rest > 0 Then
n = ((l 3) + 1) * 3
ReDim Preserve sourceB(n - 1)
Else
n = l
End If
ReDim Result(4 * n / 3 - 1) ' Das Ergebnis ist 4/3 mal so lang
cnt = 0
For i = 0 To n / 3 - 1
k = 3 * i 'Damit k nur ein- statt dreimal berechnet werden muss.
c1 = sourceB(k) ' Je drei Byte werden gelesen
c2 = sourceB(k + 1)
c3 = sourceB(k + 2)
w(1) = Int(c1 / 4) ' Je 6 Bit werden extrahiert
w(2) = (c1 And 3) * 16 + Int(c2 / 16)
w(3) = (c2 And 15) * 4 + Int(c3 / 64)
w(4) = c3 And 63
k = 4 * i 'Dami k nur ein- statt viermal berechnet werden muss
Result(k) = B64(w(1)) ' Die 6-Bit-Werte werden nach Tabelle
Result(k + 1) = B64(w(2)) ' durch Zeichen ersetzt.
Result(k + 2) = B64(w(3))
Result(k + 3) = B64(w(4))
Next i
' Je nach ueberzaehligen Bytes im Ergebnis wird dieses
' Fuellbytes aufgefuellt. Das Fuellbyte ist ein "="
Select Case rest
Case 0
' nix tun
Case 1
Result(UBound(Result)) = 61
Result(UBound(Result) - 1) = 61
Case 2
'
Result(UBound(Result)) = 61
End Select
base64_encode = StrConv(Result, vbUnicode)
base64_encode_End:
Exit Function
base64_encode_Err:
ShowStatus ("Fehler: " & Err & " / " & Error$ & " / Function: base64_encode in Modul base64")
Form1.Label7.BackColor = vbRed
Resume base64_encode_End
End Function
Function ShowStatus(ByVal text$)
Form1.Label7.Caption = text
Form1.Label7.Refresh
End Function[/code]
vll. hab ich da auch einen Fehler beim einfügen gemacht. Kann mir vll. einer sagen, wie ich das einfügen muss?
//EDIT: Der bei der Seite, die du mir geschickt hast, ist das ja auch kein VB6..
Das mit dem Versenden geht jetzt.. aber nur eine Datei. Hab es dann so gemacht, dass die eine datei per Anhang versendet wird und die Textdatei als Emailtext, aber dann ist die email nur 1 kb groß... und dann ist die datei, welche ich als Anhang verschickt habe nicht dabei und von der Textdatei nur die erste Zeile... Wenn ich die Textdatei weglasse und als text nur hallo nehme und die Datei versende geht es komischerweiße... Mir kommt es so vor, als wäre die Mail dann zu groß [img]/ohmy.gif[/img] |
|
| |
|
|
bla
Coder
Anmeldedatum: 02.05.2008
Beiträge: 267
|
|
| |
|
|
spidertimo
Newbie
Anmeldedatum: 10.07.2008
Beiträge: 14
|
Verfasst am: 19.07.2008, 18:18 |
|
|
ne das ist mit Exel und Outlook [img]/sad.gif[/img] |
|
| |
|
|
|
|
Registrieren
Login
