Winsock

Nabend,
ich musste gerade merkeb wie einfach es ist sich in VB seine IP Anzeigen zu lassen. Winsock Control an und …

Label1.Caption = Winsock1.LocalIP

Aber was ist mit Local SubNet und Local Gateway ? finde nix.

mfg Joe

Hi Joe,

Du solltest Dir wirklich mal die API-Guide laden, dann muß ich die hier nicht einzeln kopieren. Du weißt ja, daß mir dabei auch Fehler passieren … :smile:

IP-Adressen und Subnetmask:

'This project requires the following components:
' - a form (Form1) with a textbox (Text1, Multiline=True)
' and a command button (Command1)
' - a module (Module1)

'in Form1:
Private Sub Command1\_Click()
 Module1.Start
End Sub

'In Module1:

'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'Created By Verburgh Peter.
' 07-23-2001
' [email protected]
'-------------------------------------
'With this small application , you can detect the IP's installed on your computer,
'including subnet mask , BroadcastAddr..
'
'I've wrote this because i've a programm that uses the winsock control, but,
'if you have multiple ip's installed on your pc , you could get by using the Listen
' method the wrong ip ...
'Because Winsock.Localip =\> detects the default ip installed on your PC ,
' and in most of the cases it could be the LAN (nic) not the WAN (nic)
'So then you have to use the Bind function ,to bind to your right ip..
'but how do you know & find that ip ?
'you can find it now by this appl.. it check's in the api.. IP Table..
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*


Const MAX\_IP = 5 'To make a buffer... i dont think you have more than 5 ip on your pc..

Type IPINFO
 dwAddr As Long ' IP address
 dwIndex As Long ' interface index
 dwMask As Long ' subnet mask
 dwBCastAddr As Long ' broadcast address
 dwReasmSize As Long ' assembly size
 unused1 As Integer ' not currently used
 unused2 As Integer '; not currently used
End Type

Type MIB\_IPADDRTABLE
 dEntrys As Long 'number of entries in the table
 mIPInfo(MAX\_IP) As IPINFO 'array of IP address entries
End Type

Type IP\_Array
 mBuffer As MIB\_IPADDRTABLE
 BufferLen As Long
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Sub main()
Form1.Show
End Sub

'converts a Long to a string
Public Function ConvertAddressToString(longAddr As Long) As String
 Dim myByte(3) As Byte
 Dim Cnt As Long
 CopyMemory myByte(0), longAddr, 4
 For Cnt = 0 To 3
 ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
 Next Cnt
 ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function

Public Sub Start()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB\_IPADDRTABLE

Form1.Text1 = ""

On Error GoTo END1
 GetIpAddrTable ByVal 0&, Ret, True

 If Ret Founded ip installed on your PC..
 Form1.Text1 = Listing.dEntrys & " IP addresses found on your PC !!" & vbCrLf
 Form1.Text1 = Form1.Text1 & "----------------------------------------" & vbCrLf
 For Tel = 0 To Listing.dEntrys - 1
 'Copy whole structure to Listing..
 ' MsgBox bBytes(tel) & "."
 CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel \* Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
 Form1.Text1 = Form1.Text1 & "IP address : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
 Form1.Text1 = Form1.Text1 & "IP Subnetmask : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf
 Form1.Text1 = Form1.Text1 & "BroadCast IP address : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf
 Form1.Text1 = Form1.Text1 & "\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*" & vbCrLf
 Next

'MsgBox ConvertAddressToString(Listing.mIPInfo(1).dwAddr)
Exit Sub
END1:
MsgBox "ERROR"
End Sub

Und das StandardGateway:

Const MAXLEN\_PHYSADDR = 8
Private Type MIB\_IPNETROW
 dwIndex As Long
 dwPhysAddrLen As Long
 bPhysAddr(0 To MAXLEN\_PHYSADDR - 1) As Byte
 dwAddr As Long
 dwType As Long
End Type
Private Declare Function GetIpNetTable Lib "Iphlpapi" (pIpNetTable As Byte, pdwSize As Long, ByVal bOrder As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Sub Form\_Load()
 'KPD-Team 2001
 'URL: http://www.allapi.net/
 'E-Mail: [email protected]
 Dim Listing() As MIB\_IPNETROW, Ret As Long, Cnt As Long
 Dim bBytes() As Byte, bTemp(0 To 3) As Byte
 'set the graphics mode of this form to persistent
 Me.AutoRedraw = True
 'call the function to retrieve how many bytes are needed
 GetIpNetTable ByVal 0&, Ret, False
 'if it failed, exit the sub
 If Ret 0 Then ReDim Listing(0 To Ret - 1) As MIB\_IPNETROW
 'show the data
 Me.Print "Contents of address mapping table (items: " + CStr(Ret) + ")"
 For Cnt = 0 To Ret - 1
 CopyMemory Listing(Cnt), bBytes(4 + 24 \* Cnt), 24
 CopyMemory bTemp(0), Listing(Cnt).dwAddr, 4
 Me.Print " Item " + CStr(Listing(Cnt).dwIndex)
 Me.Print " address " + ConvertAddressToString(bTemp(), 4)
 Me.Print " physical address " + ConvertAddressToString(Listing(Cnt).bPhysAddr, Listing(Cnt).dwPhysAddrLen)
 Select Case Listing(Cnt).dwType
 Case 4 'Static
 Me.Print " type: Static"
 Case 3 'Dynamic
 Me.Print " type: Dynamic"
 Case 2 'Invalid
 Me.Print " type: Invalid"
 Case 1 'Other
 Me.Print " type: Other"
 End Select
 Next Cnt
End Sub
'converts a byte array to a string
Public Function ConvertAddressToString(bArray() As Byte, lLength As Long) As String
 Dim Cnt As Long
 For Cnt = 0 To lLength - 1
 ConvertAddressToString = ConvertAddressToString + CStr(bArray(Cnt)) + "."
 Next Cnt
 ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function

Gruß, Rainer