【VBA】【Excel(64bit)】WinSock 　gethostnameで自身のホスト名を取得する

Option Explicit
Public Const SOCKET_ERROR As Long = -1


Private Const WSADESCRIPTION_LEN     As Integer = 256
Private Const WSASYS_STATUS_LEN      As Integer = 128
Private Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To WSADESCRIPTION_LEN) As Byte
    szSystemstatus(0 To WSADESCRIPTION_LEN) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type



'/***  Fromat Message
' Constants - FormatMessage.dwFlags
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Private Const FORMAT_MESSAGE_FROM_STRING As Long = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFF


' FormatMessage(API)
Private Declare PtrSafe Function FormatMessage Lib "kernel32" Alias _
      "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _
      ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
      ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) _
      As Long


Private Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequested As Integer, lpWSAData As Any) As Long
Private Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare PtrSafe Function gethostname Lib "wsock32.dll" (ByVal name As String, ByVal namelen As Long) As Long

'自分自身のホスト名を取得
Public Function GetMyhostname() As String
    Dim WSA As WSADATA
    Dim sName As String
    sName = String(1024, vbNullChar)

    Dim RetCode As Long
            
    RetCode = WSAStartup(MAKEWORD(2, 2), WSA)
    If (RetCode <> 0) Then
        Call WSACleanup
        Exit Function
    End If
    
    If gethostname(sName, Len(sName)) = SOCKET_ERROR Then
        Debug.Print Err.LastDllError
        Debug.Print Err.Number
        Debug.Print ErrMessage_GetLastError(Err.LastDllError)
        Debug.Print WSAGetLastError
    End If

    Call WSACleanup

End Function

Public Function MAKEWORD(Lo As Byte, Hi As Byte) As Integer
    MAKEWORD = Lo + Hi * 256& Or 32768 * (Hi > 127)
End Function
 

Public Function ErrMessage_GetLastError(Optional ByVal dwMessageId As Long = 0) As String

    Dim dwFlags As Long    'オプションフラグ
    Dim lpBuffer As String 'メッセージを格納するたのバッファ
    Dim result As Long     '戻り値(文字列のバイト数)
    
    '引数省略対応｡
    If dwMessageId = 0 Then
        dwMessageId = VBA.Information.Err().LastDllError '未設定の場合はLastDllErrorをセット
    End If
    
    dwFlags = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS Or FORMAT_MESSAGE_MAX_WIDTH_MASK
    lpBuffer = String(1024, vbNullChar)
    result = FormatMessage(dwFlags, 0&, dwMessageId, 0&, lpBuffer, Len(lpBuffer), 0&)
    If (result > 0) Then
        lpBuffer = Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
    Else
        lpBuffer = ""
    End If

    ErrMessage_GetLastError = lpBuffer
    ErrMessage_GetLastError = lpBuffer & "(" & dwMessageId & ")"
End Function

'

ホスト名（いわゆるコンピュータ名）を取得するサンプル

gethostnameというAPIを使っている。このサンプルではホスト名が文字列で出力される。IPアドレスが取得できるgethostbynameとは違うので注意