Jump to content
PLC Forum

Brothers

Connessioni Attive In Vb6 - problema di funzionamento in altro progetto

Recommended Posts

Brothers

Perchè se includo in un progetto più ampio una form con questo codice

non funziona mentre da solo funziona perfettamente

Precisamente mi dice

La dichiarazione della routine non corrisponde alla descrizione dell'evento o della routine con lo stesso nome

e mi evidenzia questo codice:

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader

Che corrisponde ad una funzione per riordinare le righe

Se elimino questa funzione addizionale

esce un'altro errore:

mi dice: Tipo non corrispondente

e mi evidenzia questo codice:

Set lstLine = ListView1.ListItems.Add(, , GetInetAddrStr(.dwLocalAddr))

Non capisco come mai, se devo creare un modulo o no? o che altro.

Grazie anticipate

Sotto metto tutto il codice:

----------------------------------------------------------------

Option Explicit

Private Type MIB_TCPROW

dwState As Long

dwLocalAddr As Long

dwLocalPort As Long

dwRemoteAddr As Long

dwRemotePort As Long

End Type

Private Const ERROR_SUCCESS As Long = 0

Private Const MIB_TCP_STATE_CLOSED As Long = 1

Private Const MIB_TCP_STATE_LISTEN As Long = 2

Private Const MIB_TCP_STATE_SYN_SENT As Long = 3

Private Const MIB_TCP_STATE_SYN_RCVD As Long = 4

Private Const MIB_TCP_STATE_ESTAB As Long = 5

Private Const MIB_TCP_STATE_FIN_WAIT1 As Long = 6

Private Const MIB_TCP_STATE_FIN_WAIT2 As Long = 7

Private Const MIB_TCP_STATE_CLOSE_WAIT As Long = 8

Private Const MIB_TCP_STATE_CLOSING As Long = 9

Private Const MIB_TCP_STATE_LAST_ACK As Long = 10

Private Const MIB_TCP_STATE_TIME_WAIT As Long = 11

Private Const MIB_TCP_STATE_DELETE_TCB As Long = 12

Private Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal bcount As Long)

Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long

Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long

Private Declare Function ntohs Lib "wsock32.dll" (ByVal addr As Long) As Long

--------------------

Public Function GetInetAddrStr(Address As Long) As String

GetInetAddrStr = GetString(inet_ntoa(Address))

End Function

---------------------

Private Sub Form_Load()

With ListView1

.View = lvwReport

.ColumnHeaders.Add , , "Local IP Address"

.ColumnHeaders.Add , , "Local Port"

.ColumnHeaders.Add , , "Remote IP Address"

.ColumnHeaders.Add , , "Remote Port"

.ColumnHeaders.Add , , "Status "

End With

Timer1.Enabled = True

End Sub

----------------------------------

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)

ListView1.SortKey = ColumnHeader.Index - 1

ListView1.SortOrder = Abs(Not ListView1.SortOrder = 1)

ListView1.Sorted = True

End Sub

-------------------------------------

Public Function GetString(ByVal lpszA As Long) As String

GetString = String$(lstrlenA(ByVal lpszA), 0)

Call lstrcpyA(ByVal GetString, ByVal lpszA)

End Function

-------------------------------------

Private Sub Timer1_Timer()

Dim TcpRow As MIB_TCPROW

Dim buff() As Byte

Dim lngRequired As Long

Dim lngStrucSize As Long

Dim lngRows As Long

Dim lngCnt As Long

Dim strTmp As String

Dim lstLine As ListItem

ListView1.ListItems.Clear

Call GetTcpTable(ByVal 0&, lngRequired, 1)

If lngRequired > 0 Then

ReDim buff(0 To lngRequired - 1) As Byte

If GetTcpTable(buff(0), lngRequired, 1) = ERROR_SUCCESS Then

lngStrucSize = LenB(TcpRow)

'first 4 bytes indicate the number of entries

CopyMemory lngRows, buff(0), 4

For lngCnt = 1 To lngRows

'moves past the four bytes obtained above

'to get data and cast into a TcpRow stucture

CopyMemory TcpRow, buff(4 + (lngCnt - 1) * lngStrucSize), lngStrucSize

'sends results to the listview

With TcpRow

Set lstLine = ListView1.ListItems.Add(, , GetInetAddrStr(.dwLocalAddr))

lstLine.SubItems(1) = ntohs(.dwLocalPort)

lstLine.SubItems(2) = GetInetAddrStr(.dwRemoteAddr)

lstLine.SubItems(3) = ntohs(.dwRemotePort)

lstLine.SubItems(4) = (.dwState)

Select Case .dwState

Case MIB_TCP_STATE_CLOSED: strTmp = "closed"

Case MIB_TCP_STATE_LISTEN: strTmp = "listening"

Case MIB_TCP_STATE_SYN_SENT: strTmp = "sent"

Case MIB_TCP_STATE_SYN_RCVD: strTmp = "received"

Case MIB_TCP_STATE_ESTAB: strTmp = "established"

Case MIB_TCP_STATE_FIN_WAIT1: strTmp = "fin wait 1"

Case MIB_TCP_STATE_FIN_WAIT2: strTmp = "fin wait 1"

Case MIB_TCP_STATE_CLOSE_WAIT: strTmp = "close wait"

Case MIB_TCP_STATE_CLOSING: strTmp = "closing"

Case MIB_TCP_STATE_LAST_ACK: strTmp = "last ack"

Case MIB_TCP_STATE_TIME_WAIT: strTmp = "time wait"

Case MIB_TCP_STATE_DELETE_TCB: strTmp = "TCB deleted"

End Select

lstLine.SubItems(4) = lstLine.SubItems(4) & "( " & strTmp & " )"

strTmp = ""

End With

Next

End If

End If

End Sub

--------------------------------------------------------

Edited by Brothers
Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...