一个简单的问题：如何取得本机的Ip地址和电脑名称?

Question

请各位大蛱帮忙，如何取得本机的IP地址和电脑名称？

Answer 1

查看“网上邻居”的属性，再查看本地连接的属性，再查看tp/icp协议即可得到本机ip，计算机名则查看“我的电脑”属性里面的计算机名即可！

Answer 2

范例程式:NetworkInformation
说明:有关区域网路的相关资讯,诸如使用者ID、工作站名称、作业系统与版本、PDC的名称与时间、本机的位址及作业系统Service Pack的版本等,全部钜细靡遗地展现出来.
作者:不详
适用版本:VB5以上
首页:不详####################
中文说明:
VBPro.NET中文资源网
http://www.vbpro.net
资料整理：影子 VB爱好者乐园 yingzi007.126.com
####################//Form
Option ExplicitPrivate Sub CmdClose_Click()
  Unload Me
End SubPrivate Sub Form_Load()
        
  TxtValue(0) = NetworkUserName()
  TxtValue(1) = WorkstationID()
  TxtValue(2) = WindowsVersion()
  TxtValue(3) = BuildNo()
  TxtValue(4) = WindowsDir()
  TxtValue(5) = PDCName()
  TxtValue(6) = ServerTime(PDCName())
  TxtValue(7) = IPAddress()
  TxtValue(8) = SPInfo()
  
End Sub

Answer 3

Option ExplicitPrivate mAPIErrName As String
Private mAPIErrNo   As BytePrivate Declare Function WNetGetUserA Lib "mpr" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
Private Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetWindowsDirectory& Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long)
Private Declare Function NetGetDCName Lib "NETAPI32.DLL" (strServerName As Any, strDomainName As Any, pBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (buffer As Any) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Byte, ByVal lpString2 As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long) As Long
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'--------------- WindowsVersion Declarations --------------------------------
Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long           '1 = Windows 95/98.
                                 '2 = Windows NT
  szCSDVersion As String * 128
End TypePrivate Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
'--------------- WSOCK32.DLL Declarations --------------------------------
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 gethostname Lib "WSOCK32.DLL" (ByVal hostname$, HostLen&) 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&)
'--------------- ServerTime declares Constants --------------------------------
Private Declare Function NetRemoteTOD Lib "NETAPI32.DLL" (ByVal server As String, buffer As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)Private Type TIME_OF_DAY
  t_elapsedt As Long
  t_msecs As Long
  t_hours As Long
  t_mins As Long
  t_secs As Long
  t_hunds As Long
  t_timezone As Long
  t_tinterval As Long
  t_day As Long
  t_month As Long
  t_year As Long
  t_weekday As Long
End TypePublic Function PDCName() As String
  Dim szServer   As String
  Dim ptmpBuffer As Long
  Dim sByte()    As Byte
  Dim lGotNameOK As Long
  Dim lBufferOK  As Long
      
  '# this will return nothing if the machine is not in a domain
  lGotNameOK = NetGetDCName(vbNullString, vbNullString, ptmpBuffer)
  
  If lGotNameOK = 0 Then ' success
    ReDim sByte(256)    ' ptmpbuffer is a pointer so copy contents using API call
    MoveMemory sByte(0), ptmpBuffer, 256
    
    ' free ptmpbuffer - not in other samples but mentioned in documentation
    lBufferOK = NetApiBufferFree(ptmpBuffer)
    
'   If lBufferOK = 0 Then
      ' strip off trailing rubbish
      szServer = sByte
      szServer = szServer & vbNullChar
      PDCName = Left$(szServer, InStr(szServer, vbNullChar) - 1)
'   End If
  Else
    PDCName = ""
  End IfEnd FunctionPublic Function WorkstationID() As String
  Dim sBuffer As String * 255  If GetComputerNameA(sBuffer, 255&) > 0 Then
    WorkstationID = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
  Else
    WorkstationID = "?"
  End IfEnd FunctionPublic Function WindowsDir() As String
  
  WindowsDir = Space(256)
  WindowsDir = Left$(WindowsDir, GetWindowsDirectory(WindowsDir, 256&))End Function
'--------------------------------------------------------------------------------------
Private Function hibyte(ByVal wParam As Integer)
  hibyte = wParam \ &H100 And &HFF&
End FunctionPrivate Function lobyte(ByVal wParam As Integer)
  lobyte = wParam And &HFF&
End Function
 

Answer 4

Private Sub 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
    mAPIErrName = "Winsock.dll is not responding."
    Exit Sub
  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 "
    mAPIErrName = sMsg
    Exit Sub
  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."
    mAPIErrName = sMsg
    Exit Sub
  End IfEnd Sub
 
Private Sub SocketsCleanup()
  Dim lReturn As Long
 
  lReturn = WSACleanup()  If lReturn <> 0 Then
    mAPIErrName = "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup """
  End IfEnd Sub
 
Public Function IPAddress() As String
  Dim hostname As String * 256
  Dim hostent_addr As Long
  Dim host As HOSTENT
  Dim hostip_addr As Long
  Dim temp_tIPAddress() As Byte
  Dim i As Integer
  Dim tIPAddress As String
 
 
  Call SocketsInitialize
  
  If gethostname(hostname, 256) = SOCKET_ERROR Then
    MsgBox "Windows Sockets error " & Str(WSAGetLastError())
    Exit Function
  Else
    hostname = Trim$(hostname)
  End If  hostent_addr = gethostbyname(hostname)  If hostent_addr = 0 Then
    MsgBox "Winsock.dll is not responding."
    Exit Function
  End If  Call RtlMoveMemory(host, hostent_addr, LenB(host))
  Call RtlMoveMemory(hostip_addr, host.hAddrList, 4)  ReDim temp_tIPAddress(1 To host.hLength)
  Call RtlMoveMemory(temp_tIPAddress(1), hostip_addr, host.hLength)  For i = 1 To host.hLength
    tIPAddress = tIPAddress & temp_tIPAddress(i) & "."
  Next
  IPAddress = Mid$(tIPAddress, 1, Len(tIPAddress) - 1)  Call SocketsCleanup
  
End FunctionPublic Function ServerTime(ByVal pServerName As String) As Variant
  Dim t As TIME_OF_DAY
  Dim tPtr As Long
  Dim Result As Long
  Dim szServer As String
  Dim ServDate As Date
  
  'Convert the server name to unicode
  If Left(pServerName, 2) = "\\" Then
    szServer = StrConv(pServerName, vbUnicode)
  Else
    szServer = StrConv("\\" & pServerName, vbUnicode)
  End If
    
  Result = NetRemoteTOD(szServer, tPtr)  'You could also pass vbNullString for the server name
  
  If Result = 0 Then
    Call CopyMemory(t, ByVal tPtr, Len(t))  'Copy the pointer returned to a TIME_OF_DAY structure
    ServDate = DateSerial(70, 1, 1) + (t.t_elapsedt / 60 / 60 / 24)  'Convert the elapsed time since 1/1/70 to a date
    ServDate = ServDate - (t.t_timezone / 60 / 24)  'Adjust for TimeZone differences
    NetApiBufferFree (tPtr) 'Free the memory at the pointer
    ServerTime = ServDate
  Else
    If Result = 53 Then mAPIErrName = "Cannot find server " & pServerName
  End If
    
End FunctionPublic Function WindowsVersion() As String
  Dim osinfo   As OSVERSIONINFO
  Dim retvalue As Integer
  
  osinfo.dwOSVersionInfoSize = 148
  osinfo.szCSDVersion = Space$(128)
  retvalue = GetVersionExA(osinfo)
  
  Select Case osinfo.dwPlatformId
    Case Is = 1: WindowsVersion = "Windows 95/98"
    Case Is = 2: WindowsVersion = "Windows NT"
    Case Else: WindowsVersion = "Unknown"
  End Select
  
End FunctionPublic Function BuildNo() As String
  Dim osinfo   As OSVERSIONINFO
  Dim retvalue As Integer
  
  osinfo.dwOSVersionInfoSize = 148
  osinfo.szCSDVersion = Space$(128)
  retvalue = GetVersionExA(osinfo)
  
  BuildNo = osinfo.dwMajorVersion & "." & osinfo.dwMinorVersion & "." & osinfo.dwBuildNumber
  
End FunctionPublic Function SPInfo() As String
  Dim osinfo   As OSVERSIONINFO
  Dim retvalue As Integer
  
  osinfo.dwOSVersionInfoSize = 148
  osinfo.szCSDVersion = Space$(128)
  retvalue = GetVersionExA(osinfo)
  
  SPInfo = osinfo.szCSDVersion
  
End FunctionPublic Function NetworkUserName() As String
  Dim lpBuff   As String * 25
  Dim retval   As Long  retval = GetUserName(lpBuff, 25)
  ' trim off any trailing spaces found in the name
  NetworkUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)End Function

Answer 5

谢谢 w18ily(真的被封了，这次翘翘了) ，你没有翘翘吧。

Answer 6

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
    Dim strIP As String
     
Private Sub main()
     Start
     MsgBox strIP
End Sub
     
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
     
Public Sub Start()
     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
     strIP = "你机子上有 " & Listing.dEntrys & " 个 IP 地址。" & vbCrLf
     strIP = strIP & "------------------------------------------------" & vbCrLf & 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
     Exit Sub
END1:
     MsgBox "ERROR"
End Sub