Option Explicit

Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128
Private Const SOCKET_ERROR As Long = -1

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 gethostname Lib "WSOCK32.DLL" (ByVal hostname$, _
ByVal HostLen As Integer) As Long

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

Sub Form_Load()
Call SocketsInitialize
End Sub

Private Sub Command1_click()
Dim hostname$, HostLen&
HostLen& = 256
hostname$ = Space$(HostLen&)
If gethostname(hostname$, HostLen&) = SOCKET_ERROR Then
MsgBox "Windows Sockets error" & Str(WSAGetLastError())
Else
hostname$ = Trim$(hostname$)
hostname$ = Left$(hostname$, Len(hostname$) - 1)
MsgBox "Host name = " & hostname$
End If
SocketsCleanup
End Sub

Sub SocketsInitialize()
Const WS_VERSION_REQD As Integer = &H101
Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Const MIN_SOCKETS_REQD = 1
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

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 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