Option Explicit

Private Const INADDR_NONE As Long = &HFFFF

Private Type WSAData
   wVersion As Integer
   wHighVersion As Integer
   szDescription As String * 257
   szSystemStatus As String * 129
   iMaxSockets As Integer
   iMaxUdpDg As Integer
   lpVendorInfo As String * 200
End Type

Private Type HostEnt
    h_name      As Long
    h_aliases   As Long
    h_addrtype  As Integer
    h_length    As Integer
    h_addr_list As Long
End Type

Private Declare Function WSAStartup Lib "wsock32.dll" ( _
    ByVal wVersionRequired As Long, _
    lpWSAData As WSAData _
) As Long
Private Declare Function GetHostName Lib "wsock32.dll" Alias "gethostname" ( _
    ByVal hostname As String, _
    ByVal namelen As Integer _
) As Long
Private Declare Function inet_addr Lib "wsock32.dll" ( _
    ByVal cp As String _
) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" ( _
    ByVal hostname As String _
) As Long
Private Declare Function WSACleanUp Lib "wsock32.dll" Alias "WSACleanup" () As Long
Private Declare Function WSAUnhookBlockingHook% Lib "wsock32.dll" ()
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Dest As Any, _
    sour As Any, _
    ByVal bytes As Long _
)

Private Sub Command1_Click()
    Dim Version As Long
    Dim StartUpInfo As WSAData
    Dim sHostName As String
    Dim nIP As Long
    Dim nRet As Long
    
    Dim heHost  As HostEnt
    Dim nAddr     As Long
    Dim I As Integer
    Dim sAddress As String
    Dim sIpAddress As String
    
    Version = &H101
    
    If WSAStartup(Version, StartUpInfo) < 0 Then
        MsgBox "初期化失敗"
    End If
    
    sHostName = String(256, 0)
    nRet = GetHostName(sHostName, 256)
    sHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)
    Call MsgBox(sHostName)
        
    nIP = inet_addr(sHostName)
    
    If nIP = INADDR_NONE Then
        nRet = gethostbyname(sHostName)
        If nRet <> 0 Then
            I = 0
            Do
                Call CopyMemory(heHost, ByVal nRet, Len(heHost))
                Call CopyMemory(nAddr, ByVal heHost.h_addr_list + I * 4, 4)
                If nAddr = 0 Then Exit Do
                Call CopyMemory(nIP, ByVal nAddr, heHost.h_length)
                
                Call MsgBox(CLng("&H" & Mid$(Hex(nIP), 7, 2)) & "." & _
                            CLng("&H" & Mid$(Hex(nIP), 5, 2)) & "." & _
                            CLng("&H" & Mid$(Hex(nIP), 3, 2)) & "." & _
                            CLng("&H" & Mid$(Hex(nIP), 1, 2)))
                
                I = I + 1
            Loop
        End If
    End If

    Call WSAUnhookBlockingHook
    Call WSACleanUp
End Sub