Office中国论坛/Access中国论坛

标题: 如何获得本机器的IP地址? [打印本页]

作者: zzm7152    时间: 2006-11-13 05:27
标题: 如何获得本机器的IP地址?
各位高手:

本人在编写EXCEL分析SYBASE数据时,遇到想通过确认本机的IP地址来设定分析表的使用范围,必须是动态识别IP地址,请高手帮忙,谢谢!有其他手段获得IP,然后传给EXCEL的办法也行。
作者: 方漠    时间: 2006-11-14 17:45
试试下面的代码网上的)

Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
   
  Const Max_IP = 5
  
  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
   
  Type MIB_IPADDRTABLE
      dEntrys   As Long
      mIPInfo(Max_IP)   As IPINFO
  End Type
   
  Type IP_Array
      mBuffer   As MIB_IPADDRTABLE
      BufferLen   As Long
  End Type

   
  Public 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
   
  Public Sub MsgIPAddr()
      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
      MsgBox "找到 " & Listing.dEntrys & "   个IP Address!"
      For Tel = 0 To Listing.dEntrys - 1
          CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))                        
          MsgBox "IP Address:" & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr)
      Next
      End
End1:
      MsgBox Err.Number & Err.Description
      End
  End Sub


作者: zzm7152    时间: 2006-11-16 05:58
十分感谢!以后请多多赐教。
作者: 方漠    时间: 2006-11-17 01:43
呵,别客气,赐教不敢当,一起交流探讨吧.




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3