?
Solved

Reading current connections

Posted on 2003-03-27
6
Medium Priority
?
151 Views
Last Modified: 2008-03-17
Hi!

I need to read a PCs current connections, something like the DOS command NETSTAT does...

At the moment, I'm using

Shell("command.com /c " & "netstat -> " & Chr(34) & AppPath & "netstat.txt" & Chr(34), vbHide)

and then reading this information into memory, extracting the data with a couple of basic IFs and Right()s etc

However I'm sure there is an easier way!

The information I need to extract is:

1) The resolved DNS (not ip) address
2) The local port used
and
3) If the connection is currently established (ie not SYN_SENT or CLOSE_WAIT as it says in NETSTAT)

Thanks!
0
Comment
Question by:rjdown
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
6 Comments
 

Accepted Solution

by:
gepi earned 80 total points
ID: 8223000
go to http://www.allapi.net/ and download the Api - Guide application. From there I've taked this example.


Option Explicit

'Paste this code into a module and set the Startup Object
'to 'Sub Main'
'(To set the startup object, go to
'Project->Project Properties->General Tab->Startup Object)

Public Const MAX_HOSTNAME_LEN = 132
Public Const MAX_DOMAIN_NAME_LEN = 132
Public Const MAX_SCOPE_ID_LEN = 260
Public Const MAX_ADAPTER_NAME_LENGTH = 260
Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132
Public Const ERROR_BUFFER_OVERFLOW = 111
Public Const MIB_IF_TYPE_ETHERNET = 1
Public Const MIB_IF_TYPE_TOKENRING = 2
Public Const MIB_IF_TYPE_FDDI = 3
Public Const MIB_IF_TYPE_PPP = 4
Public Const MIB_IF_TYPE_LOOPBACK = 5
Public Const MIB_IF_TYPE_SLIP = 6

Type IP_ADDR_STRING
    Next As Long
    IpAddress As String * 16
    IpMask As String * 16
    Context As Long
End Type

Type IP_ADAPTER_INFO
    Next As Long
    ComboIndex As Long
    AdapterName As String * MAX_ADAPTER_NAME_LENGTH
    Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
    AddressLength As Long
    Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
    Index As Long
    Type As Long
    DhcpEnabled As Long
    CurrentIpAddress As Long
    IpAddressList As IP_ADDR_STRING
    GatewayList As IP_ADDR_STRING
    DhcpServer As IP_ADDR_STRING
    HaveWins As Boolean
    PrimaryWinsServer As IP_ADDR_STRING
    SecondaryWinsServer As IP_ADDR_STRING
    LeaseObtained As Long
    LeaseExpires As Long
End Type

Type FIXED_INFO
    HostName As String * MAX_HOSTNAME_LEN
    DomainName As String * MAX_DOMAIN_NAME_LEN
    CurrentDnsServer As Long
    DnsServerList As IP_ADDR_STRING
    NodeType As Long
    ScopeId  As String * MAX_SCOPE_ID_LEN
    EnableRouting As Long
    EnableProxy As Long
    EnableDns As Long
End Type

Public Declare Function GetNetworkParams Lib "IPHlpApi" (FixedInfo As Any, pOutBufLen As Long) As Long
Public Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As Any, pOutBufLen As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Sub main()
    'This example was created by George Bernier (bernig@dinomail.qc.ca)
    Dim error As Long
    Dim FixedInfoSize As Long
    Dim AdapterInfoSize As Long
    Dim i As Integer
    Dim PhysicalAddress  As String
    Dim NewTime As Date
    Dim AdapterInfo As IP_ADAPTER_INFO
    Dim Adapt As IP_ADAPTER_INFO
    Dim AddrStr As IP_ADDR_STRING
    Dim FixedInfo As FIXED_INFO
    Dim Buffer As IP_ADDR_STRING
    Dim pAddrStr As Long
    Dim pAdapt As Long
    Dim Buffer2 As IP_ADAPTER_INFO
    Dim FixedInfoBuffer() As Byte
    Dim AdapterInfoBuffer() As Byte
   
    'Get the main IP configuration information for this machine using a FIXED_INFO structure
    FixedInfoSize = 0
    error = GetNetworkParams(ByVal 0&, FixedInfoSize)
    If error <> 0 Then
        If error <> ERROR_BUFFER_OVERFLOW Then
           MsgBox "GetNetworkParams sizing failed with error " & error
           Exit Sub
        End If
    End If
    ReDim FixedInfoBuffer(FixedInfoSize - 1)

    error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)
    If error = 0 Then
            CopyMemory FixedInfo, FixedInfoBuffer(0), Len(FixedInfo)
            MsgBox "Host Name:  " & FixedInfo.HostName 'host name
            MsgBox "DNS Servers:  " & FixedInfo.DnsServerList.IpAddress 'dns server IP
            pAddrStr = FixedInfo.DnsServerList.Next
            Do While pAddrStr <> 0
                  CopyMemory Buffer, ByVal pAddrStr, Len(Buffer)
                  MsgBox "DNS Servers:  " & Buffer.IpAddress 'dns server IP
                  pAddrStr = Buffer.Next
            Loop
           
            Select Case FixedInfo.NodeType 'node type
                       Case 1
                                  MsgBox "Node type: Broadcast"
                       Case 2
                                   MsgBox "Node type: Peer to peer"
                       Case 4
                                    MsgBox "Node type: Mixed"
                       Case 8
                                    MsgBox "Node type: Hybrid"
                       Case Else
                                    MsgBox "Unknown node type"
            End Select
           
            MsgBox "NetBIOS Scope ID:  " & FixedInfo.ScopeId 'scope ID
            'routing
            If FixedInfo.EnableRouting Then
                       MsgBox "IP Routing Enabled "
            Else
                       MsgBox "IP Routing not enabled"
            End If
            ' proxy
            If FixedInfo.EnableProxy Then
                       MsgBox "WINS Proxy Enabled "
            Else
                       MsgBox "WINS Proxy not Enabled "
            End If
            ' netbios
            If FixedInfo.EnableDns Then
                      MsgBox "NetBIOS Resolution Uses DNS "
            Else
                      MsgBox "NetBIOS Resolution Does not use DNS  "
            End If
    Else
            MsgBox "GetNetworkParams failed with error " & error
            Exit Sub
    End If
   
    'Enumerate all of the adapter specific information using the IP_ADAPTER_INFO structure.
    'Note:  IP_ADAPTER_INFO contains a linked list of adapter entries.
   
    AdapterInfoSize = 0
    error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
    If error <> 0 Then
        If error <> ERROR_BUFFER_OVERFLOW Then
           MsgBox "GetAdaptersInfo sizing failed with error " & error
           Exit Sub
        End If
    End If
   ReDim AdapterInfoBuffer(AdapterInfoSize - 1)
 
 ' Get actual adapter information
   error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
   If error <> 0 Then
      MsgBox "GetAdaptersInfo failed with error " & error
      Exit Sub
   End If
   CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)
   pAdapt = AdapterInfo.Next

   Do While pAdapt <> 0
        CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
          Select Case Buffer2.Type
                Case MIB_IF_TYPE_ETHERNET
                    MsgBox "Ethernet adapter "
                Case MIB_IF_TYPE_TOKENRING
                    MsgBox "Token Ring adapter "
                Case MIB_IF_TYPE_FDDI
                    MsgBox "FDDI adapter "
                Case MIB_IF_TYPE_PPP
                    MsgBox "PPP adapter"
                Case MIB_IF_TYPE_LOOPBACK
                    MsgBox "Loopback adapter "
                Case MIB_IF_TYPE_SLIP
                    MsgBox "Slip adapter "
                Case Else
                    MsgBox "Other adapter "
        End Select
    MsgBox " AdapterName: " & Buffer2.AdapterName
    MsgBox "AdapterDescription: " & Buffer2.Description 'adatpter name

    For i = 0 To Buffer2.AddressLength - 1
           PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))
            If i < Buffer2.AddressLength - 1 Then
             PhysicalAddress = PhysicalAddress & "-"
            End If

    Next
    MsgBox "Physical Address: " & PhysicalAddress 'mac address
    If Buffer2.DhcpEnabled Then
            MsgBox "DHCP Enabled "
    Else
            MsgBox "DHCP disabled"
    End If

    pAddrStr = Buffer2.IpAddressList.Next
    Do While pAddrStr <> 0
           CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer)
           MsgBox "IP Address: " & Buffer.IpAddress
           MsgBox "Subnet Mask: " & Buffer.IpMask
           pAddrStr = Buffer.Next
           If pAddrStr <> 0 Then
            CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, Len(Buffer2.IpAddressList)
           End If
   Loop
    MsgBox "Default Gateway: " & Buffer2.GatewayList.IpAddress
    pAddrStr = Buffer2.GatewayList.Next
    Do While pAddrStr <> 0
            CopyMemory Buffer, Buffer2.GatewayList, Len(Buffer)
            MsgBox "IP Address: " & Buffer.IpAddress
            pAddrStr = Buffer.Next
            If pAddrStr <> 0 Then
            CopyMemory Buffer2.GatewayList, ByVal pAddrStr, Len(Buffer2.GatewayList)
            End If
    Loop

    MsgBox "DHCP Server: " & Buffer2.DhcpServer.IpAddress
    MsgBox "Primary WINS Server: " & Buffer2.PrimaryWinsServer.IpAddress
    MsgBox "Secondary WINS Server: " & Buffer2.SecondaryWinsServer.IpAddress

    ' Display time
    NewTime = CDate(Adapt.LeaseObtained)
    MsgBox "Lease Obtained: " & CStr(NewTime)

    NewTime = CDate(Adapt.LeaseExpires)
    MsgBox "Lease Expires :  " & CStr(NewTime)
    pAdapt = Buffer2.Next
    If pAdapt <> 0 Then
        CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)
    End If

   Loop
   
End Sub

0
 
LVL 6

Author Comment

by:rjdown
ID: 8225293
:O well I did ask for an EASIER way lol..
0
 
LVL 6

Author Comment

by:rjdown
ID: 8225304
:O well I did ask for an EASIER way lol..
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 6

Author Comment

by:rjdown
ID: 8227391
ahh cmon there MUST be a way without all this code :(
0
 
LVL 6

Author Comment

by:rjdown
ID: 8257335
hmm

well I followed the link you gave, and managed to find some suitable code. Thanks :)
0
 

Expert Comment

by:gepi
ID: 8259064
For nothing :)
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses
Course of the Month7 days, 20 hours left to enroll

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question