DLL invia mail + allegato, ma...

**IlGrandeReddy** · 07-05-2003, 21:58

Ho scaricato (da un sito a scopo didattico!) e personalizzato una dll che permette tramite alcune variabili (Server, mittente, destinatario, ecc..) l'invio di mail da VB.
Ho un piccolo problema:
il file che invio in allegato, pippo.txt arriva a destinazione con il nome c__nomecartella_nomesottocartella_pippo.txt.

Non essendo un esperto di VB non posso fare altro che chiedere aiuto a voi...
come faccio a fare arrivare il file a destinazione col nome pippo.txt?

Questo è il codice della dll:

' Variabili necessarie
' e-mail di chi invia il messaggio
Private m_Sender As String
' e-mail del destinatario
Private m_Recipient As String
' Nome di chi invia il messaggio
Private m_SenderName As String
' Nome del destinatario
Private m_RecipientName As String
' oggetto del messaggio
Private m_Subject As String
' corpo del messaggio
Private m_Body As String
' server di posta elettronica
Private m_Server As String
' timeout per il collegamento (in secondi)
Private m_TimeOut As Integer
' nome del file da inviare in attach
Private m_FilesAtt As String
' nome del file temporaneo uuecodato (default=tmpfilea.uue) ATTENZIONE!!! se la classe
' puo' essere usata da più utenti contemporaneamente, bisogna inserire sempre un nome di file nuovo
' nuovo per ogni chiamata (caso pratico: email automatica da IIS: è coveniente usare il numero di sessione
' come nome file)
Private m_FileTemp As String
' variabile booleana che indica la possibilità di cancellare il file temporaneo
Private m_KillFileTemp As Boolean
' variabile booleana che indica la possibilità di autenticare l'utente sul server
' se false (default) non richiede l'autenticazione
Private m_Aut_Ric As Boolean
'variabile del nome utente se è richiesta l'autenticazione
Private m_user As String
'variabile password se è richiesta l'autenticazione
Private m_password

' Impostazione delle proprietà
Public Property Get Sender() As String
Sender = m_Sender
End Property
Public Property Let Sender(strSender As String)
m_Sender = strSender
End Property
Public Property Get recipient() As String
recipient = m_Recipient
End Property

Public Property Let recipient(strRecipient As String)
m_Recipient = strRecipient
End Property
Public Property Get Sendername() As String
Sendername = m_SenderName
End Property
Public Property Let Sendername(strSendername As String)
m_SenderName = strSendername
End Property
Public Property Get RecipientName() As String
RecipientName = m_RecipientName
End Property
Public Property Let RecipientName(StrrecipientName As String)
m_RecipientName = StrrecipientName
End Property
Public Property Get Subject() As String
Subject = m_Subject
End Property
Public Property Let Subject(strSubject As String)
m_Subject = strSubject
End Property
Public Property Get Body() As String
Body = m_Body
End Property
Public Property Let Body(strBody As String)
m_Body = strBody
End Property
Public Property Get Server() As String
Server = m_Server
End Property
Public Property Let Server(strServer As String)
m_Server = strServer
End Property
Public Property Get TimeOut() As Integer
TimeOut = m_TimeOut
End Property
Public Property Let TimeOut(inttimeout As Integer)
m_TimeOut = inttimeout
End Property
Public Property Get FilesAtt() As String
FilesAtt = m_FilesAtt
End Property
Public Property Let FilesAtt(ArFiles As String)
m_FilesAtt = ArFiles
End Property
Public Property Get FileTemp() As String
FileTemp = m_FileTemp
End Property
Public Property Let FileTemp(strFileTemp As String)
m_FileTemp = strFileTemp
End Property
Public Property Get KillFileTemp() As Boolean
KillFileTemp = m_KillFileTemp
End Property
Public Property Let KillFileTemp(BoolFileTemp As Boolean)
m_KillFileTemp = BoolFileTemp
End Property
Public Property Get aut_ric() As Boolean
aut_ric = m_Aut_Ric
End Property
Public Property Let aut_ric(BoolAutRic As Boolean)
m_Aut_Ric = BoolAutRic
End Property
Public Property Get user() As String
user = m_user
End Property
Public Property Let user(struser As String)
m_user = struser
End Property

Public Property Get password() As String
password = m_password
End Property
Public Property Let password(strpassword As String)
m_password = strpassword
End Property

Public Function send() As Boolean
Dim t As Double, ris As Boolean, merror As Boolean
Dim myuser As String, mypassword As String
If Len(FileTemp) = 0 Then FileTemp = "tmpfilea.uue"
If Dir(FilesAtt) <> "" And Dir(FileTemp) = "" Then
'crea il file per la codifica
ris = CodificaUU
End If
t = Timer
' se la proprietà timeout non viene impostata dall'utente
' viene impostata di default a 40 secondi
If TimeOut = 0 Then TimeOut = 40
On Error GoTo senderr

' genera il file di log, utile per cercare eventuali errori

Open "vbmail.log" For Output As 2
Print #2, "Componente VBMail di Nicola Ciaramellano - log del: " & Now()
Close #2
With frmVBMail.sockVBMail
send = True
'Tenta il collegamento al Server di Posta
' e aspetta un numero di secondi pari a quello impostato
' nella proprietà Timeout
If .State <> sckConnected And .State <> sckOpen Then
.Connect Server, 25
Do While .State <> sckConnected And Timer < t + TimeOut
DoEvents
Loop
If .State <> sckConnected Then
MsgBox "Il server non ha risposto entro " & TimeOut + 5 & " secondi!"
.Close
send = False
GoTo sendexit
End If
End If
merror = GetResponse
' Crea il messaggio
Dim StrMessage As String

If aut_ric = True Then
'Autenticazione richiesta
StrMessage = "EHLO " & Server & vbCrLf
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
.SendData StrMessage
merror = GetResponse
StrMessage = "AUTH LOGIN" & vbCrLf
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
.SendData StrMessage
merror = GetResponse
myuser = user
StrMessage = Codifica_Sringa_Mime(myuser) & vbCrLf
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
.SendData StrMessage
merror = GetResponse
mypassword = password
StrMessage = Codifica_Sringa_Mime(mypassword) & vbCrLf
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
.SendData StrMessage
merror = GetResponse
Else
'Autenticazione non richiesta
StrMessage = "HELO " & Server & vbCrLf
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
.SendData StrMessage
merror = GetResponse
End If
' manda i dati del Mittente
' assicurandosi che siano tra <>
If Left(Sender, 1) <> "<" Then Sender = "<" & Sender
If Right(Sender, 1) <> ">" Then Sender = Sender & ">"
StrMessage = "MAIL FROM:" & Sender & vbCrLf
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
.SendData StrMessage

merror = GetResponse

'manda i dati del Destinatario
' assicurandosi che siano tra <>
If Left(recipient, 1) <> "<" Then recipient = "<" & recipient
If Right(recipient, 1) <> ">" Then recipient = recipient & ">"
StrMessage = "RCPT TO:" & recipient & vbCrLf
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
.SendData StrMessage
merror = GetResponse
If merror = True Then
.Close
send = False
GoTo sendexit
End If

' manda il Testo del messaggio
StrMessage = "DATA" & vbCrLf
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
.SendData StrMessage
merror = GetResponse

StrMessage = "FROM: " & Sendername & vbCrLf
StrMessage = StrMessage & "TO: " & Chr(34) & RecipientName & Chr(34) & " " & recipient & vbCrLf
StrMessage = StrMessage & "SUBJECT: " & Subject & vbCrLf
StrMessage = StrMessage & "DATE: " & Format$(Now, "dd/mm/yyyy") & vbCrLf & vbCrLf
StrMessage = StrMessage & Body & vbCrLf
.SendData StrMessage
StrMessage = ""

' manda il file allegato, se esiste

If Dir(FileTemp) <> "" Then
Open FileTemp For Input As 10
While EOF(10) = False
Line Input #10, l$
StrMessage = l$ & vbCrLf
.SendData StrMessage
Wend
Close 10

End If
StrMessage = ""
StrMessage = StrMessage & "." & vbCrLf
Open "vbmail.log" For Append As 2
Print #2, StrMessage
Close 2
.SendData StrMessage
merror = GetResponse

'Chiude il collegamento
.Close
t = Timer
Do While .State <> sckClosed And Timer < t + TimeOut
DoEvents
Loop
End With

sendexit:
If KillFileTemp = True And Dir(FileTemp) <> "" Then
Kill FileTemp
End If
Exit Function
senderr:
send = False
Resume sendexit
End Function

Private Function GetResponse() As Boolean

' funzione che legge la risposta dal server mail
' è possibile aggiungere la gestione di altri errori

Dim strTemp As String
Open "vbmail.log" For Append As 2
strTemp = ""
Do While strTemp = ""
frmVBMail.sockVBMail.GetData strTemp
DoEvents
Loop
Print #2, strTemp
Close #2
GetResponse = False
If Left(strTemp, 21) = "553 malformed address" Then
GetResponse = True
End If
End Function

Public Function CodificaUU() As Boolean

' Funzione che effettua la codifica per il file allegato

Dim UU As String
Dim Stingaiv As String
Dim Riga As String
Dim Stringa3 As String
Dim i As Long, a1 As Long, a2 As Long, a3 As Long
Dim PosizioneB As Long
Dim a$
Dim n As Long
Dim fN As String
Dim bin As String
CodificaUU = True
On Error GoTo errore
If Len(FileTemp) = 0 Then FileTemp = "tmpfilea.uue"

UU = "`"
For i = 1 To 63
UU = UU & Chr$(32 + i)
Next

fN = FilesAtt

While InStr(fN, "\") > 0
fN = Mid$(fN, InStr(fN, "\") + 1)
Wend

Open FilesAtt For Binary Access Read As 1 Len = 4096

bin = Input$(LOF(1), 1)
Close 1

Open FileTemp For Output As 1 Len = 4096
Print #1,
Print #1, "begin 666 " & fN$

Riga = String$(45 / 3 * 4, Chr$(0))
For x = 1 To Len(bin) Step 45
a$ = Mid$(bin, x, 45)
n = Len(a$)
PosizioneB = 0
For i = 0 To n - 1 Step 3
Stringa3 = Mid$(a$, i + 1, 3)
While Len(Stringa3) < 3
Stringa3 = Stringa3 + Chr$(0)
Wend
a1 = CLng(Asc(Mid$(Stringa3, 1, 1)))
a2 = CLng(Asc(Mid$(Stringa3, 2, 1)))
a3 = CLng(Asc(Mid$(Stringa3, 3, 1)))
Stingaiv = Mid$(UU, 1 + (a1& \ &H4), 1) + _
Mid$(UU, 1 + ((a1 * 16& And 48&) Or (a2 \ 16& And 15)), 1) + _
Mid$(UU, 1 + ((a2 * 4& And 60&) Or (a3 \ 64& And 3)), 1) + _
Mid$(UU, 1 + (a3 And 63&), 1)
Mid$(Riga, 1 + PosizioneB, 4) = Stingaiv
PosizioneB = PosizioneB + 4
Next
Print #1, Mid$(UU, 1 + n, 1) & Left$(Riga, PosizioneB)
Next
Print #1, "`"
Print #1, "end"
Print #1,
Close 1

uueexit:
Exit Function

errore:
CodificaUU = False
Resume uueexit
End Function

-----

Mi rendo conto che è una richiesta abbastanza assurda ma conto su di voi...
Se potete aiutarmi posso darvi qualche consiglio in cucina, o con le donne...
:metallica

GRAZIE
REDDY

**xegallo** · 07-05-2003, 22:22

quando la scriverai indentata decentemente probabilmente lo leggerò

**IlGrandeReddy** · 08-05-2003, 21:41

codice:

' Classe per la spedizione di E-mail
' per ASP
' Scritta da N. Ciaramellano
'
'
' Variabili necessarie
' e-mail di chi invia il messaggio
Private m_Sender As String
' e-mail del destinatario
Private m_Recipient As String
' Nome di chi invia il messaggio
Private m_SenderName As String
' Nome del destinatario
Private m_RecipientName As String
' oggetto del messaggio
Private m_Subject As String
' corpo del messaggio
Private m_Body As String
' server di posta elettronica
Private m_Server As String
' timeout per il collegamento (in secondi)
Private m_TimeOut As Integer
' nome del file da inviare in attach
Private m_FilesAtt As String
' nome del file temporaneo uuecodato (default=tmpfilea.uue) ATTENZIONE!!! se la classe
' puo' essere usata da più utenti contemporaneamente, bisogna inserire sempre un nome di file nuovo
' nuovo per ogni chiamata (caso pratico: email automatica da IIS: è coveniente usare il numero di sessione
' come nome file)
Private m_FileTemp As String
' variabile booleana che indica la possibilità di cancellare il file temporaneo
Private m_KillFileTemp As Boolean
' variabile booleana che indica la possibilità di autenticare l'utente sul server
' se false (default) non richiede l'autenticazione
Private m_Aut_Ric As Boolean
'variabile del nome utente se è richiesta l'autenticazione
Private m_user As String
'variabile password se è richiesta l'autenticazione
Private m_password




' Impostazione delle proprietà
Public Property Get Sender() As String
    Sender = m_Sender
End Property
Public Property Let Sender(strSender As String)
    m_Sender = strSender
End Property
Public Property Get recipient() As String
    recipient = m_Recipient
End Property

Public Property Let recipient(strRecipient As String)
    m_Recipient = strRecipient
End Property
Public Property Get Sendername() As String
    Sendername = m_SenderName
End Property
Public Property Let Sendername(strSendername As String)
    m_SenderName = strSendername
End Property
Public Property Get RecipientName() As String
    RecipientName = m_RecipientName
End Property
Public Property Let RecipientName(StrrecipientName As String)
    m_RecipientName = StrrecipientName
End Property
Public Property Get Subject() As String
    Subject = m_Subject
End Property
Public Property Let Subject(strSubject As String)
    m_Subject = strSubject
End Property
Public Property Get Body() As String
    Body = m_Body
End Property
Public Property Let Body(strBody As String)
    m_Body = strBody
End Property
Public Property Get Server() As String
    Server = m_Server
End Property
Public Property Let Server(strServer As String)
    m_Server = strServer
End Property
Public Property Get TimeOut() As Integer
    TimeOut = m_TimeOut
End Property
Public Property Let TimeOut(inttimeout As Integer)
    m_TimeOut = inttimeout
End Property
Public Property Get FilesAtt() As String
    FilesAtt = m_FilesAtt
End Property
Public Property Let FilesAtt(ArFiles As String)
    m_FilesAtt = ArFiles
End Property
Public Property Get FileTemp() As String
    FileTemp = m_FileTemp
End Property
Public Property Let FileTemp(strFileTemp As String)
    m_FileTemp = strFileTemp
End Property
Public Property Get KillFileTemp() As Boolean
    KillFileTemp = m_KillFileTemp
End Property
Public Property Let KillFileTemp(BoolFileTemp As Boolean)
    m_KillFileTemp = BoolFileTemp
End Property
Public Property Get aut_ric() As Boolean
    aut_ric = m_Aut_Ric
End Property
Public Property Let aut_ric(BoolAutRic As Boolean)
    m_Aut_Ric = BoolAutRic
End Property
Public Property Get user() As String
    user = m_user
End Property
Public Property Let user(struser As String)
    m_user = struser
End Property

Public Property Get password() As String
    password = m_password
End Property
Public Property Let password(strpassword As String)
    m_password = strpassword
End Property

Public Function send() As Boolean
   Dim t As Double, ris As Boolean, merror As Boolean
   Dim myuser As String, mypassword As String
   If Len(FileTemp) = 0 Then FileTemp = "tmpfilea.uue"
    If Dir(FilesAtt) <> "" And Dir(FileTemp) = "" Then
        'crea il file per la codifica
        ris = CodificaUU
    End If
    t = Timer
    ' se la proprietà timeout non viene impostata dall'utente
    ' viene impostata di default a 40 secondi
    If TimeOut = 0 Then TimeOut = 40
    On Error GoTo senderr
    
    ' genera il file di log, utile per cercare eventuali errori
    
    Open "vbmail.log" For Output As 2
    Print #2, "Componente VBMail di Nicola Ciaramellano - log del: " & Now()
    Close #2
    With frmVBMail.sockVBMail
        send = True
        'Tenta il collegamento al Server di Posta
        ' e aspetta un numero di secondi pari a quello impostato
        ' nella proprietà Timeout
        If .State <> sckConnected And .State <> sckOpen Then
            .Connect Server, 25
            Do While .State <> sckConnected And Timer < t + TimeOut
                DoEvents
            Loop
            If .State <> sckConnected Then
                MsgBox "Il server non ha risposto entro " & TimeOut + 5 & " secondi!"
                .Close
                send = False
                GoTo sendexit
            End If
        End If
    merror = GetResponse
    ' Crea il messaggio
    Dim StrMessage As String
    If aut_ric = True Then
        'Autenticazione richiesta
        StrMessage = "EHLO " & Server & vbCrLf
        Open "vbmail.log" For Append As 2
        Print #2, StrMessage
        Close 2
        .SendData StrMessage
        merror = GetResponse
        StrMessage = "AUTH LOGIN" & vbCrLf
        Open "vbmail.log" For Append As 2
        Print #2, StrMessage
        Close 2
        .SendData StrMessage
        merror = GetResponse
        myuser = user
        StrMessage = Codifica_Sringa_Mime(myuser) & vbCrLf
        Open "vbmail.log" For Append As 2
        Print #2, StrMessage
        Close 2
        .SendData StrMessage
        merror = GetResponse
        mypassword = password
        StrMessage = Codifica_Sringa_Mime(mypassword) & vbCrLf
        Open "vbmail.log" For Append As 2
        Print #2, StrMessage
        Close 2
        .SendData StrMessage
        merror = GetResponse
    Else
        'Autenticazione non richiesta
        StrMessage = "HELO " & Server & vbCrLf
        Open "vbmail.log" For Append As 2
        Print #2, StrMessage
        Close 2
        .SendData StrMessage
        merror = GetResponse
    End If
    ' manda i dati del Mittente
    ' assicurandosi che siano tra <>
     If Left(Sender, 1) <> "<" Then Sender = "<" & Sender
     If Right(Sender, 1) <> ">" Then Sender = Sender & ">"
    StrMessage = "MAIL FROM:" & Sender & vbCrLf
    Open "vbmail.log" For Append As 2
    Print #2, StrMessage
    Close 2
    .SendData StrMessage
    
    
    merror = GetResponse
    
    'manda i dati del Destinatario
    ' assicurandosi che siano tra <>
     If Left(recipient, 1) <> "<" Then recipient = "<" & recipient
     If Right(recipient, 1) <> ">" Then recipient = recipient & ">"
    StrMessage = "RCPT TO:" & recipient & vbCrLf
    Open "vbmail.log" For Append As 2
    Print #2, StrMessage
    Close 2
    .SendData StrMessage
    merror = GetResponse
    If merror = True Then
        .Close
        send = False
        GoTo sendexit
    End If
    
    ' manda il Testo del messaggio
    StrMessage = "DATA" & vbCrLf
    Open "vbmail.log" For Append As 2
    Print #2, StrMessage
    Close 2
    Open "vbmail.log" For Append As 2
    Print #2, StrMessage
    Close 2
    .SendData StrMessage
    merror = GetResponse
    
    StrMessage = "FROM: " & Sendername & vbCrLf
    StrMessage = StrMessage & "TO: " & Chr(34) & RecipientName & Chr(34) & " " & recipient & vbCrLf
    StrMessage = StrMessage & "SUBJECT: " & Subject & vbCrLf
    StrMessage = StrMessage & "DATE: " & Format$(Now, "dd/mm/yyyy") & vbCrLf & vbCrLf
    StrMessage = StrMessage & Body & vbCrLf
    .SendData StrMessage
    StrMessage = ""
    
    ' manda il file allegato, se esiste
    
    If Dir(FileTemp) <> "" Then
        Open FileTemp For Input As 10
        While EOF(10) = False
            Line Input #10, l$
            StrMessage = l$ & vbCrLf
            .SendData StrMessage
        Wend
        Close 10
        
    End If
    StrMessage = ""
    StrMessage = StrMessage & "." & vbCrLf
    Open "vbmail.log" For Append As 2
    Print #2, StrMessage
    Close 2
    .SendData StrMessage
    merror = GetResponse
        
    'Chiude il collegamento
    .Close
    t = Timer
    Do While .State <> sckClosed And Timer < t + TimeOut
        DoEvents
    Loop
    End With
    
sendexit:
    If KillFileTemp = True And Dir(FileTemp) <> "" Then
            Kill FileTemp
    End If
    Exit Function
senderr:
    send = False
    Resume sendexit
End Function

Private Function GetResponse() As Boolean

    ' funzione che legge la risposta dal server mail
    ' è possibile aggiungere la gestione di altri errori
    
    Dim strTemp As String
    Open "vbmail.log" For Append As 2
    strTemp = ""
    Do While strTemp = ""
        frmVBMail.sockVBMail.GetData strTemp
        DoEvents
    Loop
    Print #2, strTemp
    Close #2
    GetResponse = False
    If Left(strTemp, 21) = "553 malformed address" Then
        GetResponse = True
    End If
End Function

Public Function CodificaUU() As Boolean
    
    ' Funzione che effettua la codifica per il file allegato
    
    Dim UU As String
    Dim Stingaiv As String
    Dim Riga As String
    Dim Stringa3 As String
    Dim i As Long, a1 As Long, a2 As Long, a3 As Long
    Dim PosizioneB As Long
    Dim a$
    Dim n As Long
    Dim fN As String
    Dim bin As String
    CodificaUU = True
    On Error GoTo errore
    If Len(FileTemp) = 0 Then FileTemp = "tmpfilea.uue"

    UU = "`"
    For i = 1 To 63
    UU = UU & Chr$(32 + i)
    Next

    fN = FilesAtt

    While InStr(fN, "\") > 0
        fN = Mid$(fN, InStr(fN, "\") + 1)
    Wend

    Open FilesAtt For Binary Access Read As 1 Len = 4096

    bin = Input$(LOF(1), 1)
    Close 1

    Open FileTemp For Output As 1 Len = 4096
    Print #1,
    Print #1, "begin 666 " & fN$

    Riga = String$(45 / 3 * 4, Chr$(0))
    For x = 1 To Len(bin) Step 45
        a$ = Mid$(bin, x, 45)
        n = Len(a$)
        PosizioneB = 0
        For i = 0 To n - 1 Step 3
            Stringa3 = Mid$(a$, i + 1, 3)
            While Len(Stringa3) < 3
                Stringa3 = Stringa3 + Chr$(0)
            Wend
            a1 = CLng(Asc(Mid$(Stringa3, 1, 1)))
            a2 = CLng(Asc(Mid$(Stringa3, 2, 1)))
            a3 = CLng(Asc(Mid$(Stringa3, 3, 1)))
            Stingaiv = Mid$(UU, 1 + (a1& \ &H4), 1) + _
            Mid$(UU, 1 + ((a1 * 16& And 48&) Or (a2 \ 16& And 15)), 1) + _
            Mid$(UU, 1 + ((a2 * 4& And 60&) Or (a3 \ 64& And 3)), 1) + _
            Mid$(UU, 1 + (a3 And 63&), 1)
            Mid$(Riga, 1 + PosizioneB, 4) = Stingaiv
            PosizioneB = PosizioneB + 4
        Next
        Print #1, Mid$(UU, 1 + n, 1) & Left$(Riga, PosizioneB)
    Next
    Print #1, "`"
    Print #1, "end"
    Print #1,
    Close 1

uueexit:
    Exit Function
    
errore:
    CodificaUU = False
    Resume uueexit
End Function

Discussione: DLL invia mail + allegato, ma...

Strumenti discussione

Ricerca discussione

Visualizza

DLL invia mail + allegato, ma...

SORRY!

Permessi di invio