بدست اوردن 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