[Ghoghnus]

سُلام دوستان با این کد ها میتونید ipسیتم خودتون را بدست بیارید!

کد:

Option Explicit

Private Const MAX_IP = 10

Private 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 used
    unused2 As Integer ' not used
End Type

Private Type MIB_IPADDRTABLE
    dEntrys As Long   'number of entries in the table
    mIPInfo(MAX_IP) As IPINFO  'array of IP address entries
End Type

Private Type IP_Array
    mBuffer As MIB_IPADDRTABLE
    BufferLen As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long



Private 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


Private Sub Form_Load()
   Dim Ret As Long, Tel As Long
  Dim bBytes() As Byte
  Dim Listing As MIB_IPADDRTABLE
  
  On Error GoTo END1
  
  GetIpAddrTable ByVal 0&, Ret, True
  
  If Ret <= 0 Then Exit Sub
  
  ReDim bBytes(0 To Ret - 1) As Byte
  
  GetIpAddrTable bBytes(0), Ret, False
  CopyMemory Listing.dEntrys, bBytes(0), 4

  For Tel = 0 To Listing.dEntrys - 1
     CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
    
    If ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) <> "0.0.0.0" _
    And Trim$(ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr)) <> "" Then
     Form1.Text1 = Form1.Text1 & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
    End If
  
  Next
Exit Sub
END1:
MsgBox "ERROR"
End Sub