form1.frm

vb 程序基础设计与编程对初学者会有很大帮助

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "获取IP地址"
   ClientHeight    =   4140
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6300
   LinkTopic       =   "Form1"
   ScaleHeight     =   4140
   ScaleWidth      =   6300
   StartUpPosition =   3  '窗口缺省
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   240
      Top             =   2880
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.TextBox Text3 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000007&
      Height          =   400
      Left            =   2000
      TabIndex        =   6
      Top             =   1920
      Width           =   3000
   End
   Begin VB.TextBox Text2 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000007&
      Height          =   400
      Left            =   2000
      TabIndex        =   5
      Top             =   1320
      Width           =   3000
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000007&
      Height          =   400
      Left            =   2000
      TabIndex        =   1
      Top             =   720
      Width           =   3000
   End
   Begin VB.CommandButton Command1 
      Caption         =   "运  行"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1680
      TabIndex        =   0
      Top             =   3000
      Width           =   2535
   End
   Begin VB.Label Label3 
      Caption         =   "计算机名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   500
      TabIndex        =   4
      Top             =   1920
      Width           =   1500
   End
   Begin VB.Label Label2 
      Caption         =   "IP地址："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   500
      TabIndex        =   3
      Top             =   1320
      Width           =   1500
   End
   Begin VB.Label Label1 
      Caption         =   "适配器地址："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   500
      TabIndex        =   2
      Top             =   720
      Width           =   1500
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32

Private Type NCB
  ncb_command As Byte
  ncb_retcode As Byte
  ncb_lsn As Byte
  ncb_num As Byte
  ncb_buffer As Long
  ncb_length As Integer
  ncb_callname As String * NCBNAMSZ
  ncb_name As String * NCBNAMSZ
  ncb_rto As Byte
  ncb_sto As Byte
  ncb_post As Long
  ncb_lana_num As Byte
  ncb_cmd_cplt As Byte
  ncb_reserve(9) As Byte  ' Reserved, must be 0
  ncb_event As Long
End Type

Private Type ADAPTER_STATUS
  adapter_address(5) As Byte
  rev_major As Byte
  reserved0 As Byte
  adapter_type As Byte
  rev_minor As Byte
  duration As Integer
  frmr_recv As Integer
  frmr_xmit As Integer
  iframe_recv_err As Integer
  xmit_aborts As Integer
  xmit_success As Long
  recv_success As Long
  iframe_xmit_err As Integer
  recv_buff_unavail As Integer
  t1_timeouts As Integer
  ti_timeouts As Integer
  Reserved1 As Long
  free_ncbs As Integer
  max_cfg_ncbs As Integer
  max_ncbs As Integer
  xmit_buf_unavail As Integer
  max_dgram_size As Integer
  pending_sess As Integer
  max_cfg_sess As Integer
  max_sess As Integer
  max_sess_pkt_size As Integer
  name_count As Integer
End Type

Private Type NAME_BUFFER
  name As String * NCBNAMSZ
  name_num As Integer
  name_flags As Integer
End Type

Private Type ASTAT
  adapt As ADAPTER_STATUS
  NameBuff(30) As NAME_BUFFER
End Type

Private Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

Private Function EthernetAddress(LanaNumber As Long) As String
  Dim udtNCB       As NCB
  Dim bytResponse  As Byte
  Dim udtASTAT     As ASTAT
  Dim udtTempASTAT As ASTAT
  Dim lngASTAT     As Long
  Dim strOut       As String
  Dim x            As Integer

  udtNCB.ncb_command = NCBRESET
  bytResponse = Netbios(udtNCB)
  udtNCB.ncb_command = NCBASTAT
  udtNCB.ncb_lana_num = LanaNumber
  udtNCB.ncb_callname = "* "
  udtNCB.ncb_length = Len(udtASTAT)
  lngASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length)
  strOut = ""
  If lngASTAT Then
    udtNCB.ncb_buffer = lngASTAT
    bytResponse = Netbios(udtNCB)
    CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
     With udtASTAT.adapt
      For x = 0 To 5
        strOut = strOut & "-" & Right$("00" & Hex$(.adapter_address(x)), 2)
      Next x
    End With
    HeapFree GetProcessHeap(), 0, lngASTAT
  End If
  EthernetAddress = strOut
End Function

Private Sub Command1_Click()
  Text1.Text = Right$(EthernetAddress(0), 17)
  Text2.Text = Winsock1.LocalIP
  Text3.Text = Winsock1.LocalHostName
End Sub