Отправка файлов по отдельности с WINSOCK

[VBnovichok]

Привет Всем!!!!

Ситуация:
В папке "С:\Temp\" находятся файлы (temp.part1.rar, temp.part2.rar и т.д. общее кол-во их не известно) необходимо отправить их каждый по отдельности

Вопрос: Как на примере нижеуказанного кода сделать подобную отправку?

Заранее благодарен за помощь!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! :lol:


Имеем следующий код:

Option Explicit
Private Enum SMTP_State
MAIL_CONNECT
MAIL_HELO
MAIL_FROM
MAIL_RCPTTO
MAIL_DATA
MAIL_DOT
MAIL_QUIT
End Enum
Private m_State As SMTP_State
Private m_strEncodedFiles As String

Private Sub Form_Load()

Dim Host
Host = getstring(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000001", "SMTP Server")

'пробовал следующее:
'Dim F As String
'Const P As String = "c:\temp\"
'F = Dir$(P & "temp.part??.rar")
'While Len(F) > 0
'F = Dir$
'Wend
'm_strEncodedFiles = m_strEncodedFiles & _
UUEncodeFile(P & F) & vbCrLf
'Но программа зависает

m_strEncodedFiles = m_strEncodedFiles & _
UUEncodeFile("c:\Temp\temp.rar") & vbCrLf
On Error Resume Next
Winsock1.Connect Trim$(Host), 25
m_State = MAIL_CONNECT
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim strServerResponse As String
Dim strResponseCode As String
Dim strDataToSend As String
Dim txtSender As String
Dim txtRecipient
Dim txtSubject
Dim txtMessage
Dim txtFromname
Dim txtTo

txtSender = getstring(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000001", "SMTP Email Address")
txtRecipient = "user@domaim.com"
txtSubject = "Test"
txtMessage = "Test"
txtFromname = getstring(HKEY_CURRENT_USER, "Software\Microsoft\Internet Account Manager\Accounts\00000001", "SMTP Display Name")
txtTo = ""Test""
Winsock1.GetData strServerResponse
Debug.Print strServerResponse
strResponseCode = Left(strServerResponse, 3)
If strResponseCode = "250" Or _
strResponseCode = "220" Or _
strResponseCode = "354" Then

Select Case m_State
Case MAIL_CONNECT
m_State = MAIL_HELO
strDataToSend = Trim$(txtSender)
strDataToSend = Left$(strDataToSend, _
InStr(1, strDataToSend, "@") - 1)
Winsock1.SendData "HELO " & strDataToSend & vbCrLf
Case MAIL_HELO
m_State = MAIL_FROM
Winsock1.SendData "MAIL FROM:" & Trim$(txtSender) & vbCrLf
Case MAIL_FROM
m_State = MAIL_RCPTTO
Winsock1.SendData "RCPT TO:" & Trim$(txtRecipient) & vbCrLf
Case MAIL_RCPTTO
m_State = MAIL_DATA
Winsock1.SendData "DATA" & vbCrLf
Case MAIL_DATA
m_State = MAIL_DOT
Winsock1.SendData "From: " + txtFromname + " <" + txtSender + ">" + vbCrLf
Winsock1.SendData "To: " + txtTo + " <" + txtRecipient + ">" + vbCrLf
Winsock1.SendData "X-Priority: 1 (Highest)" & vbCrLf
Winsock1.SendData "Subject:" & txtSubject & vbLf & vbCrLf

Dim varLines As Variant
Dim varLine As Variant
Dim strMessage As String

strMessage = txtMessage & vbCrLf & vbCrLf & m_strEncodedFiles
m_strEncodedFiles = ""
varLines = Split(strMessage, vbCrLf)
strMessage = ""
For Each varLine In varLines
Winsock1.SendData CStr(varLine) & vbLf
Next
Winsock1.SendData "." & vbCrLf
Case MAIL_DOT
m_State = MAIL_QUIT
Winsock1.SendData "QUIT" & vbCrLf
Case MAIL_QUIT
Winsock1.Close
End Select
Else
Winsock1.Close
End If
End Sub

[SSecurity]

если тебе надо имя файла корректно определить могу предложить такой код

Код: Выделить всё

Const P As String = "c:\temp\"
F = Dir$(P & "temp.part1.rar")
I=1
While Dir(F) <>""
'код для отправки сюда файла F
I=I+1
F = P & "temp.part" & Trim(Str(I)) & ".rar"
Wend


[SSecurity]

А что касается отправки файла ... думаю проще ВИНСОКОМ законнектится и до посинения отправлять фалы, разрезая каждый на равные части например размером в 1024 байта, и получая в ответ контрольную сумму ... если конечно коннект с серваком, который контролируется....

А вообще можно поточно в ПЕРЕМЕННУЮ записать весь файл и отправить одним разом например так ...

Код: Выделить всё

Sub SendFiles()
Const P As String = "c:\temp\"
F = Dir$(P & "temp.part1.rar")
I=1
While Dir(F) <>""
   RealSend(F)
   I=I+1
   F = P & "temp.part" & Trim(Str(I)) & ".rar"
Wend
End Sub

Sub RealSend(File as string)
Dim TT as string, AAA as Binary
'Можно ТТ сделать массивом если размер будет не сходится
TT = ""
Open File For Binary as 1
  For H=1 to Len(File)
    Get #1, H, AAA
    TT = TT + Chr(AAA)
  Next I
  Winsock1.SendData TT
Close
End Sub


это работает при небольших файлах и он без подтверждения шлет сразу всё

Можно модифицировать
Это далеко не лучший вариант:)

[VBnovichok]

Спасибо SSecurity за участие

Задача состоит в том чтобы код отправлял файлы в папке Temp по отдельности, т.к. на серваке стоит ограничение по объему. Поэтому rar и разбил БОЛЬШОЙ файл на несколько part, а теперь каждый part необходимо отправить

[SSecurity]

Рад пообщаться, уважаемый VBnovichok!

Ну в таком случае тебе просто теперь нужна процедура отправки файла, думаю тут уже все просто ...

Надебюсь с именами все получилось .... кстати какой прикол, если убить промежуточный файл ну например ...
Temp1.rar
Temp2.rar
Temp4.rar

он последний не отправит

[VBnovichok]

Шо-то не идет
Может покажешь на моем примере

СПАСИБО :oops:

[SSecurity]

Ты пытаешься прикрепить к письму файлы как я понял?
если ДА ... то их просто надо дописать и разом отослать

[VBnovichok]

Так разом в одном письме то и нельзя, файлы temp.part1.rar, temp.part2.rar - аккурат по 300КБ. У сервака ограничение 400 КБ на одно сообщение.
Поэтому если прицепить несколько файлов или один файл больше чем 300КБ. Сообщение не пройдет.
Во как...

Нужно чтобы на каждый файл было отдельное письмо

[VBnovichok]

С MAPI было все просто, а вот WINSOCK..........
и

Код: Выделить всё

Dim F As String
Const P As String = "c:\temp\"
F = Dir$(P & "temp.part??.rar")
While Len(F) > 0

MessageCtrl.AttachmentPathName = P & F
MessageCtrl.Send False

F = Dir$
Wend

это работало

[alibek]

А в чем проблема? Насколько я понял, один файл отправляется, проблемы при отправлении нескольких файлов подряд?
Код я толком не смотрел, но думаю дело не в коде, на первый взгляд с ним все нормально.
Скорее всего дело в том, что почтовый сервер mail.ru (как и любой другой сервер бесплатной почтовой службы) имеет определенные ограничения на исходящую почту. Это ограничения на размер отправляемых писем, на частоту отправки писем, на минимальный интервал между двумя отправляемыми письмами и т.п.
А что касается

'пробовал следующее:
'Dim F As String
'Const P As String = "c:\temp"
'F = Dir$(P & "temp.part??.rar")
'While Len(F) > 0
'F = Dir$
'Wend
'm_strEncodedFiles = m_strEncodedFiles & _
UUEncodeFile(P & F) & vbCrLf
'Но программа зависает

Программа скорее всего не зависает, а просто тормозит. Если у тебя несколько файлов по 300-400 Кб и ты их так активно гоняешь в строковом буфере, то процедура может выполняться несколько минут.

Я бы советовал не объединять строки, а просто каждый файл обрабатывать отдельно. Т.е. строку пишешь как m_strEncodedFiles = UUEncodeFile(P & F) & vbCrLf и обрабатываешь ее отдельно -- открыл сессию, создал письмо, отправил, закрыл сессию, следующий файл.

[VBnovichok]

Код: Выделить всё

Dim F As String
Const P As String = "c:\archiv\"
F = Dir$(P & "archiv.part???.rar")
While Len(F) > 0

m_strEncodedFiles = m_strEncodedFiles & _
                         UUEncodeFile(P & F) & vbCrLf 

Winsock1.Connect Trim$(txtHost), 25
m_State = MAIL_CONNECT

В таком варианте все файлы из папки ARCHIV с расширением *.RAR отправляются одним письмом. А моя задача, чтобы каждому файлу с расширением *.RAR соответствовало отдельное письмо (сколько файлов - столько писем)

Помогите с примером

Списибо!