frmmain.frm

在本机取得计算机上所有IP地址的代码

VERSION 5.00
Begin VB.Form FrmMain 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   0  'None
   Caption         =   "取得IP地址"
   ClientHeight    =   3735
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4575
   Icon            =   "FrmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   249
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   305
   StartUpPosition =   2  '屏幕中心
   Begin 取得IP地址.MyButton CmdGet 
      Height          =   375
      Left            =   2640
      TabIndex        =   3
      Top             =   3240
      Width           =   1815
      _ExtentX        =   3201
      _ExtentY        =   661
      SPN             =   "MyButtonDefSkin"
      Text            =   "取得IP地址(&G)"
      AccessKey       =   "G"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   16777215
   End
   Begin VB.TextBox TxtShow 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00000000&
      Height          =   2655
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   480
      Width           =   4335
   End
   Begin 取得IP地址.MicTitleBar MicTitleBar1 
      Height          =   360
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   4575
      _ExtentX        =   8070
      _ExtentY        =   635
   End
   Begin VB.PictureBox MyButtonDefSkin 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      ForeColor       =   &H00000000&
      Height          =   315
      Left            =   0
      Picture         =   "FrmMain.frx":0ECA
      ScaleHeight     =   21
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   150
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   2250
   End
   Begin VB.Label LblInfo 
      BackStyle       =   0  'Transparent
      Caption         =   "本程序使用TechnoFantasy技术制作而成。"
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   3240
      Width           =   2415
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const MAX_IP = 255
Private Type IPINFO
        dwAddr As Long
        dwIndex As Long
        dwMask As Long
        dwBCastAddr As Long
        dwReasmSize As Long
        unused1 As Integer
        unused2 As Integer
End Type
Private Type MIB_IPADDRTABLE
        dEntrys As Long
        mIPInfo(MAX_IP) As IPINFO
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 Function GetIPAddress() As String
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim StrIP As String
Dim Listing As MIB_IPADDRTABLE
On Error GoTo ERROR
  GetIpAddrTable ByVal 0&, Ret, True
  If Ret <= 0 Then Exit Function
  ReDim bBytes(0 To Ret - 1) As Byte
  GetIpAddrTable bBytes(0), Ret, False
  CopyMemory Listing.dEntrys, bBytes(0), 4
  StrIP = "你电脑上有 " & Listing.dEntrys & " 个 IP 地址。" & vbCrLf
  StrIP = StrIP & "----------------------------------------------" & vbCrLf
  For Tel = 0 To Listing.dEntrys - 1
  CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
  StrIP = StrIP & "IP 地址：" & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
  StrIP = StrIP & "子网掩码：" & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf
  StrIP = StrIP & "广播地址：" & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf
  StrIP = StrIP & "----------------------------------------------" & vbCrLf
  Next Tel
  GetIPAddress = StrIP
ERROR: If Err.Number <> 0 Then GetIPAddress = "无法正确取得IP地址，请检查您的配置。"
End Function

Private Sub CmdGet_Click()
TxtShow.Text = GetIPAddress
End Sub