seven.frm

显示本机IP 《API》!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

VERSION 5.00
Begin VB.Form frmIP 
   Caption         =   "Form1"
   ClientHeight    =   2835
   ClientLeft      =   3390
   ClientTop       =   1500
   ClientWidth     =   6690
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2835
   ScaleWidth      =   6690
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   2400
      TabIndex        =   0
      Top             =   1140
      Width           =   1695
   End
End
Attribute VB_Name = "frmIP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
   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 = 128
 
   Private Type HOSTENT
       hName As Long
       hAliases As Long
       hAddrType As Integer
       hLength As Integer
       hAddrList As Long
   End Type
 
   Private 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 Type
 
   Private 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&)
    Function hibyte(ByVal wParam As Integer)
 
       hibyte = wParam \ &H100 And &HFF&
 
   End Function
 
   Function lobyte(ByVal wParam As Integer)
 
       lobyte = wParam And &HFF&
 
   End Function
 
   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
           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 Sub
 
   Sub SocketsCleanup()
   Dim lReturn As Long
 
       lReturn = WSACleanup()
 
       If lReturn <> 0 Then
           MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup """
           End
       End If
 
   End Sub
 


Private Sub Command1_Click()
   Dim hostname As String * 256
   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
 
       If gethostname(hostname, 256) = SOCKET_ERROR Then
           MsgBox "Windows Sockets error " & Str(WSAGetLastError())
           Exit Sub
       Else
           hostname = Trim$(hostname)
       End If
 
       hostent_addr = gethostbyname(hostname)
 
       If hostent_addr = 0 Then
           MsgBox "Winsock.dll is not responding."
           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 hostname
       MsgBox ip_address
 
End Sub

Private Sub Form_Load()
       SocketsInitialize
End Sub


Private Sub Form_Unload(Cancel As Integer)
   SocketsCleanup
End Sub