Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > VB6 > Не срабатывает событие


Автор: Marvel 10.8.2004, 20:25
Help - Не срабатывает событие:
в коде формы все ок, но я создал winsock1 в модуле класса, а события на него прописать не могу.
Код
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
   
   MsgBox "Winsock Error number " & Number & vbCrLf & _
           Description, vbExclamation, "Winsock Error"
           
End Sub

при ошибке код не работает, хотя в изначальном примере где код в форме- все ок.

http://marvel.at.tut.by/tmp/f.zip

в SendMailsrc.zip от которого я вертелся события срабатывают
в SmtpTest.zip - нет
почему?

Автор: cardinal 11.8.2004, 00:26
Попробуй вместо Private Public написать, может заработает. А вообще напиши (если не заработает) как добиться в первом работающем варианте этой ошибки, то есть как сделать так чтобы событие сработало?

Автор: Marvel 11.8.2004, 01:12
изменил на паблик- тот же результат
Код
Public Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'когда все заработает - удалить
   If mvarbDebug Then
       Dim m
       m = MsgBox("data arrived")

в исходниках SendMailsrc при попытке отправить почту выдается ошибка host unreacheble или что-то вроде, т.е. норма когда не подключен к сети (если подключен то все шлется)

В моем же файлике SmtpTest.zip winsock объявлен внутри класса, а вот как к нему событие прикрутить?.. В коде формы все понятно: жмем F2, выбираем winsock, смотрим что у него есть Event: error, и пишем обработчик: Sub Winsock1_Error. В классе так не сработало, может там по другому как-то надо оформлять обработчик события...
В первом посте этой темы я дал ссылку на исходники, прошу - посмотрите. Сам уже много всего перепробовал но пока безрезультатно.

Автор: cardinal 11.8.2004, 04:20
С тебя ящик... водки smile.gif

Блин долго я просидел (часа три наверно), пока докумекал вот до чего:
Код
Private WithEvents Winsock1 As MSWinsockLib.Winsock
...
Public Function Send() As Boolean
 
   If Len(mvarAttach) <> 0 Then
   m_strEncodedFiles = m_strEncodedFiles & _
                        UUEncodeFile(mvarAttach) & vbCrLf
   End If
   
   
   Winsock1.Connect Trim$(mvarHost), 25

   Do While Winsock1.State = sckResolvingHost: DoEvents: Loop
   
   m_State = MAIL_CONNECT
End Function

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox "Winsock Error number " & Number & vbCrLf & _
       Description, vbExclamation, "Winsock Error"
End Sub

То есть у Winsock'ета есть TimeOut определенный на Connect и Event он об ошибке выкидывает только после того, как пройдет это определенное количество времени. Если мы не дождались этого Event'a и вышли из процедуры, то Event пропал (по другому я себе объяснить данный факт не смог). Мы недолго думаю (ну в смысле долго думая, но все таки smile.gif) берем и ждем пока TimeOut не кончится, то есть пока он пытается сделать Connect, а потом все происходит само собой и Event ловится нашей процедурой, которая выкидывает нам правильное сообщение об ошибке.

Если кто-то удививится тому, что я так долго пытался помочь человеку, то вот тому объяснение:
самому интересно стало. biggrin.gif

Автор: Marvel 11.8.2004, 11:47
Все! Релиз! clsSmtp v1.0!

http://marvel.at.tut.by/clssmtp.zip



cardinal , в германию я ящик водки слать не буду, но если появишься в Беларуси, желательно в Полоцке, то пиво с меня rolleyes.gif

ключевая строка приняла вид:
Код
Do While Not ((Winsock1.State = sckClosed) Or (Winsock1.State = sckError)): DoEvents: Loop


теперь мы знаем как к классу прикрутить компоненты (даешь классные классы)

один из недостатков класса - функция UUEncodeFile достаточно медленна, но мне пока что быстро и не надо.

Автор: cardinal 11.8.2004, 14:49
Цитата(Marvel @ 11.8.2004, 10:47)
функция UUEncodeFile достаточно медленна

То над чем можно поработать я подчеркнул красным цветом.

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
'
'Get file name
strFileName = Mid$(strFilePath, InStrRev(strFilePath, "\") + 1)
'
'Insert first marker: "begin 664 ..."
strResult = "begin 664 " + strFileName + vbLf
'
'Get file size
lFileSize = FileLen(strFilePath)
lEncodedLines = lFileSize \ 45 + 1
'
'Prepare buffer to retrieve data from
'the file by 45 symbols chunks
strFileData = Space(45)
'
intFile = FreeFile
'
Open strFilePath For Binary As intFile
For i = 1 To lEncodedLines -> For i = 1 To lEncodedLines - 1 'Read file data by 45-bytes cnunks
'
If i = lEncodedLines Then -> вынести из цикла
'Last line of encoded data often is not
'equal to 45, therefore we need to change
'size of the buffer
strFileData = Space(lFileSize Mod 45)
End If
'Retrieve data chunk from file to the buffer
Get intFile, , strFileData
'Add first symbol to encoded string that informs
'about quantity of symbols in encoded string.
'More often "M" symbol is used.
strTempLine = Chr(Len(strFileData) + 32)
'
If i = lEncodedLines And (Len(strFileData) Mod 3) Then -> вынести из циклаlength of
'source data is not a number divisible by 3, add one or two
'blankspace symbols
strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))
End If

For j = 1 To Len(strFileData) Step 3 -> раскрыть цикл

'Breake each 3 (8-bits) bytes to 4 (6-bits) bytes
'
'1 byte
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32) -> возможно можно заменить на And 3 '2 byte
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32) -> возможно можно заменить на And 3 и на сдвиг влево на четыре
'3 byte
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32) -> возможно можно заменить на And 63 и сдвиг на 2 влево
'4 byte
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32) -> возможно можно заменить на And 63
Next j
'replace " " with "`"
strTempLine = Replace(strTempLine, " ", "`") -> сделать один раз вне цикла? 'add encoded line to result buffer
strResult = strResult + strTempLine + vbLf
'reset line buffer
strTempLine = ""
Next i
Close intFile

'add the end marker
strResult = strResult & "`" & vbLf + "end" + vbLf
'asign return value
UUEncodeFile = strResult

End Function

Ну и на крайний случай можешь почитать тут:
http://forum.vingrad.ru/index.php?showtopic=15962
smile.gif
Цитата(Marvel @ 11.8.2004, 10:47)
но если появишься в Беларуси, желательно в Полоцке, то пиво с меня

Вылетаю первым рейсом smile.gif

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)