main.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Main 
   Caption         =   "Form1"
   ClientHeight    =   2970
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6255
   LinkTopic       =   "Form1"
   ScaleHeight     =   2970
   ScaleWidth      =   6255
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "获取IP"
      Height          =   495
      Left            =   3840
      TabIndex        =   2
      Top             =   840
      Width           =   1695
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   840
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   840
      Width           =   2295
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   840
      TabIndex        =   0
      Text            =   "Text2"
      Top             =   1560
      Width           =   2295
   End
   Begin VB.Label Label1 
      Caption         =   "名称"
      Height          =   255
      Left            =   360
      TabIndex        =   4
      Top             =   840
      Width           =   495
   End
   Begin VB.Label Label2 
      Caption         =   "IP"
      Height          =   255
      Left            =   480
      TabIndex        =   3
      Top             =   1560
      Width           =   375
   End
End
Attribute VB_Name = "Main"
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" (hostname$, HostLen&) As Long
Private Declare Function gethostbyname Lib _
    "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Function GetComputerName Lib _
    "kernel32" Alias "GetComputerNameA" (ByVal _
    lpBuffer As String, nSize As Long) 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 * 255
    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
    GetComputerName hostname, 256
    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)
    Text1.Text = hostname
    Text2.Text = ip_address

End Sub

Private Sub Form_Load()
    SocketsInitialize
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SocketsCleanup
End Sub