请教各位高手用vb代码实现本机自动获得ip地址的代码及方法 ？？！问题解决立即放分！

Question

请教各位高手用vb代码实现本机自动获得ip地址的代码及方法 ？？！问题解决立即放分！

Answer 1

最方便就是加载一个winsock控件
Winsock1.LocalIP

Answer 2

不是给本机设置具体的ip，而是让本机通过DHCP指派自动活动IP

Answer 3

转的,一个form 加一个 command按钮,你看看行不行?
========================================
' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : [email protected]
' * Date             : 13/10/98
' * Time             : 10:24
' * Module Name      : IP_Module
' * Module Filename  : IP.bas
' **********************************************************************
' * Comments         :
' * Find IP address ginving the hostname
' **********************************************************************'Here's sample code for gethostbyname()'Add a textbox (Text1) And a Command button (Command1) To a New form And use the following code:'Usage: Fill in the textbox with the name you want to resolve and click the command button to resolve the name.Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128Private Type HOSTENT
   hName As Long
   hAliases As Long
   hAddrType As Integer
   hLength As Integer
   hAddrList As Long
End TypePrivate Type WSADATA
   wversion As Integer
   wHighVersion As Integer
   szDescription(0 To WSADescription_Len) As Byte
   szSystemStatus(0 To WSASYS_Status_Len) As Byte
   iMaxSockets As Integer
   iMaxUdpDg As Integer
   lpszVendorInfo As Long
End TypePrivate Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : [email protected]
' * Date             : 13/10/98
' * Time             : 10:24
' * Module Name      : IP_Module
' * Module Filename  : IP.bas
' **********************************************************************
' * Comments         :
' * Find IP address ginving the hostname
' **********************************************************************Function hibyte(ByVal wParam As Integer)
   
   hibyte = wParam \ &H100 And &HFF&
   
End FunctionFunction lobyte(ByVal wParam As Integer)
   
   lobyte = wParam And &HFF&
   
End FunctionSub SocketsInitialize()
   
   Dim WSAD As WSADATA
   Dim iReturn As Integer
   Dim sLowByte As String, sHighByte As String, sMsg As String
   
   iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
   
   If iReturn <> 0 Then
      MsgBox "Winsock.dll is not responding."
      End
   End If
   
   If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
      sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
      sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
      sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
      sMsg = sMsg & " is not supported by winsock.dll "
      MsgBox sMsg
      End
   End If
   
   If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
      sMsg = "This application requires a minimum of "
      sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
      MsgBox sMsg
      End
   End If
   
End SubSub SocketsCleanup()
   Dim lReturn As Long
   
   lReturn = WSACleanup()
   
   If lReturn <> 0 Then
      MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
      End
   End If
   
End SubSub Form_Load()
   
   SocketsInitialize
   
End SubPrivate Sub Form_Unload(Cancel As Integer)
   
   SocketsCleanup
   
End SubPrivate Sub Command1_click()
   Dim hostent_addr As Long
   Dim host As HOSTENT
   Dim hostip_addr As Long
   Dim temp_ip_address() As Byte
   Dim i As Integer
   Dim ip_address As String
   
   hostent_addr = gethostbyname(Text1)
   
   If hostent_addr = 0 Then
      MsgBox "Can't resolve name."
      Exit Sub
   End If
   
   RtlMoveMemory host, hostent_addr, LenB(host)
   RtlMoveMemory hostip_addr, host.hAddrList, 4
   
   ReDim temp_ip_address(1 To host.hLength)
   RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
   
   For i = 1 To host.hLength
      ip_address = ip_address & temp_ip_address(i) & "."
   Next
   ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
   
   MsgBox ip_address
   
End Sub

Answer 4

另一种,也是代码,两部分
form1.frm 文件
============================================
VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6165
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10695
   LinkTopic       =   "Form1"
   ScaleHeight     =   6165
   ScaleWidth      =   10695
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   615
      Left            =   4800
      TabIndex        =   3
      Top             =   1560
      Width           =   4935
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   615
      Left            =   360
      TabIndex        =   2
      Top             =   1440
      Width           =   3855
   End
   Begin VB.ListBox List2 
      Height          =   960
      Left            =   4440
      TabIndex        =   1
      Top             =   240
      Width           =   5775
   End
   Begin VB.ListBox List1 
      Height          =   960
      Left            =   0
      TabIndex        =   0
      Top             =   240
      Width           =   4095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
   ReDim TabArray(0 To 0) As Long
   TabArray(0) = 61
  'clear existing tabs and
  'set the list tabstops
   Call SendMessage(List2.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List2.hwnd, LB_SETTABSTOPS, 1&, TabArray(0))
   List2.Refresh
  
  'initialize winsock and load adapter data
   SocketsInitialize
   DisplayAdatersInfo
 
   With Command1
      .Enabled = List1.ListIndex > -1
      .Caption = "Release IP"
   End With
   
   With Command2
      .Enabled = List1.ListIndex > -1
      .Caption = "Renew IP"
   End With
    
End SubPrivate Sub Form_Unload(Cancel As Integer)
    SocketsCleanup
End SubPrivate Sub Command1_Click()
   
   Dim ip_index As Long
   
   ip_index = CLng(List1.List(List1.ListIndex))
   
  'assure an adapter index has been selected
   If ip_index <> 0 Then
   
      Screen.MousePointer = vbHourglass
      
     'release the IP for the selected adapter
      If IPRelease(ip_index) Then
      DisplayAdatersInfo
      End If
      Screen.MousePointer = vbDefault
   End If
End Sub
Private Sub Command2_Click()
   Dim ip_index As Long
   
   ip_index = CLng(List1.List(List1.ListIndex))
   
  'assure an adapter index has been selected
   If ip_index <> 0 Then
   
      Screen.MousePointer = vbHourglass
      
     'release the IP for the selected adapter
      If IPRenew(ip_index) Then
         DisplayAdatersInfo
      End If
      Screen.MousePointer = vbDefault
   End If
End SubPrivate Sub List1_Click()   Command1.Enabled = List1.ListIndex > -1
   Command2.Enabled = List1.ListIndex > -1End SubPrivate Sub List1_MouseDown(Button As Integer, Shift As Integer, _
                            X As Single, Y As Single)List2.ListIndex = List1.ListIndex
End SubPrivate Sub List2_MouseDown(Button As Integer, Shift As Integer, _
                            X As Single, Y As Single)
List1.ListIndex = List2.ListIndex
End SubSub DisplayAdatersInfo()  'populates two listboxes with adapter info  'working vars
   Dim buff()      As Byte
   Dim cbRequired  As Long
   Dim Adapter     As IP_ADAPTER_INFO
   Dim ptr1        As Long
   
  'clear the lists
   List1.Clear
   List2.Clear
      
   Call GetAdaptersInfo(ByVal 0&, cbRequired)   If cbRequired > 0 Then
   
      ReDim buff(0 To cbRequired - 1) As Byte
      
      If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
   
         ptr1 = VarPtr(buff(0))
         
        'ptr1 is 0 when no more adapters
         Do While (ptr1 <> 0)
         CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
         
            With Adapter
               List1.AddItem .dwIndex
               List2.AddItem TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode)) _
                             & vbTab & _
                             TrimNull(StrConv(.sDescription, vbUnicode))
               
               ptr1 = .dwNext
               
            End With  'With Adapter
            
         Loop  'Do While (ptr1 <> 0)
         
      End If
   End IfEnd SubPrivate Function TrimNull(item As String)    Dim pos As Integer
   
   'double check that there is a chr$(0) in the string
    pos = InStr(item, Chr$(0))
    If pos Then
          TrimNull = Left$(item, pos - 1)
    Else: TrimNull = item
    End If
  
End Function

Answer 5

续上,模块文件
module1.bas
================================
Attribute VB_Name = "Module1"
Public Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Public Const MAX_ADAPTER_NAME As Long = 128
Public Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Public Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Public Const MAX_HOSTNAME_LEN As Long = 128
Public Const MAX_DOMAIN_NAME_LEN As Long = 128
Public Const MAX_SCOPE_ID_LEN As Long = 256Public Const ERROR_BUFFER_OVERFLOW As Long = 111
Public Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Public Const GMEM_FIXED As Long = &H0Public Const LB_SETTABSTOPS As Long = &H192Public Const IP_SUCCESS As Long = 0
Public Const ERROR_SUCCESS As Long = 0Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const WS_VERSION_REQD As Long = &H101Private Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To MAX_WSADescription) As Byte
   szSystemStatus(0 To MAX_WSASYSStatus) As Byte
   wMaxSockets As Integer
   wMaxUDPDG As Integer
   dwVendorInfo As Long
End TypePrivate Type IP_ADDRESS_STRING
    IpAddr(0 To 15)  As Byte
End TypePrivate Type IP_MASK_STRING
    IpMask(0 To 15)  As Byte
End TypePrivate Type IP_ADDR_STRING
    dwNext     As Long
    IpAddress  As IP_ADDRESS_STRING
    IpMask     As IP_MASK_STRING
    dwContext  As Long
End TypePublic Type IP_ADAPTER_INFO
  dwNext                As Long
  ComboIndex            As Long  'reserved
  sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3))        As Byte
  sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
  dwAddressLength       As Long
  sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1))       As Byte
  dwIndex               As Long
  uType                 As Long
  uDhcpEnabled          As Long
  CurrentIpAddress      As Long
  IpAddressList         As IP_ADDR_STRING
  GatewayList           As IP_ADDR_STRING
  DhcpServer            As IP_ADDR_STRING
  bHaveWins             As Long
  PrimaryWinsServer     As IP_ADDR_STRING
  SecondaryWinsServer   As IP_ADDR_STRING
  LeaseObtained         As Long
  LeaseExpires          As Long
End TypePrivate Type IP_ADAPTER_INDEX_MAP
   Index As Long
   AdapterName(0 To MAX_ADAPTER_NAME - 1) As Integer
End TypePrivate Type IP_INTERFACE_INFO
   NumAdapters As Long
   Adapter As IP_ADAPTER_INDEX_MAP
End TypePublic Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
   (IpAdapterInfo As Any, _
   pOutBufLen As Long) As Long
   
Private Declare Function GetInterfaceInfo Lib "iphlpapi.dll" _
  (ByVal pIfTable As Long, _
   dwOutBufLen As Long) As LongPrivate Declare Function IPReleaseAddress Lib "iphlpapi.dll" _
   Alias "IpReleaseAddress" _
  (AdapterInfo As IP_ADAPTER_INDEX_MAP) As LongPrivate Declare Function IPRenewAddress Lib "iphlpapi.dll" _
   Alias "IpRenewAddress" _
  (AdapterInfo As IP_ADAPTER_INDEX_MAP) As LongPrivate Declare Function GlobalAlloc Lib "kernel32" _
  (ByVal wFlags As Long, _
   ByVal dwBytes As Long) As LongPrivate Declare Function GlobalFree Lib "kernel32" _
  (ByVal hMem As Long) As LongPublic Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)Public Declare Function WSAStartup Lib "ws2_32.dll" _
  (ByVal wVR As Long, _
   lpWSAD As WSADATA) As LongPublic Declare Function WSACleanup Lib "ws2_32.dll" () As LongPublic Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As LongPublic Function SocketsInitialize() As Boolean   Dim WSAD As WSADATA
   
   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
    
End Function
Public Sub SocketsCleanup()
   
   If WSACleanup() <> 0 Then
       MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
   End If
    
End Sub
Public Function IPRelease(ByVal dwAdapterIndex As Long) As Boolean  'api vars
   Dim bufptr        As Long
   Dim dwOutBufLen   As Long
   Dim ip_map        As IP_ADAPTER_INDEX_MAP
   
  'working vars
   Dim success       As Long
   Dim nStructSize   As Long
   Dim NumAdapters   As Long
   Dim cnt As Long
   success = GetInterfaceInfo(0, dwOutBufLen)   If success <> 0 And _
      success = ERROR_INSUFFICIENT_BUFFER Then
   
      bufptr = GlobalAlloc(GMEM_FIXED, dwOutBufLen)
      success = GetInterfaceInfo(bufptr, dwOutBufLen)
       
      If success = ERROR_SUCCESS Then
               
         CopyMemory NumAdapters, ByVal bufptr, 4
         
         nStructSize = LenB(ip_map)
         
         If NumAdapters > 0 Then
         
           'loop through installed adapters...
            For cnt = 0 To NumAdapters - 1
               CopyMemory ip_map, _
                          ByVal bufptr + (nStructSize * cnt) + 4, _
                          nStructSize
               
              'compare the index to the value passed
               If ip_map.Index = dwAdapterIndex Then
                  IPRelease = IPReleaseAddress(ip_map) = ERROR_SUCCESS
                  If success <> ERROR_SUCCESS Then
                      MsgBox "ReleaseIP error " & success & _
                             ", Err# is " & Err.LastDllError
                  End If
                  
               End If  'If ip_map.Index
            
            Next  'For cnt
         
         End If  'If NumAdapters
      End If  'If success = ERROR_SUCCESS
   End If  'If success <> 0
   
   GlobalFree bufptrEnd Function
Public Function IPRenew(ByVal dwAdapterIndex As Long) As Boolean  'api vars
   Dim bufptr        As Long
   Dim dwOutBufLen   As Long
   Dim ip_map        As IP_ADAPTER_INDEX_MAP
   
  'working vars
   Dim success       As Long
   Dim nStructSize   As Long
   Dim NumAdapters   As Long
   Dim cnt           As Long
   success = GetInterfaceInfo(0, dwOutBufLen)   If success <> 0 And _
      success = ERROR_INSUFFICIENT_BUFFER Then
   
      bufptr = GlobalAlloc(GMEM_FIXED, dwOutBufLen)
      success = GetInterfaceInfo(bufptr, dwOutBufLen)
       
      If success = ERROR_SUCCESS Then
        CopyMemory NumAdapters, ByVal bufptr, 4
         
         nStructSize = LenB(ip_map)
         
        'if an adapter installed...
         If NumAdapters > 0 Then
         
           'loop through the adapters...
            For cnt = 0 To NumAdapters - 1
               CopyMemory ip_map, _
                          ByVal bufptr + (nStructSize * cnt) + 4, _
                          nStructSize
               
              'compare the index to the value passed
               If ip_map.Index = dwAdapterIndex Then
                  
                  IPRenew = IPRenewAddress(ip_map) = ERROR_SUCCESS
                  
                  If success <> ERROR_SUCCESS Then
                      MsgBox "IpRenewAddress error " & success & _
                             ", Err# is " & Err.LastDllError
                  End If
                  
               End If  'If ip_map.Index
            
            Next  'For cnt
         
         End If  'If NumAdapters
      End If  'If success = ERROR_SUCCESS
   End If  'If success <> 0
   
   GlobalFree bufptrEnd Function

Answer 6

不会吧?太可怕了！
加载一个winsock控件Option ExplicitPrivate Sub Command1_Click()
    Text1.Text = Winsock1.LocalIP
    Text2.Text = Winsock1.LocalHostName
    Winsock1.Close
End Sub

Answer 7

在windows手动改ip的时候，有两个单选按钮：“自动获得ip地址”，“使用下列指定ip”,我问的是用代码完成“自动获得ip地址”这个单选按钮的功。

Answer 8

在windows手动改ip的时候，有两个单选按钮：“自动获得ip地址”，“使用下列指定ip”,我问的是用代码完成“自动获得ip地址”这个单选按钮的功。