ActiveX dll и многопоточность

[neprden]

Я сам админ и програмирую редко поэтому как правило в детали не в никаю... помогите плз разобраться с activeX dll - документации как ее писать у меня нет поэтому писал "интуитивно". Так вот в ней сидит класс который пускает эхо запросы (не асинхронно ибо доку по IcmpSendEcho2 для вб не нашел) далее чтобы не отказываться от классовой модели и при этом орг-ть многопоточность цепляю его в Vb.net - там класс обертка objPing c с методом mPing который вызывает
метод ping из длл .
есть код :

Dim a1 As New objPing
Dim a2 As New objPing
a1.mAddress = "1.1.1.1" -не настоящий чтобы сработал таймаут
ф-ии IcmpSendEcho
a2.mAddress = "2.2.2.2" - реальный
Dim s1 As Threading.Thread
s1 = New Threading.Thread(AddressOf a1.mPing)
Dim s2 As Threading.Thread
s2 = New Threading.Thread(AddressOf a2.mPing)
s1.Start()
s2.Start()
при выполнении кода происходит следующее все замерает на таймаут отведенный для IcmpSendEcho а потом последовательно появляются два результата вызова , т.е ни о какой многопоточности нет в помине ..
Почему так происходит ?

[tyomitch]

Создавать объекты нужно с разных тредов. Каждый объект выполняется только в том треде, в котором был создан.

[neprden]

Создавать объекты нужно с разных тредов. Каждый объект выполняется только в том треде, в котором был создан.

ничего не изменилось
Public Sub aaa()
Dim a1 As objPing
a1 = New objPing
a1.mAddress = "1.1.1.1"
a1.mPing()
End Sub
Public Sub bbb()
Dim a2 As objPing

a2 = New objPing

a2.mAddress = "2.2.2.2"
a2.mPing()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click



Dim s1 As Threading.Thread
s1 = New Threading.Thread(AddressOf aaa)
Dim s2 As Threading.Thread
s2 = New Threading.Thread(AddressOf bbb)
s1.Start()
s2.Start()

[neprden]

вот еще на всякий случай
Public Class objPing
Public mAddress As String
Private dllPing As mdll.pngs
Public mEcho As mdll.ICMP_ECHO_REPLY_
Public mOptions As mdll.ICMP_OPTIONS_
'Public Event Complit()
Public Sub mPing()

dllPing.TIMEOUT = 4000
dllPing.DoPing(mAddress)
mEcho = dllPing.Echo
mOptions = dllPing.Echo.OPTIONS
'RaiseEvent Complit()
MsgBox(mEcho.RoundTripTime)
End Sub



Public Sub New()
dllPing = New mdll.pngs
End Sub

[neprden]

да блин я ДЛЛ ку то на vb6 писал - может скомпил как то не так ? Зачем переместили ?
вот кстати дллка
Private rwREmoteIP_ As String
Private r_echo_ As ICMP_ECHO_REPLY
Private rwData_ As String
Private rwTIMEOUT_ As Long
Private rwOPTIONS_ As IP_OPTION_INFORMATION
Public Event IcmpError(ErrorMessage As String)

Public Type ICMP_OPTIONS_
Ttl As Byte
tos As Byte
Flags As Byte
OptionsSize As Byte
OptionsData As Long
End Type


Public Type ICMP_ECHO_REPLY_
RemoteAddressStr As String
RemoteAddress As Long
status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
DataPointer As Long
OPTIONS As ICMP_OPTIONS_
Data As String
strStatus As String
End Type
Public Event icmpRecive(status As Long, eRTT As Long, eTTL As Byte, eRAddress As String)

Public Property Get DataForSend() As String
DataForSend = rwData_
End Property
Public Property Let DataForSend(newstr As String)
rwData_ = newstr
End Property

Public Property Get RemoteIP() As String
RemoteIP = rwREmoteIP_
End Property
Public Property Let RemoteIP(newstr As String)
rwREmoteIP_ = newstr

End Property

Public Property Get TIMEOUT() As Long
TIMEOUT = rwTIMEOUT_
End Property
Public Property Let TIMEOUT(newstr As Long)
rwTIMEOUT_ = newstr

End Property
Public Property Get OPTIONS_TTL() As Long
OPTIONS_TTL = rwOPTIONS_.Ttl
End Property
Public Property Let OPTIONS_TTL(newstr As Long)
rwOPTIONS_.Ttl = newstr

End Property

Public Property Get OPTIONS_TOS() As Long
OPTIONS_TOS = rwOPTIONS_.tos
End Property
Public Property Let OPTIONS_TOS(newstr As Long)
rwOPTIONS_.tos = newstr

End Property

Public Property Get OPTIONS_FLAG() As Long
OPTIONS_FLAG = rwOPTIONS_.Flags
End Property
Public Property Let OPTIONS_FLAG(newstr As Long)
rwOPTIONS_.Flags = newstr

End Property

Public Property Get OPTIONS_LEN_OPT() As Long
OPTIONS_LEN_OPT = rwOPTIONS_.OptionsSize
End Property
Public Property Let OPTIONS_LEN_OPT(newstr As Long)
rwOPTIONS_.OptionsSize = newstr

End Property
Public Property Get OPTIONS_OPT() As String
OPTIONS_OPT = rwOPTIONS_.OptionsData
End Property
Public Property Let OPTIONS_OPT(newstr As String)
rwOPTIONS_.OptionsData = newstr

End Property

Public Property Get RTT() As String
RTT = r_echo_.RoundTripTime
End Property

Public Property Get Echo() As ICMP_ECHO_REPLY_
If r_echo_.Address <> 0 Then
Echo.RemoteAddressStr = GetIPStrFromLOng(r_echo_.Address)
Echo.RemoteAddress = r_echo_.Address
End If
If r_echo_.DataSize > 0 Then Echo.Data = Left(r_echo_.Data, r_echo_.DataSize)
Echo.DataPointer = r_echo_.DataPointer
Echo.DataSize = r_echo_.DataSize
Echo.OPTIONS.Flags = r_echo_.OPTIONS.Flags
Echo.OPTIONS.OptionsData = r_echo_.OPTIONS.OptionsData
Echo.OPTIONS.OptionsSize = r_echo_.OPTIONS.OptionsSize
Echo.OPTIONS.tos = r_echo_.OPTIONS.tos
Echo.OPTIONS.Ttl = r_echo_.OPTIONS.Ttl
Echo.Reserved = r_echo_.Reserved
Echo.RoundTripTime = r_echo_.RoundTripTime
Echo.status = r_echo_.status
Echo.strStatus = GetStatusCode(r_echo_.status)
End Property



Public Function DoPing(Optional mIpAddress As String) As Long
Dim nultmp As ICMP_ECHO_REPLY
Dim errm As String
Dim ret As Long
If mIpAddress <> "" Then rwREmoteIP_ = mIpAddress
ret = Ping(rwREmoteIP_, r_echo_, rwOPTIONS_, errm, rwData_, rwTIMEOUT_)
If ret = 0 Then
RaiseEvent IcmpError(errm)
r_echo_ = nultmp
Exit Function
End If
RaiseEvent icmpRecive(r_echo_.status, r_echo_.RoundTripTime, r_echo_.OPTIONS.Ttl, GetIPStrFromLOng(r_echo_.Address))
DoPing = r_echo_.status
End Function

Public Function doConvertIpToString(ByVal iPaddress As Long) As String
doConvertIpToString = GetIPStrFromLOng(iPaddress)
End Function






Private Sub Class_Initialize()

rwTIMEOUT_ = PING_TIMEOUT
r_echo_.RoundTripTime = 0

End Sub

[GSerg]

neprden, топик я обратно перенесу, а ты оформи код как положено. Или же потрём, как непотребство и всё такое.

[neprden]

1. св-ва класса :
Instancing=5
Persistable=1
правильно ?
2. как положено ето так ?

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

Private rwREmoteIP_ As String
Private r_echo_ As ICMP_ECHO_REPLY
Private rwData_ As String
Private rwTIMEOUT_ As Long
Private rwOPTIONS_ As IP_OPTION_INFORMATION
Public Event IcmpError(ErrorMessage As String)

Public Type ICMP_OPTIONS_
Ttl             As Byte
tos             As Byte
Flags           As Byte
OptionsSize     As Byte
OptionsData     As Long
End Type


Public Type ICMP_ECHO_REPLY_
RemoteAddressStr         As String
RemoteAddress As Long
status          As Long
RoundTripTime   As Long
DataSize        As Integer
Reserved        As Integer
DataPointer     As Long
OPTIONS         As ICMP_OPTIONS_
Data            As String
strStatus As String
End Type

Public Event icmpRecive(status As Long, eRTT As Long, eTTL As Byte, eRAddress As String)

Public Property Get DataForSend() As String
DataForSend = rwData_
End Property
Public Property Let DataForSend(newstr As String)
rwData_ = newstr
End Property

Public Property Get RemoteIP() As String
RemoteIP = rwREmoteIP_
End Property
Public Property Let RemoteIP(newstr As String)
rwREmoteIP_ = newstr
End Property

Public Property Get TIMEOUT() As Long
TIMEOUT = rwTIMEOUT_
End Property
Public Property Let TIMEOUT(newstr As Long)
rwTIMEOUT_ = newstr
End Property
Public Property Get OPTIONS_TTL() As Long
OPTIONS_TTL = rwOPTIONS_.Ttl
End Property
Public Property Let OPTIONS_TTL(newstr As Long)
rwOPTIONS_.Ttl = newstr
End Property

Public Property Get OPTIONS_TOS() As Long
OPTIONS_TOS = rwOPTIONS_.tos
End Property
Public Property Let OPTIONS_TOS(newstr As Long)
rwOPTIONS_.tos = newstr
End Property

Public Property Get OPTIONS_FLAG() As Long
OPTIONS_FLAG = rwOPTIONS_.Flags
End Property
Public Property Let OPTIONS_FLAG(newstr As Long)
rwOPTIONS_.Flags = newstr
End Property

Public Property Get OPTIONS_LEN_OPT() As Long
OPTIONS_LEN_OPT = rwOPTIONS_.OptionsSize
End Property
Public Property Let OPTIONS_LEN_OPT(newstr As Long)
rwOPTIONS_.OptionsSize = newstr
End Property
Public Property Get OPTIONS_OPT() As String
OPTIONS_OPT = rwOPTIONS_.OptionsData
End Property
Public Property Let OPTIONS_OPT(newstr As String)
rwOPTIONS_.OptionsData = newstr
End Property

Public Property Get RTT() As String
RTT = r_echo_.RoundTripTime
End Property

Public Property Get Echo() As ICMP_ECHO_REPLY_
If r_echo_.Address <> 0 Then
Echo.RemoteAddressStr = GetIPStrFromLOng(r_echo_.Address)
Echo.RemoteAddress = r_echo_.Address
End If
If r_echo_.DataSize > 0 Then Echo.Data = Left(r_echo_.Data, r_echo_.DataSize)
Echo.DataPointer = r_echo_.DataPointer
Echo.DataSize = r_echo_.DataSize
Echo.OPTIONS.Flags = r_echo_.OPTIONS.Flags
Echo.OPTIONS.OptionsData = r_echo_.OPTIONS.OptionsData
Echo.OPTIONS.OptionsSize = r_echo_.OPTIONS.OptionsSize
Echo.OPTIONS.tos = r_echo_.OPTIONS.tos
Echo.OPTIONS.Ttl = r_echo_.OPTIONS.Ttl
Echo.Reserved = r_echo_.Reserved
Echo.RoundTripTime = r_echo_.RoundTripTime
Echo.status = r_echo_.status
Echo.strStatus = GetStatusCode(r_echo_.status)
End Property

Public Function DoPing(Optional mIpAddress As String) As Long
Dim nultmp As ICMP_ECHO_REPLY
Dim errm As String
Dim ret As Long
If mIpAddress <> "" Then rwREmoteIP_ = mIpAddress
ret = Ping(rwREmoteIP_, r_echo_, rwOPTIONS_, errm, rwData_, rwTIMEOUT_)
If ret = 0 Then
RaiseEvent IcmpError(errm)
r_echo_ = nultmp
Exit Function
End If
RaiseEvent icmpRecive(r_echo_.status, r_echo_.RoundTripTime, r_echo_.OPTIONS.Ttl, GetIPStrFromLOng(r_echo_.Address))
DoPing = r_echo_.status
End Function

Public Function doConvertIpToString(ByVal iPaddress As Long) As String
doConvertIpToString = GetIPStrFromLOng(iPaddress)
End Function

Private Sub Class_Initialize()
rwTIMEOUT_ = PING_TIMEOUT
r_echo_.RoundTripTime = 0
End Sub


[lister]

2. как положено ето так ?

Желательно иерархически и с использованием [syntax="vb"] [/syntax]- так читать удобнее, а то все глаза сломаешь, пока вникаешь