SendMime64

ForeColor= &H00000000&
    Height = 735
    Left = 120
    MaxLength= 1000
    MultiLine= -1 'True
    ScrollBars= 2 'Vertikal
    TabIndex= 0
    TabStop = 0 'False
    Top= 3960
    Width = 7935
    End
    Begin VB.TextBox Mailtxt 
    Appearance= 0 '2D
    BackColor= &H00FFFFFF&
    Height = 1965
    Left = 120
    MultiLine= -1 'True
    ScrollBars= 3 'Beides
    TabIndex= 5
    Top= 1920
    Width = 7935
    End
    Begin VB.Label ggg 
    Alignment= 2 'Zentriert
    AutoSize= -1 'True
    BackColor= &H00000000&
    Caption = "Server:"

ForeColor= &H00FFFFFF&
    Height = 195
    Left = 105
    TabIndex= 13
    Top= 360
    Width = 525
    End
    Begin VB.Label Label2 
    BackColor= &H00000000&
    Caption = "To:"

ForeColor= &H00FFFFFF&
    Height = 255
    Left = 240
    TabIndex= 12
    Top= 840
    Width = 375
    End
    Begin VB.Label Label3 
    BackColor= &H00000000&
    Caption = "From:"

ForeColor= &H00FFFFFF&
    Height = 255
    Left = 240
    TabIndex= 11
    Top= 1200
    Width = 495
    End
    Begin VB.Label Label4 
    BackColor= &H00000000&
    Caption = "Subject:"

ForeColor= &H00FFFFFF&
    Height = 255
    Left = 120
    TabIndex= 10
    Top= 1560
    Width = 615
    End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Option Explicit
    Dim bTrans As Boolean
    Dim m_iStage As Integer
    Public Path As Variant

Private Sub Attachement_Click()
  Load Form2
  Form2.Show
  End Sub

Private Sub delattach_Click()
  Path = ""
  Form1.AttachementList.List(0) = Path
End Sub

'Routine for connecting to the server

Private Sub Connect_Click()
 ' Little Error check
   If Tobox.Text = "" Or InStr(Tobox.Text, "@") = 0 Then
      MsgBox "To: Is not correct!"
      Exit Sub
   End If
   If Winsock1.State <> sckClosed Then Winsock1.Close
   Winsock1.LocalPort = 0
   Winsock1.Protocol = sckTCPProtocol
   Winsock1.Connect MailServer.Text, "25"
   txtStatus.Text = txtStatus.Text & "Connected to " & MailServer.Text & vbCrLf
   bTrans = True
   m_iStage = 0
   Transmit m_iStage
End Sub

Private Sub Exit_Click()
   On Error Resume Next
   If Winsock1.State <> sckClosed Then Winsock1.Close 'Fehler bereinigen durch schlie�en
   End
End Sub

'Routine for received Data

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  Dim strData As String
  On Error Resume Next
  Winsock1.GetData strData, vbString
  txtStatus.Text = txtStatus.Text & strData 'Zeigt Daten in Statusleiste an
  If bTrans Then
     m_iStage = m_iStage + 1
     Transmit m_iStage
  End If
End Sub

'Triggers the different sections

Private Sub Transmit(iStage As Integer)
  Dim Helo As String
  Dim pos As Integer
  Select Case m_iStage
     Case 1:
        Helo = Frombox.Text
        pos = Len(Helo) - InStr(Helo, "@")
        Helo = Right$(Helo, pos)
        Winsock1.SendData "HELO " & Helo & vbCrLf
     Case 2:
        Winsock1.SendData "MAIL FROM: <" & Trim(Frombox.Text) & ">" & vbCrLf
     Case 3:
        Winsock1.SendData "RCPT TO: <" & Trim(Tobox.Text) & ">" & vbCrLf
     Case 4:
        Winsock1.SendData "DATA" & vbCrLf
     Case 5:
        ' Calls the routine to send the Header
        Call SendMimetxt(Frombox.Text, Tobox.Text, Subjekt.Text, Mailtxt.Text, Form1.AttachementList.List(0))
        m_iStage = 0
        bTrans = False
  End Select
End Sub

'Routine for Winsock Error

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 "Error:" & Description, vbOKOnly, "Winsock Error!" ' Show error message
    If Winsock1.State <> sckClosed Then
        Winsock1.Close
        txtStatus = txtStatus & vbCrLf & "Disconnected"
    End If
End Sub

Private Sub SendMimetxt(txtFrom, txtTo, txtSubjekt, txtMail, txtMimePath)
  Dim temp As Variant
  If txtMimePath <> "" Then
    'Prepare the MIME Mail Header
    '!!!!!!!!!!!!!!!!!!!!!!
    'If you want additional Headers like Dat
    '     e,Message-Id,...etc. !
    'simply add them below!
    '!!!!!!!!!!!!!!!!!!!!!!
     temp = temp & "From: " & txtFrom & vbNewLine
     temp = temp & "To: " & txtTo & vbNewLine
     temp = temp & "Subject: " & txtSubjekt & vbNewLine
    'Do not change this Headers
     temp = temp & "Mime-Version: 1.0" & vbNewLine
     temp = temp & "Content-Type: multipart/mixed; boundary=" + Chr(34) + "NextMimePart" + Chr(34) + vbNewLine
     temp = temp & "This is a multi-part message in MIME format." + vbNewLine
     temp = temp & "--NextMimePart" + vbNewLine
    'Header plus Message
     temp = temp & vbCrLf & txtMail
    'Send the Mime Header and the Message
     Winsock1.SendData temp
    'Call Attachement Routine
     SendMimeAttachement (txtMimePath)
  Else
    'Send the E-Mail without Attachement
     temp = temp & "From: " & txtFrom & vbNewLine
     temp = temp & "To: " & txtTo & vbNewLine
     temp = temp & "Subject: " & txtSubjekt & vbNewLine
     temp = temp & vbCrLf & txtMail
    'Send Data and finish it!
     Winsock1.SendData temp
     Winsock1.SendData vbCrLf & "." & vbCrLf
  End If
End Sub
'************************
'Routine for sending a MIME Attachement
'***************************************

Private Sub SendMimeAttachement(Path As Variant)
  'Dim Global
   Dim l As Long, i As Long, Filein As Long
   Dim temp As Variant
  'For Encoding BASE64
   Dim b As Integer
   Dim Base64Tab As Variant
   Dim bin(3) As Byte
   Dim s As Variant
  'Base64Tab holds the encode tab
   Base64Tab = 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", "+", "/")
  'Gets the next free filenumber
   Filein = FreeFile
  'Open Base64 Input File
   Open Path For Binary As Filein
  'Preparing the Mime Header
   temp = vbCrLf + "--NextMimePart" + vbNewLine
   temp = temp + "Content-Type: application/octet-stream; name=" + Chr(34) + Form2.txtSave.Text + Chr(34) + vbNewLine
   temp = temp + "Content-Transfer-Encoding: base64" + vbNewLine
   temp = temp + "Content-Disposition: attachment; filename=" + Chr(34) + Form2.txtSave.Text + Chr(34) + vbNewLine
   Winsock1.SendData temp & vbCrLf
   l = LOF(Filein) - (LOF(Filein) Mod 3)
   For i = 1 To l Step 3
      'Read three bytes
       Get Filein, , bin(0)
       Get Filein, , bin(1)
       Get Filein, , bin(2)
      'Always wait until there're more then 64characters
       If Len(s) > 64 Then
          Do
          Loop Until Winsock1.State = 7
          s = s + vbCrLf
          Winsock1.SendData s
          s = ""
       End If
      'Calc Base64-encoded char
       b = (bin(0) \ 4) And &H3F 'right shift 2 bits (&H3F=111111b)
      'the character s holds the encoded chars
       s = s + Base64Tab(b)
       b = ((bin(0) And &H3) * 16) Or ((bin(1) \ 16) And &HF)
       s = s + Base64Tab(b)
       b = ((bin(1) And &HF) * 4) Or ((bin(2) \ 64) And &H3)
       s = s + Base64Tab(b)
       b = bin(2) And &H3F
       s = s + Base64Tab(b)
  Next i
 'Now, you need to check if there is something left

If Not (LOF(Filein) Mod 3 = 0) Then
    'Reads the number of bytes left
     For i = 1 To (LOF(Filein) Mod 3)
         Get Filein, , bin(i - 1)
     Next i
    'If there are only 2 chars left
     If (LOF(Filein) Mod 3) = 2 Then
        b = (bin(0) \ 4) And &H3F 'right shift 2 bits (&H3F=111111b)
        s = s + Base64Tab(b)
        b = ((bin(0) And &H3) * 16) Or ((bin(1) \ 16) And &HF)
        s = s + Base64Tab(b)
        b = ((bin(1) And &HF) * 4) Or ((bin(2) \ 64) And &H3)
        s = s + Base64Tab(b)
        s = s + "="
       'If there is only one char left
     Else
        b = (bin(0) \ 4) And &H3F 'right shift 2 bits (&H3F=111111b)
        s = s + Base64Tab(b)
        b = ((bin(1) And &H3) * 16) Or ((bin(1) \ 16) And &HF)
        s = s + Base64Tab(b)
        s = s + "=="
     End If
  End If
  'Send the characters left
   If s <> "" Then
       s = s & vbCrLf
       Winsock1.SendData s
   End If
  'Send the last part of the MIME Body
   Winsock1.SendData vbCrLf & "--NextMimePart--" & vbCrLf
   Winsock1.SendData vbCrLf & "." & vbCrLf
   Close Filein
End Sub

'Save it as fileactions.frm

VERSION 5.00
Begin VB.Form Form2 
BackColor= &H00000000&
BorderStyle= 4 'Festes Werkzeugfenster
Caption = "Add a Attachement"
ClientHeight = 3780
ClientLeft= 45
ClientTop= 300
ClientWidth= 4875
LinkTopic= "Form2"
MaxButton= 0 'False
MinButton= 0 'False
ScaleHeight= 3780
ScaleWidth= 4875
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows-Standard
Begin VB.FileListBox filList 
Height = 2235
Hidden = -1 'True
Left = 120
Pattern = "*.txt"
System = -1 'True
TabIndex= 6
Top= 120
Width = 2055
End
Begin VB.DirListBox Dirlist 
Height = 2115
Left = 2520
TabIndex= 5
Top= 120
Width = 2175
End
Begin VB.DriveListBox drvList 
Height = 315
Left = 2520
TabIndex= 4
Top= 2400
Width = 2175
End
Begin VB.TextBox txtSave 
Height = 285
Left = 120
TabIndex= 3
Top= 2400
Width = 2055
End
Begin VB.ComboBox txtPatter 
Height = 315
Left = 120
TabIndex= 2
Text = "*.*"
Top= 2760
Width = 2055
End
Begin VB.CommandButton Add 
Caption = "Add Attachement"
Height = 375
Left = 600
TabIndex= 1
Top= 3240
Width = 1695
End
Begin VB.CommandButton Cancel 
Caption = "Cancel"
Height = 375
Left = 2400
TabIndex= 0
Top= 3240
Width = 1695
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim temp As Variant

Private Sub Add_Click()

If Me.txtSave.Text = "" Then
     MsgBox "I have no file to Attach!"
     Exit Sub
  End If

temp = Dirlist.Path
  If Not Right(temp, 1) = "\" Then temp = temp + "\"
  Path = temp + txtSave
  Form1.AttachementList.List(0) = Path
  Me.Hide
End Sub

Private Sub Cancel_Click()
  Unload Me
End Sub

Private Sub DirList_Change()
  filList.Path = Dirlist.Path
End Sub

Private Sub drvList_Change()
  On Error Goto DriveHandler
  Dirlist.Path = drvList.Drive
  Exit Sub
  DriveHandler:
  drvList.Drive = Dirlist.Path
  Exit Sub
End Sub

Private Sub filList_Click()
  txtSave.Text = filList.List(filList.ListIndex)
End Sub

Private Sub Form_Load()
  txtPatter.AddItem "*.*", 0
  txtPatter.AddItem "*.txt", 1
  filList.Pattern = txtPatter.Text
End Sub

Private Sub txtPatter_Change()
  filList.Pattern = txtPatter.Text
End Sub

Private Sub txtPatter_Click()
  filList.Pattern = txtPatter.Text
End Sub
 Inputs:
If you are able to use a normal E-Mail Application, 
I think you should also be able to use this program!

Returns:An E-Mail sended to a E-Mail Adress ;-)

Assumes:Send me your comment to galgen@wtal.de

'You have to copy the section below and paste it 
'to the Notepad Save it as Mimeform.frm

'Creare un file Mimeform.frm ed incollare questo codice

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
BackColor= &H00000000&
BorderStyle= 4 'Festes Werkzeugfenster
Caption = "Sends E-Mail With Attachement!"
ClientHeight = 5220
ClientLeft= 1650
ClientTop= 2205
ClientWidth= 8280
LinkTopic= "Form1"
MaxButton= 0 'False
MinButton= 0 'False
ScaleHeight= 5220
ScaleWidth= 8280
StartUpPosition = 2 'Bildschirmmitte
Begin VB.CommandButton delattach
Caption = "Del Attachement"
Height = 375
Left = 6120
TabIndex= 7
Top= 840
Width = 1695
End
Begin VB.ListBox AttachementList
Height = 645
ItemData= "Mimeform.frx":0000
Left = 4440
List = "Mimeform.frx":0002
TabIndex= 14
Top= 120
Width = 3375
End
Begin VB.CommandButton Exit
Caption = "Exit"
Height = 375
Left = 4200
TabIndex= 9
Top= 4800
Width = 3855
End
Begin VB.CommandButton Connect
Appearance= 0 '2D
BackColor= &H00000000&
Caption = "Send E-Mail"
Height = 375
Left = 120
TabIndex= 8
Top= 4800
Width = 3975
End
Begin MSWinsockLib.Winsock Winsock1
Left = 3120
Top= 0
_ExtentX= 741
_ExtentY= 741
_Version= 393216
End
Begin VB.ComboBox MailServer
Appearance= 0 '2D
BackColor= &H00FFFFFF&
Height = 315
Left = 720
TabIndex= 1
Text = "mail.kdt.de"
Top= 240
Width = 2175
End
Begin VB.CommandButton Attachement
Caption = "Add Attachement"
Height = 375
Left = 4440
TabIndex= 6
Top= 840
Width = 1575
End
Begin VB.TextBox Tobox
Appearance= 0 '2D
BackColor= &H00FFFFFF&
Height = 285
Left = 720
MaxLength= 50
TabIndex= 2
Text = "galgen@wtal.de"
Top= 720
Width = 2175
End
Begin VB.ComboBox Frombox
Appearance= 0 '2D
BackColor= &H00FFFFFF&
Height = 315
ItemData= "Mimeform.frx":0004
Left = 720
List = "Mimeform.frx":0006
TabIndex= 3
Text = "me@host.com"
Top= 1080
Width = 2175
End
Begin VB.TextBox Subjekt
Appearance= 0 '2D
BackColor= &H00FFFFFF&
Height = 285
Left = 720
TabIndex= 4
Top= 1560
Width = 7335
End
Begin VB.TextBox txtStatus
Appearance= 0 '2D
BackColor= &H00C0C0C0&

ForeColor= &H00000000&
Height = 735
Left = 120
MaxLength= 1000
MultiLine= -1 'True
ScrollBars= 2 'Vertikal
TabIndex= 0
TabStop = 0 'False
Top= 3960
Width = 7935
End
Begin VB.TextBox Mailtxt
Appearance= 0 '2D
BackColor= &H00FFFFFF&
Height = 1965
Left = 120
MultiLine= -1 'True
ScrollBars= 3 'Beides
TabIndex= 5
Top= 1920
Width = 7935
End
Begin VB.Label ggg
Alignment= 2 'Zentriert
AutoSize= -1 'True
BackColor= &H00000000&
Caption = "Server:"

ForeColor= &H00FFFFFF&
Height = 195
Left = 105
TabIndex= 13
Top= 360
Width = 525
End
Begin VB.Label Label2
BackColor= &H00000000&
Caption = "To:"

ForeColor= &H00FFFFFF&
Height = 255
Left = 240
TabIndex= 12
Top= 840
Width = 375
End
Begin VB.Label Label3
BackColor= &H00000000&
Caption = "From:"

ForeColor= &H00FFFFFF&
Height = 255
Left = 240
TabIndex= 11
Top= 1200
Width = 495
End
Begin VB.Label Label4
BackColor= &H00000000&
Caption = "Subject:"

ForeColor= &H00FFFFFF&
Height = 255
Left = 120
TabIndex= 10
Top= 1560
Width = 615
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bTrans As Boolean
Dim m_iStage As Integer
Public Path As Variant

Private Sub Attachement_Click()
Load Form2
Form2.Show
End Sub

Private Sub delattach_Click()
Path = ""
Form1.AttachementList.List(0) = Path
End Sub

'Routine for connecting to the server

Private Sub Connect_Click()
' Little Error check

If Tobox.Text = "" Or InStr(Tobox.Text, "@") = 0 Then
MsgBox "To: Is not correct!"
Exit Sub
End If
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.LocalPort = 0
Winsock1.Protocol = sckTCPProtocol
Winsock1.Connect MailServer.Text, "25"
txtStatus.Text = txtStatus.Text & "Connected to " & MailServer.Text & vbCrLf
bTrans = True
m_iStage = 0
Transmit m_iStage
End Sub

Private Sub Exit_Click()
On Error Resume Next
If Winsock1.State <> sckClosed Then Winsock1.Close 'Fehler bereinigen durch schlie�en
End
End Sub

'Routine for received Data

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
On Error Resume Next
Winsock1.GetData strData, vbString
txtStatus.Text = txtStatus.Text & strData 'Zeigt Daten in Statusleiste an
If bTrans Then
m_iStage = m_iStage + 1
Transmit m_iStage
End If
End Sub

'Triggers the different sections

Private Sub Transmit(iStage As Integer)
Dim Helo As String
Dim pos As Integer
Select Case m_iStage
Case 1:
Helo = Frombox.Text
pos = Len(Helo) - InStr(Helo, "@")
Helo = Right$(Helo, pos)
Winsock1.SendData "HELO " & Helo & vbCrLf
Case 2:
Winsock1.SendData "MAIL FROM: <" & Trim(Frombox.Text) & ">" & vbCrLf
Case 3:
Winsock1.SendData "RCPT TO: <" & Trim(Tobox.Text) & ">" & vbCrLf
Case 4:
Winsock1.SendData "DATA" & vbCrLf
Case 5:
' Calls the routine to send the Header

Call SendMimetxt(Frombox.Text, Tobox.Text, Subjekt.Text, Mailtxt.Text, Form1.AttachementList.List(0))
m_iStage = 0
bTrans = False
End Select
End Sub

'Routine for Winsock Error

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 "Error:" & Description, vbOKOnly, "Winsock Error!" ' Show error message
If Winsock1.State <> sckClosed Then
Winsock1.Close
txtStatus = txtStatus & vbCrLf & "Disconnected"
End If
End Sub

Private Sub SendMimetxt(txtFrom, txtTo, txtSubjekt, txtMail, txtMimePath)
Dim temp As Variant
If txtMimePath <> "" Then
'Prepare the MIME Mail Header

'!!!!!!!!!!!!!!!!!!!!!!

'If you want additional Headers like Dat

' e,Message-Id,...etc. !

'simply add them below!

'!!!!!!!!!!!!!!!!!!!!!!

temp = temp & "From: " & txtFrom & vbNewLine
temp = temp & "To: " & txtTo & vbNewLine
temp = temp & "Subject: " & txtSubjekt & vbNewLine
'Do not change this Headers

temp = temp & "Mime-Version: 1.0" & vbNewLine
temp = temp & "Content-Type: multipart/mixed; boundary=" + Chr(34) + "NextMimePart" + Chr(34) + vbNewLine
temp = temp & "This is a multi-part message in MIME format." + vbNewLine
temp = temp & "--NextMimePart" + vbNewLine
'Header plus Message

temp = temp & vbCrLf & txtMail
'Send the Mime Header and the Message

Winsock1.SendData temp
'Call Attachement Routine

SendMimeAttachement (txtMimePath)
Else
'Send the E-Mail without Attachement

temp = temp & "From: " & txtFrom & vbNewLine
temp = temp & "To: " & txtTo & vbNewLine
temp = temp & "Subject: " & txtSubjekt & vbNewLine
temp = temp & vbCrLf & txtMail
'Send Data and finish it!

Winsock1.SendData temp
Winsock1.SendData vbCrLf & "." & vbCrLf
End If
End Sub
'************************

'Routine for sending a MIME Attachement

'***************************************

Private Sub SendMimeAttachement(Path As Variant)
'Dim Global

Dim l As Long, i As Long, Filein As Long
Dim temp As Variant
'For Encoding BASE64

Dim b As Integer
Dim Base64Tab As Variant
Dim bin(3) As Byte
Dim s As Variant
'Base64Tab holds the encode tab

Base64Tab = 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", "+", "/")
'Gets the next free filenumber

Filein = FreeFile
'Open Base64 Input File

Open Path For Binary As Filein
'Preparing the Mime Header

temp = vbCrLf + "--NextMimePart" + vbNewLine
temp = temp + "Content-Type: application/octet-stream; name=" + Chr(34) + Form2.txtSave.Text + Chr(34) + vbNewLine
temp = temp + "Content-Transfer-Encoding: base64" + vbNewLine
temp = temp + "Content-Disposition: attachment; filename=" + Chr(34) + Form2.txtSave.Text + Chr(34) + vbNewLine
Winsock1.SendData temp & vbCrLf
l = LOF(Filein) - (LOF(Filein) Mod 3)
For i = 1 To l Step 3
'Read three bytes

Get Filein, , bin(0)
Get Filein, , bin(1)
Get Filein, , bin(2)
'Always wait until there're more then 64characters

If Len(s) > 64 Then
Do
Loop Until Winsock1.State = 7
s = s + vbCrLf
Winsock1.SendData s
s = ""
End If
'Calc Base64-encoded char

b = (bin(0) \ 4) And &H3F 'right shift 2 bits (&H3F=111111b)
'the character s holds the encoded chars

s = s + Base64Tab(b)
b = ((bin(0) And &H3) * 16) Or ((bin(1) \ 16) And &HF)
s = s + Base64Tab(b)
b = ((bin(1) And &HF) * 4) Or ((bin(2) \ 64) And &H3)
s = s + Base64Tab(b)
b = bin(2) And &H3F
s = s + Base64Tab(b)
Next i
'Now, you need to check if there is something left

If Not (LOF(Filein) Mod 3 = 0) Then
'Reads the number of bytes left

For i = 1 To (LOF(Filein) Mod 3)
Get Filein, , bin(i - 1)
Next i
'If there are only 2 chars left

If (LOF(Filein) Mod 3) = 2 Then
b = (bin(0) \ 4) And &H3F 'right shift 2 bits (&H3F=111111b)
s = s + Base64Tab(b)
b = ((bin(0) And &H3) * 16) Or ((bin(1) \ 16) And &HF)
s = s + Base64Tab(b)
b = ((bin(1) And &HF) * 4) Or ((bin(2) \ 64) And &H3)
s = s + Base64Tab(b)
s = s + "="
'If there is only one char left

Else
b = (bin(0) \ 4) And &H3F 'right shift 2 bits (&H3F=111111b)
s = s + Base64Tab(b)
b = ((bin(1) And &H3) * 16) Or ((bin(1) \ 16) And &HF)
s = s + Base64Tab(b)
s = s + "=="
End If
End If
'Send the characters left

If s <> "" Then
s = s & vbCrLf
Winsock1.SendData s
End If
'Send the last part of the MIME Body

Winsock1.SendData vbCrLf & "--NextMimePart--" & vbCrLf
Winsock1.SendData vbCrLf & "." & vbCrLf
Close Filein
End Sub

'Save it as fileactions.frm

VERSION 5.00
Begin VB.Form Form2
BackColor= &H00000000&
BorderStyle= 4 'Festes Werkzeugfenster
Caption = "Add a Attachement"
ClientHeight = 3780
ClientLeft= 45
ClientTop= 300
ClientWidth= 4875
LinkTopic= "Form2"
MaxButton= 0 'False
MinButton= 0 'False
ScaleHeight= 3780
ScaleWidth= 4875
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows-Standard
Begin VB.FileListBox filList
Height = 2235
Hidden = -1 'True
Left = 120
Pattern = "*.txt"
System = -1 'True
TabIndex= 6
Top= 120
Width = 2055
End
Begin VB.DirListBox Dirlist
Height = 2115
Left = 2520
TabIndex= 5
Top= 120
Width = 2175
End
Begin VB.DriveListBox drvList
Height = 315
Left = 2520
TabIndex= 4
Top= 2400
Width = 2175
End
Begin VB.TextBox txtSave
Height = 285
Left = 120
TabIndex= 3
Top= 2400
Width = 2055
End
Begin VB.ComboBox txtPatter
Height = 315
Left = 120
TabIndex= 2
Text = "*.*"
Top= 2760
Width = 2055
End
Begin VB.CommandButton Add
Caption = "Add Attachement"
Height = 375
Left = 600
TabIndex= 1
Top= 3240
Width = 1695
End
Begin VB.CommandButton Cancel
Caption = "Cancel"
Height = 375
Left = 2400
TabIndex= 0
Top= 3240
Width = 1695
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim temp As Variant

Private Sub Add_Click()

If Me.txtSave.Text = "" Then
MsgBox "I have no file to Attach!"
Exit Sub
End If

temp = Dirlist.Path
If Not Right(temp, 1) = "\" Then temp = temp + "\"
Path = temp + txtSave
Form1.AttachementList.List(0) = Path
Me.Hide
End Sub

Private Sub Cancel_Click()
Unload Me
End Sub

Private Sub DirList_Change()
filList.Path = Dirlist.Path
End Sub

Private Sub drvList_Change()
On Error Goto DriveHandler
Dirlist.Path = drvList.Drive
Exit Sub
DriveHandler:
drvList.Drive = Dirlist.Path
Exit Sub
End Sub

Private Sub filList_Click()
txtSave.Text = filList.List(filList.ListIndex)
End Sub

Private Sub Form_Load()
txtPatter.AddItem "*.*", 0
txtPatter.AddItem "*.txt", 1
filList.Pattern = txtPatter.Text
End Sub

Private Sub txtPatter_Change()
filList.Pattern = txtPatter.Text
End Sub

Private Sub txtPatter_Click()
filList.Pattern = txtPatter.Text
End Sub
Inputs:
If you are able to use a normal E-Mail Application,
I think you should also be able to use this program!

Returns:An E-Mail sended to a E-Mail Adress ;-)

Assumes:Send me your comment to galgen@wtal.de

'You have to copy the section below and paste it

'to the Notepad Save it as Mimeform.frm