Stuart McLachlan
stuart at lexacorp.com.pg
Tue Jun 30 16:40:26 CDT 2009
I dunno, I've never needed to find it, but John, Gustav & co were talking about needing to know he Subnet mask so I decided it would be a good idea to include it in the Class. On 30 Jun 2009 at 18:27, Max Wanadoo wrote: > Stuart, this is good stuff. > Why would I need to know the subnet mask in the context of finding the IP > and Hostname? > > Max > > > > -----Original Message----- > From: dba-vb-bounces at databaseadvisors.com > [mailto:dba-vb-bounces at databaseadvisors.com] On Behalf Of Stuart McLachlan > Sent: 30 June 2009 14:02 > To: Discussion concerning Visual Basic and related programming issues. > Subject: Re: [dba-VB] Syslogs > > On 30 Jun 2009 at 13:50, Gustav Brock wrote: > > > However, no function is included to reveal the subnet mask. The only > "human" method I > >can locate for this purpose is to look up the registry: > > I just found another API call which returns more info including the SubNet > mask(s) so I've > modified clsResolve to include GetMyIPMask: > > Option Compare Database > Option Explicit > > '// define constants > Private Const IP_SUCCESS As Long = 0 > Private Const SOCKET_ERROR As Long = -1 > > Private Const MAX_WSADescription As Long = 256 > Private Const MAX_WSASYSStatus As Long = 128 > Private Const MIN_SOCKETS_REQD As Long = 1 > > Private Const WS_VERSION_REQD As Long = &H101 > Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And > &HFF& > Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF& > > Private Const WSADescription_Len As Long = 256 > Private Const WSASYS_Status_Len As Long = 128 > Private Const AF_INET As Long = 2 > > '// structures > > Private Type HOSTENT > hName As Long > hAliases As Long > hAddrType As Integer > hLength As Integer > hAddrList As Long > End Type > > > Private Type WSADATA > wVersion As Integer > wHighVersion As Integer > szDescription(0 To MAX_WSADescription) As Byte > szSystemStatus(0 To MAX_WSASYSStatus) As Byte > wMaxSockets As Long > wMaxUDPDG As Long > dwVendorInfo As Long > End Type > > Private Type IPINFO > dwAddr As Long ' IP address > dwIndex As Long ' interface index > dwMask As Long ' subnet mask > dwBCastAddr As Long ' broadcast address > dwReasmSize As Long ' assembly size > unused1 As Integer ' not currently used > unused2 As Integer '; not currently used > End Type > > Private Type MIB_IPADDRTABLE > dEntrys As Long 'number of entries in the table > mIPInfo(5) As IPINFO 'array of IP address entries assumes maximum of 5 > Interfaces > End Type > > Private Type IP_Array > mBuffer As MIB_IPADDRTABLE > BufferLen As Long > End Type > > > '// api > 'kernel32 > Private Declare Sub apiCopyMemory Lib "kernel32" Alias "RtlMoveMemory" > (xDest As Any, > xSource As Any, ByVal nBytes As Long) > Private Declare Function apiStrLen Lib "kernel32" Alias "lstrlenA" (lpString > As Any) As Long > 'wsock32 > Private Declare Function apiGetHostByName Lib "wsock32.dll" Alias > "gethostbyname" > (ByVal hostname As String) As Long > Private Declare Function apiWSAStartup Lib "wsock32.dll" Alias "WSAStartup" > (ByVal > wVersionRequired As Long, lpWSADATA As WSADATA) As Long > Private Declare Function apiWSACleanup Lib "wsock32.dll" Alias "WSACleanup" > () As Long > Private Declare Function apiInetAddr Lib "wsock32.dll" Alias "inet_addr" > (ByVal s As String) > As Long > Private Declare Function apiGetHostByAddr Lib "wsock32.dll" Alias > "gethostbyaddr" (haddr > As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long > Private Declare Function apiGetHostName Lib "wsock32.dll" Alias > "gethostname" (ByVal > hostname$, ByVal HostLen As Integer) As Long > 'IPHlpAPI > Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, > pdwSize As > Long, ByVal Sort As Long) As Long > > '// private functions > Private Function InitializeSocket() As Boolean > Dim WSAD As WSADATA > > 'attempt to initialize the socket > InitializeSocket = apiWSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS > End Function > > Private Sub CloseSocket() > 'try to close the socket > If apiWSACleanup() <> 0 Then > MsgBox "Error calling apiWSACleanup.", vbCritical > End If > > End Sub > > Public Function GetIPFromHostName(ByVal sHostName As String) As String > 'converts a host name to an IP address. > > Dim nBytes As Long > Dim ptrHosent As Long > Dim hstHost As HOSTENT > Dim ptrName As Long > Dim ptrAddress As Long > Dim ptrIPAddress As Long > Dim sAddress As String 'declare this as Dim sAddress(1) As String if you > want 2 ip > addresses returned > > 'try to initalize the socket > If InitializeSocket() = True Then > > 'try to get the IP > ptrHosent = apiGetHostByName(sHostName & vbNullChar) > > If ptrHosent <> 0 Then > > 'get the IP address > apiCopyMemory hstHost, ByVal ptrHosent, LenB(hstHost) > apiCopyMemory ptrIPAddress, ByVal hstHost.hAddrList, 4 > > 'fill buffer > sAddress = Space$(4) > 'if you want multiple domains returned, > 'fill all items in sAddress array with 4 spaces > > apiCopyMemory ByVal sAddress, ByVal ptrIPAddress, > hstHost.hLength > > 'change this to > 'CopyMemory ByVal sAddress(0), ByVal ptrIPAddress, > hstHost.hLength > 'if you want an array of ip addresses returned > '(some domains have more than one ip address associated with it) > > 'get the IP address > GetIPFromHostName = IPToText(sAddress) > 'if you are using multiple addresses, you need > IPToText(sAddress(0)) & "," & > IPToText(sAddress(1)) > 'etc > End If > Else > MsgBox "Failed to open Socket." > End If > End Function > > Private Function IPToText(ByVal IPAddress As String) As String > 'converts characters to numbers > IPToText = CStr(Asc(IPAddress)) & "." & _ > CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _ > CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _ > CStr(Asc(Mid$(IPAddress, 4, 1))) > End Function > > Private Function ConvertAddressToString(longAddr As Long) As String > Dim myByte(3) As Byte > Dim Cnt As Long > CopyMemory myByte(0), longAddr, 4 > For Cnt = 0 To 3 > ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) > + "." > Next Cnt > ConvertAddressToString = Left$(ConvertAddressToString, > Len(ConvertAddressToString) > - 1) > End Function > > > Public Function GetHostNameFromIP(ByVal sIPAddress As String) As String > Dim ptrHosent As Long > Dim hAddress As Long > Dim sHost As String > Dim nBytes As Long > > 'try to open the socket > If InitializeSocket() = True Then > > 'convert string address to long datatype > hAddress = apiInetAddr(sIPAddress) > > 'check if an error ocucred > If hAddress <> SOCKET_ERROR Then > > 'obtain a pointer to the HOSTENT structure > 'that contains the name and address > 'corresponding to the given network address. > ptrHosent = apiGetHostByAddr(hAddress, 4, AF_INET) > > If ptrHosent <> 0 Then > > 'convert address and > 'get resolved hostname > > apiCopyMemory ptrHosent, ByVal ptrHosent, 4 > > nBytes = apiStrLen(ByVal ptrHosent) > > If nBytes > 0 Then > 'fill the IP address buffer > sHost = Space$(nBytes) > > apiCopyMemory ByVal sHost, ByVal ptrHosent, nBytes > GetHostNameFromIP = sHost > End If > Else > MsgBox "Call to gethostbyaddr failed." > End If > 'close the socket > CloseSocket > Else > MsgBox "Invalid IP address" > End If > Else > MsgBox "Failed to open Socket" > End If > End Function > > > Public Function GetMyHostName() As String > 'Finds local HostName > Dim strHostname As String > Dim lngHostLen As Long > 'try to initalize the socket > If InitializeSocket() = True Then > lngHostLen = 256 > strHostname = Space$(lngHostLen) > If apiGetHostName(strHostname, lngHostLen) = SOCKET_ERROR Then > MsgBox "Windows Sockets error getting Host Name" > Else > strHostname = Trim$(strHostname) > strHostname = Left$(strHostname, Len(strHostname) - 1) > End If > Else > MsgBox "Failed to open Socket." > End If > GetMyHostName = strHostname > End Function > > Public Function GetMyIPAddress() As String > GetMyIPAddress = GetIPFromHostName(GetMyHostName) > End Function > > Public Function GetMyIPMask() > Dim Ret As Long > Dim bBytes() As Byte > Dim tel As Long > Dim Listing As MIB_IPADDRTABLE > On Error GoTo END1 > GetIpAddrTable ByVal 0&, Ret, True > If Ret <= 0 Then Exit Function > ReDim bBytes(0 To Ret - 1) As Byte > 'retrieve the data > GetIpAddrTable bBytes(0), Ret, False > 'Get the first 4 bytes to get the entry's.. ip installed > CopyMemory Listing.dEntrys, bBytes(0), 4 > 'Copy whole structure to Listing and return for Adapter 1 (Adapter 0 > = Loopback) > CopyMemory Listing.mIPInfo(1), bBytes(4 + > (Len(Listing.mIPInfo(0)))), > Len(Listing.mIPInfo(1)) > GetIPMask = ConvertAddressToString(Listing.mIPInfo(1).dwMask) > Exit Function > END1: > MsgBox "Error Resolving Subnet Mask" > End Function > > > > > > > _______________________________________________ > dba-VB mailing list > dba-VB at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/dba-vb > http://www.databaseadvisors.com > > _______________________________________________ > dba-VB mailing list > dba-VB at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/dba-vb > http://www.databaseadvisors.com >