VBNet - Форум - Отправка файлов по отдельности с WINSOCK

Вопрос: Отправка файлов по отдельности с WINSOCK Добавлено: 12.12.03 22:33

Автор вопроса: VBnovichok

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

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

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

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

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

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

Ответить

Ответы Всего ответов: 2

Номер ответа: 1
Автор ответа:

NeForm@t

ICQ: 252999255

Вопросов: 36
Ответов: 247

Web-сайт: g--k.newmail.ru
Профиль | | #1

Добавлено: 12.12.03 23:17

Делаешь такую процедуру:

sub zzz(num as integer)

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

Далее в начале пишешь:

Public numVsego as integer

Public numTek as integer

При загрузке формы весь код после "'Програма зависает" и до конца процедуры заменяешь на :

numVsego =4'Здесь надо указать всего чачтей

numTek=1

zzz numTek

В событии Winsock1_DataArrival(ByVal bytesTotal As Long)

А имменно здесь:

Case MAIL_QUIT
Winsock1.Close
' Дальше добавляешь:

if numTek<>numVsego then

numTek=numTek+1