OVH Cloud OVH Cloud

Winsock : Fichier joint

1 réponse
Avatar
cedced
Bonjour,

Pour l'envoi de fichiers joints, j'utilise la fonction UUEncodefile() :
impeccable.

Mais pour la réception des fichiers joints, j'utilise la fonction
UUdecodeToFile() et là problème.

La fonction ne décode pas bien les fichiers. (Anomalie constamment à la
réception)

J'utilise ces 2 fonctions que j'ai trouvé sur le web.

Merci de votre aide.

Ci-dessous, les 2 focntions : Encode et Decode.
--------------------------------------------------------------------
Public Function UUEncodeFile(strFilePath As String) As String

Dim intFile As Integer 'file handler

Dim intTempFile As Integer 'temp file

Dim lFileSize As Long 'size of the file

Dim strFileName As String 'name of the file

Dim strFileData As String 'file data chunk

Dim lEncodedLines As Long 'number of encoded lines

Dim strTempLine As String 'temporary string

Dim i As Long 'loop counter

Dim j As Integer 'loop counter

Dim strResult As String

strFileName = Mid$(strFilePath, InStrRev(strFilePath, "\") + 1)

strResult = "begin 664 " + strFileName + vbLf

lFileSize = FileLen(strFilePath)

lEncodedLines = lFileSize / 45 + 1

strFileData = Space(45)

intFile = FreeFile

Open strFilePath For Binary As intFile

For i = 1 To lEncodedLines

If i = lEncodedLines Then

strFileData = Space(lFileSize Mod 45)

End If

Get intFile, , strFileData

strTempLine = Chr(Len(strFileData) + 32)

If i = lEncodedLines And (Len(strFileData) Mod 3) Then

strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))

End If

For j = 1 To Len(strFileData) Step 3

strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32)

strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 _

+ Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32)

strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4
_

+ Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32)

strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)

Next j

strResult = strResult + strTempLine + vbLf

strTempLine = ""

Next i

Close intFile

strResult = strResult & "'" & vbLf + "end" + vbLf

UUEncodeFile = strResult

End Function

----------------------------------------------------------------------------
-------------------------------------------------------------

Public Function UUDecodeToFile(strUUCodeData As String, strFilePath As
String) As Boolean

Dim vDataLine As Variant

Dim vDataLines As Variant

Dim strDataLine As String

Dim intSymbols As Integer

Dim intFile As Integer

Dim strTemp As String

Dim i As Long

If Left$(strUUCodeData, 6) = "begin " Then

strUUCodeData = Mid$(strUUCodeData, InStr(1, strUUCodeData, vbLf) + 1)

End If

If Right$(strUUCodeData, 4) = "end" + vbLf Then

strUUCodeData = Left$(strUUCodeData, Len(strUUCodeData) - 7)

End If

intFile = FreeFile

Open strFilePath For Binary As intFile

vDataLines = Split(strUUCodeData, vbLf)

For Each vDataLine In vDataLines

strDataLine = CStr(vDataLine)

intSymbols = Asc(Left$(strDataLine, 1))

strDataLine = Mid$(strDataLine, 2, intSymbols)

For i = 1 To Len(strDataLine) Step 4

strTemp = strTemp + Chr((Asc(Mid(strDataLine, i, 1)) - 32) * 4 + _

(Asc(Mid(strDataLine, i + 1, 1)) - 32) \ 16)

strTemp = strTemp + Chr((Asc(Mid(strDataLine, i + 1, 1)) Mod 16) * 16 + _

(Asc(Mid(strDataLine, i + 2, 1)) - 32) \ 4)

strTemp = strTemp + Chr((Asc(Mid(strDataLine, i + 2, 1)) Mod 4) * 64 + _

Asc(Mid(strDataLine, i + 3, 1)) - 32)

Next i

Put intFile, , strTemp

strTemp = ""

Next

Close intFile

UUDecodeToFile = True

End Function

1 réponse

Avatar
ng
Salut,

Quel protocole ? SMTP ?

--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/

cedced wrote:
Bonjour,

Pour l'envoi de fichiers joints, j'utilise la fonction UUEncodefile()
: impeccable.

Mais pour la réception des fichiers joints, j'utilise la fonction
UUdecodeToFile() et là problème.

La fonction ne décode pas bien les fichiers. (Anomalie constamment à
la réception)

J'utilise ces 2 fonctions que j'ai trouvé sur le web.

Merci de votre aide.

Ci-dessous, les 2 focntions : Encode et Decode.
--------------------------------------------------------------------
Public Function UUEncodeFile(strFilePath As String) As String

Dim intFile As Integer 'file handler

Dim intTempFile As Integer 'temp file

Dim lFileSize As Long 'size of the file

Dim strFileName As String 'name of the file

Dim strFileData As String 'file data chunk

Dim lEncodedLines As Long 'number of encoded lines

Dim strTempLine As String 'temporary string

Dim i As Long 'loop counter

Dim j As Integer 'loop counter

Dim strResult As String

strFileName = Mid$(strFilePath, InStrRev(strFilePath, "") + 1)

strResult = "begin 664 " + strFileName + vbLf

lFileSize = FileLen(strFilePath)

lEncodedLines = lFileSize / 45 + 1

strFileData = Space(45)

intFile = FreeFile

Open strFilePath For Binary As intFile

For i = 1 To lEncodedLines

If i = lEncodedLines Then

strFileData = Space(lFileSize Mod 45)

End If

Get intFile, , strFileData

strTempLine = Chr(Len(strFileData) + 32)

If i = lEncodedLines And (Len(strFileData) Mod 3) Then

strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))

End If

For j = 1 To Len(strFileData) Step 3

strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) 4 + 32)

strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) *
16 _

+ Asc(Mid(strFileData, j + 1, 1)) 16 + 32)

strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod
16) * 4 _

+ Asc(Mid(strFileData, j + 2, 1)) 64 + 32)

strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod
64 + 32)

Next j

strResult = strResult + strTempLine + vbLf

strTempLine = ""

Next i

Close intFile

strResult = strResult & "'" & vbLf + "end" + vbLf

UUEncodeFile = strResult

End Function

----------------------------------------------------------------------------
-------------------------------------------------------------

Public Function UUDecodeToFile(strUUCodeData As String, strFilePath As
String) As Boolean

Dim vDataLine As Variant

Dim vDataLines As Variant

Dim strDataLine As String

Dim intSymbols As Integer

Dim intFile As Integer

Dim strTemp As String

Dim i As Long

If Left$(strUUCodeData, 6) = "begin " Then

strUUCodeData = Mid$(strUUCodeData, InStr(1, strUUCodeData, vbLf) + 1)

End If

If Right$(strUUCodeData, 4) = "end" + vbLf Then

strUUCodeData = Left$(strUUCodeData, Len(strUUCodeData) - 7)

End If

intFile = FreeFile

Open strFilePath For Binary As intFile

vDataLines = Split(strUUCodeData, vbLf)

For Each vDataLine In vDataLines

strDataLine = CStr(vDataLine)

intSymbols = Asc(Left$(strDataLine, 1))

strDataLine = Mid$(strDataLine, 2, intSymbols)

For i = 1 To Len(strDataLine) Step 4

strTemp = strTemp + Chr((Asc(Mid(strDataLine, i, 1)) - 32) * 4 + _

(Asc(Mid(strDataLine, i + 1, 1)) - 32) 16)

strTemp = strTemp + Chr((Asc(Mid(strDataLine, i + 1, 1)) Mod 16) * 16
+ _

(Asc(Mid(strDataLine, i + 2, 1)) - 32) 4)

strTemp = strTemp + Chr((Asc(Mid(strDataLine, i + 2, 1)) Mod 4) * 64
+ _

Asc(Mid(strDataLine, i + 3, 1)) - 32)

Next i

Put intFile, , strTemp

strTemp = ""

Next

Close intFile

UUDecodeToFile = True

End Function