| Dragon Drop | |
Dragon Drop - A Software Consultancy
|
|
| Home Our Products Consultancy Web Page Development Services Coding Windows External Resources | |
| Links Newsletter News And Issues Books etc. About Us | |
| CODING: Exchange Visual Basic VBA HomeSite | Coding Tools Software Clinic |
This code was taken from the Microsoft site (based on Q160215) and then tidied up a little bit and then made into a simple class. All it does is present a property called .GetHostName which returns the computer's host name.
The error handling in this example has been reduced to a minimum in order to show the basic functionality.
Calling this routine is easy. If the class was called, for example, clsHostInformation, then the calling code would look like this:
Dim oHost As clsHostInformation Set oHost = New clsHostInformation MsgBox oHost.HostName Set oHost = Nothing
The whole of the class is as follows:
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 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 As Integer, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function GetHostName Lib "WSOCK32.DLL" Alias "gethostname" (ByVal HostName As String, ByVal HostLen As Long) As Long
Private m_sHostName As String
'
'
Private Sub Class_Initialize()
SocketsInitialize
DetermineHostName
SocketsCleanup
End Sub
Private Sub Class_Terminate()
SocketsCleanup
End Sub
Public Property Get HostName() As String
HostName = m_sHostName
End Property
Private Sub SocketsInitialize()
Dim WSAD As WSADATA
Dim nReturnCode As Long
nReturnCode = WSAStartup(WS_VERSION_REQD, WSAD)
End Sub
Private Sub SocketsCleanup()
Dim nReturnCode As Long
On Error Resume Next
nReturnCode = WSACleanup()
End Sub
Private Sub DetermineHostName()
Dim sHostName As String * 256
If GetHostName(sHostName, 256) = SOCKET_ERROR Then
m_sHostName = ""
Else
m_sHostName = Left(sHostName, InStr(1, sHostName, Chr$(0), vbBinaryCompare) - 1)
End If
End Sub
If there are any suggestions for updates then please drop me a mail at malcolm.smith@dragondrop.com.