'================================================================
'= IPアドレス取得
'=    (IpAddress2.bas)
'================================================================
#include "Windows.bi"

#define MIN_SOCKETS_REQD 1
#define WS_VERSION_REQD &H101
#define WS_VERSION_MAJOR (WS_VERSION_REQD \ &H100 and &HFF)
#define WS_VERSION_MINOR (WS_VERSION_REQD and &HFF)

#define SOCKET_ERROR -1
#define WSADESCRIPTION_LEN 257
#define WSASYS_STATUS_LEN 129
#define MAX_WSADescription 256
#define MAX_WSASYSStatus 128

Type WSAData
    wVersion     As Integer
    wHighVersion As Integer
    szDescription(MAX_WSADescription) As Byte
    szSystemStatus(MAX_WSASYSStatus)  As Byte
    wMaxSockets  As Integer
    wMaxUDPDG    As Integer
    dwVEndorInfo As Long
End Type

Type HOSTENT
    hName     As Long
    hAliases  As Long
    hAddrType As Integer
    hLen      As Integer
    hAddrList As Long
End Type

'WinSockの初期化
Declare Function Api_WSAStartup& Lib "WSOCK32" Alias "WSAStartup" (ByVal wVersionRequired&, lpWSADATA As WSAData)

'WinSockのリソースを解放
Declare Function Api_WSACleanup& Lib "WSOCK32" Alias "WSACleanup" ()

'WinSock で発生したエラー取得
Declare Function Api_WSAGetLastError& Lib "WSOCK32" Alias "WSAGetLastError" ()

'ローカルマシンのホスト名を取得
Declare Function Api_gethostname& Lib "WSOCK32" Alias "gethostname" (ByVal szHost$, ByVal dwHostLen&)

'ホスト名からホストに関する情報（ hostent 構造体に対するポインタ）を得る
Declare Function Api_gethostbyname& Lib "WSOCK32" Alias "gethostbyname" (ByVal szHost$)

' ある位置から別の位置にメモリブロックを移動する関数の宣言
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

Var Shared Text(3) As object
Var Shared Button1 As Object

For i = 0 To 3
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1))) : Text(i).SetFontSize 14
Next
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared sHostName As String * 256

'================================================================
'=
'================================================================
Declare Function HiByte(ByVal wParam As Integer)
Function HiByte(ByVal wParam As Integer)
    HiByte = wParam \ &H100 And &HFF
End Function

'================================================================
'=
'================================================================
Declare Function LoByte(ByVal wParam As Integer)
Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF
End Function

'================================================================
'=
'================================================================
Declare Sub SocketsCleanup ()
Sub SocketsCleanup()
    If Api_WSACleanup() <> ERROR_SUCCESS Then
        A% = MessageBox("", "ソケットエラーをクリアしました！", 0, 2)
    End If
End Sub

'================================================================
'=
'================================================================
Declare Function SocketsInitialize() As Integer
Function SocketsInitialize() As Integer
    Var WSAD As WSAData
    Var sLoByte As String
    Var sHiByte As String

    If Api_WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
        A% = MessageBox("", "32ビットWindowsソケットが反応しません！。", 0, 2)
        SocketsInitialize = False
        Exit Function
    End If

    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        A% = MessageBOx("", "このアプリケーションは、最小のサポートされたソケットを必要とします", 0, 2)
        SocketsInitialize = False
        Exit Function
    End If

    If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR and HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
        sHiByte = Str$(HiByte(WSAD.wVersion))
        sLoByte = Str$(LoByte(WSAD.wVersion))
        A% = MessageBox("", "ソケットバージョン " & sLoByte & "." & sHiByte & " は、サポートされていません！", 0, 2)
        SocketsInitialize = False
        Exit Function
    End If

    SocketsInitialize = True
End Function

'================================================================
'=
'================================================================
Declare Function GetIPAddress() As String
function GetIPAddress() As String
    Var lpHost As Long
    Var HOST As HOSTENT
    Var dwIPAddr As Long
    Var i As Integer
    Var sIPAddr As String

    If Not SocketsInitialize Then
        GetIPAddress = ""
        Exit Function
    End If

    If Api_gethostname(sHostName, 256) = SOCKET_ERROR Then
        GetIPAddress = ""
        A% = MessageBox("", "ホスト名を取得できません！", 0, 2)
        SocketsCleanup
        Exit Function
    End If

    sHostName = Trim$(sHostName)
    lpHost = Api_gethostbyname(sHostName)
    If lpHost = 0 Then
        GetIPAddress = ""
        A% = MessageBox("", "Windowsソケットは反応していません。ホスト名を取得できません！", 0, 2)
        SocketsCleanup
        Exit Function
    End If

    CopyMemory HOST, lpHost, Len(HOST)
    CopyMemory dwIPAddr, HOST.hAddrList, 4

    Var tmpIPAddr(HOST.hLen) As Byte

    CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen

    For i = 1 To HOST.hLen
        sIPAddr = sIPAddr & Str$(tmpIPAddr(i)) & "."
    Next

    GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
    SocketsCleanup
End Function

'================================================================
'=
'================================================================
Declare Function GetIPHostName() As String
Function GetIPHostName() As String
    If Not SocketsInitialize Then
        GetIPHostName = ""
        Exit Function
    End If

    If Api_gethostname(sHostName, 256) = SOCKET_ERROR Then
        GetIPHostName = ""
        A% = MessageBox("", "Windowsソケットエラー。ホスト名を取得できません！", 0, 2)
        SocketsCleanup
        Exit Function
    End If

    GetIPHostName = Left$(sHostName, InStr(sHostName, Chr$(0)) - 1)
    SocketsCleanup
End Function

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Text(0).SetWindowText GetIPAddress
    Text(1).SetWindowText sHostName
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End