Вобщем такая проблема, я использую контрол Dasharma, все хорошо, но НОД 32 и некоторые другие антивирусы злостно палят там троян VB, я определил из за чего, но как не пытался исправить не чего не вышло.
Вот код контрола, закоментированы места из за которых эта хрень.
Private Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription As String * 257
szSystemStatus As String * 129
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Type sockaddr_in
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero(1 To 8) As Byte
End Type
Public Enum AlertVars
Yes = 0
No = 1
End Enum
Public Enum StateVars
Connecting = 0
Connected = 1
Sending = 2
Sended = 3
Recving = 4
Listening = 5
Accepted = 6
End Enum
Event DataArrival(Data As String)
Event Accepted(IP As String)
Event Connected(IP As String, port As Long)
Event ConnectError()
Private Declare Function gethostname Lib "ws2_32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
Private Declare Function getpeername Lib "ws2_32.dll" (ByVal so As Long, ByRef stru As sockaddr_in, ByRef strulen As Long) As Long
Private Declare Function gethostbyname Lib "wsock32" (ByVal hostname As String) As Long
Private Declare Function inet_ntoa Lib "ws2_32.dll" (ByVal inn As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nbytes As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long
Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSAData) As Long
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Private Declare Function htonl Lib "ws2_32.dll" (ByVal hostlong As Long) As Long
Private Declare Function Socket Lib "ws2_32.dll" Alias "socket" (ByVal afi As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function Con Lib "ws2_32.dll" Alias "connect" (ByVal s As Long, ByRef name As sockaddr_in, ByVal namelen As Long) As Long
Private Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal BufLen As Long, ByVal flags As Long) As Long
Private Declare Function Lis Lib "ws2_32.dll" Alias "listen" (ByVal s As Long, ByVal backlog As Long) As Long
Private Declare Function VBind Lib "ws2_32.dll" Alias "bind" (ByVal s As Long, ByRef name As sockaddr_in, ByRef namelen As Long) As Long
Private Declare Function WSAAsyncSelect Lib "ws2_32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Private Declare Function accept Lib "ws2_32.dll" (ByVal s As Long, addr As sockaddr_in, addrlen As Long) As Long
Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As Any, ByVal BufLen As Long, ByVal flags As Long) As Long
Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Private Const MAXCONN = &H7FFFFFFF
Private Const FD_READ = &H1
Private Const FD_ACCEPT = &H8
Private Const FD_CONNECT = &H10
Private Const FD_CLOSE = &H20
Public AlertMode As AlertVars
Public LocalIP As String
Public LocalName As String
Public State As StateVars
Public ConnectedRemoteIP As String
Dim NewSocket As Long
Dim IncSocket As Long
Dim aSocket As Long
Dim imClient As Boolean
Dim tmppIP As String
Dim tmppPort As Long
Public Function Connect(Host As String, port As Long)
Dim IP As String
tmppIP = Host
tmppPort = port
Dim cStruct As sockaddr_in
Dim retV As Long
If Left(Host, 1) <> 1 Or Left(Host, 1) <> 2 Then IP = GetIPFromHostName(Host)
cStruct.sin_addr = inet_addr(IP)
cStruct.sin_family = 2
'cStruct.sin_port = htons(port)
State = Connecting
closesocket NewSocket
closesocket aSocket
NewSocket = Socket(2, 1, 6)
WSAAsyncSelect NewSocket, inCON.hwnd, &H202, FD_CONNECT
'retV = Con(NewSocket, cStruct, Len(cStruct))
aSocket = NewSocket
End Function
Public Function SendData(Data As String) As Boolean
If Data = "" Then Exit Function
Dim sB() As Byte
Dim sBytes As Long
Dim LensB As Long
LensB = Len(Data)
sB() = StrConv(Data, vbFromUnicode)
sBytes = send(aSocket, sB(0), LensB, 0&)
If sBytes = -1 Then
If AlertMode = Yes Then MsgBox "Невозможно передать данные!", vbCritical, "Ошибка"
SendData = False
Else
SendData = True
State = Sended
End If
End Function
Public Function Listen(port As Long) As Boolean
closesocket aSocket
Dim sST As sockaddr_in
Dim tRe
sST.sin_addr = &H0
sST.sin_family = 2
'sST.sin_port = htons(port)
IncSocket = Socket(2, 1, 6)
tRe = VBind(IncSocket, sST, LenB(sST))
If tRe = -1 Then
If AlertMode = Yes Then MsgBox "Невозможно слушать порт, наверное он занят", vbCritical, "Ошибка"
Listen = False
Else
Listen = True
State = Listening
End If
tRe = Lis(IncSocket, MAXCONN)
tRe = WSAAsyncSelect(IncSocket, inC.hwnd, &H202, FD_CONNECT Or FD_ACCEPT)
End Function
Public Sub CloseConnection()
closesocket NewSocket
closesocket IncSocket
closesocket aSocket
End Sub
Private Sub inC_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ns As sockaddr_in
Dim vRE As Long
aSocket = accept(IncSocket, ns, Len(ns))
'ConnectedRemoteIP = Convert(inet_ntoa(ns.sin_addr))
RaiseEvent Accepted(ConnectedRemoteIP)
WSAAsyncSelect aSocket, inD.hwnd, &H202, FD_READ Or FD_CLOSE
End Sub
Private Sub inCON_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim nst As sockaddr_in
Dim rVal As Long
'rVal = getpeername(aSocket, nst, Len(nst))
If rVal = -1 Then
closesocket NewSocket
closesocket aSocket
If AlertMode = Yes Then MsgBox "Невозможно установить коннект к хосту " & Host, vbCritical, "Ошибка"
RaiseEvent ConnectError
Exit Sub
End If
State = Connected
imClient = True
RaiseEvent Connected(tmppIP, tmppPort)
WSAAsyncSelect aSocket, inD.hwnd, &H202, FD_READ Or FD_CLOSE
End Sub
Private Sub inD_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim incData As String
incData = GetData
If incData = "" Then
If imClient = True Then Exit Sub
WSAAsyncSelect IncSocket, inC.hwnd, &H202, FD_CONNECT Or FD_ACCEPT
Else
RaiseEvent DataArrival(incData)
End If
End Sub
Private Function GetData() As String
Dim bytes As Long
Dim RB As String * 16384
Dim Data As String
bytes = recv(aSocket, RB, 16384, 0)
If bytes > 0 Then
Data = Left$(RB, bytes)
GetData = Data
Else
GetData = ""
End If
End Function
Private Sub UserControl_Initialize()
Dim ws As WSAData
'WSAStartup &H202, ws
Dim MyName As String * 255
gethostname MyName, 255
LocalName = MyName
LocalIP = GetIPFromHostName(MyName)
End Sub
Private Function GetIPFromHostName(ByVal sHostName As String) As String
Dim nbytes As Long
Dim ptrHosent As Long
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String
sAddress = Space$(4)
'ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent <> 0 Then
ptrAddress = ptrHosent + 12
CopyMemory ptrAddress, ByVal ptrAddress, 4
CopyMemory ptrIPAddress, ByVal ptrAddress, 4
CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
GetIPFromHostName = IPToText(sAddress)
End If
End Function
Private Function IPToText(ByVal IPAddress As String) As String
IPToText = CStr(Asc(IPAddress)) & "." & _
CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function
Private Function Convert(ByVal Inp As Long) As String
Dim pr As String
Dim re As Long
pr = String$(lstrlen(ByVal Inp), 0)
're = lstrcpy(ByVal pr, ByVal Inp)
If re Then Convert = pr
End Function
Private Sub UserControl_Resize()
Width = 465
Height = 390
End Sub
Private Sub UserControl_Terminate()
closesocket NewSocket
closesocket IncSocket
closesocket aSocket
End Sub
Ответить
|