VPF::Снова почтовый клиент - Форум программистов

Некто

Дата 21.7.2004, 10:18 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 50
Регистрация: 11.5.2004

Репутация: нет
Всего: нет

Блуждая по бескрайнем просторам интернета, нашел код процедуры, которая из любого файла на диске делает вложение. Вот ее код:

Код


Public Function UUEncodeFile(strFilePath As String) As String
Dim intFile         As Integer
Dim intTempFile     As Integer
Dim lFileSize       As Long
Dim strFilename     As String
Dim strFileData     As String
Dim lEncodedLines   As Long
Dim strTempLine     As String
Dim i               As Long
Dim j               As Integer
Dim strResult       As String
strFilename = Mid$(strFilePath, InStrRev(strFilePath, "\") + 1)
strResult = "begin 664 " + strFilename + vbCrLf
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
strTempLine = Replace(strTempLine, " ", "`")
strResult = strResult + strTempLine + vbCrLf
strTempLine = ""
Next i
Close intFile
strResult = strResult & "`" & vbCrLf + "end" + vbCrLf
UUEncodeFile = strResult
End Function

Функция работает замечательно! Но мне нужна еще точно такая но только в обратном направление. Тоесть передаешь вложение из письма а она сохраняет это вложение на диск. Вчера думал, думал, но незнаю как сделать. Помогите плиз.

bom

Дата 21.7.2004, 13:08 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 329
Регистрация: 22.2.2004
Где: Казахстан, Алматы

Репутация: 4
Всего: 6

Держи:

Код



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

    Dim vDataLine   As Variant
    Dim vDataLines  As Variant
    Dim strDataLine As String
    Dim intSymbols  As Integer
    Dim intFile     As Integer
    Dim strTemp     As String
    
    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
    
End Function

Не знаешь случайно как происходит авторизация на SMTP ящике?

Некто

Дата 22.7.2004, 09:49 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 50
Регистрация: 11.5.2004

Репутация: нет
Всего: нет

При авторизации на Smtp клиент пишет серверу "Auth Login" а дальше они обмениваются зашифрованой абро-кадаброй. Что тоже пишешь почтовый клиент?

bom

Дата 23.7.2004, 09:44 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 329
Регистрация: 22.2.2004
Где: Казахстан, Алматы

Репутация: 4
Всего: 6

Цитата

Что тоже пишешь почтовый клиент?

Нет, но иногда нужно бывает.

Некто

Дата 23.7.2004, 10:31 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 50
Регистрация: 11.5.2004

Репутация: нет
Всего: нет

У меня эта функциия дает ошибку во втором цикле. Проверь пожалуйста мне она очень нужна.

bom

Дата 23.7.2004, 17:38 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 329
Регистрация: 22.2.2004
Где: Казахстан, Алматы

Репутация: 4
Всего: 6

Перед отправкой проверял, но проверил еще раз - все в порядке. На всякий случай, вот код:

Код


Dim DataBuffer As String
'Делаем аттачмент из блокнота:
DataBuffer = UUEncodeFile(Environ("windir") & "\notepad.exe")
'Извлекаем аттачмент в корень диска с:
UUDecodeToFile DataBuffer, "c:\attachednotepad.exe"

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »