Projects

QuickQuery Half-Life Edition

April 11, 2007 by Java

Browsing QuickQuery HL Edition/DNS Mod.bas (7.51 KB)

Attribute VB_Name = "DNS_Mod"
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 AF_UNSPEC As Integer = 0                    ' unspecified
Private Const AF_UNIX As Integer = 1                      ' local to host (pipes, portals)
Private Const AF_INET As Integer = 2                     ' internetwork: UDP, TCP, etc.
Private Const AF_IMPLINK As Integer = 3                  ' arpanet imp addresses
Private Const AF_PUP As Integer = 4                      ' pup protocols: e.g. BSP
Private Const AF_CHAOS As Integer = 5                    ' mit CHAOS protocols
Private Const AF_IPX As Integer = 6                      ' IPX and SPX
Private Const AF_NS As Integer = AF_IPX                  ' XEROX NS protocols
Private Const AF_ISO As Integer = 7                      ' ISO protocols
Private Const AF_OSI As Integer = AF_ISO                 ' OSI is ISO
Private Const AF_ECMA As Integer = 8                     ' european computer manufacturers
Private Const AF_DATAKIT As Integer = 9                  ' datakit protocols
Private Const AF_CCITT As Integer = 10                    ' CCITT protocols, X.25 etc
Private Const AF_SNA As Integer = 11                      ' IBM SNA
Private Const AF_DECnet As Integer = 12                   ' DECnet
Private Const AF_DLI As Integer = 13                      ' Direct data link interface
Private Const AF_LAT As Integer = 14                      ' LAT
Private Const AF_HYLINK As Integer = 15                  ' NSC Hyperchannel
Private Const AF_APPLETALK As Integer = 16               ' AppleTalk
Private Const AF_NETBIOS As Integer = 17                  ' NetBios-style addresses
Private Const AF_VOICEVIEW As Integer = 18               ' VoiceView
Private Const AF_FIREFOX As Integer = 19                  ' Protocols from Firefox
Private Const AF_UNKNOWN1 As Integer = 20                 ' Somebody is using this!
Private Const AF_BAN As Integer = 21                     ' Banyan
Private Const AF_ATM As Integer = 22                     ' Native ATM Services
Private Const AF_INET6 As Integer = 23                   ' Internetwork Version 6
Private Const AF_CLUSTER As Integer = 24                 ' Microsoft Wolfpack
Private Const AF_12844 As Integer = 25                   ' IEEE 1284.4 WG AF

Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128

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 Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Long, lpWSAData As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Function gethostname Lib "wsock32.dll" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Private Declare Function gethostbyaddr Lib "wsock32.dll" (Addr As Long, addrLen As Long, addrType As Long) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal hostname$) As Long
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal IPAddress$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)



Private Function HiByte(ByVal wParam As Long) As Integer
    HiByte = wParam \ &H100 And &HFF&
End Function


Private Function LoByte(ByVal wParam As Long) As Integer
    LoByte = wParam And &HFF&
End Function

   

Private Sub SocketsCleanup()
   Dim X As Long
   X = WSACleanup()
   If X <> 0 Then
       MsgBox "Windows Sockets error " & X & " occurred in Cleanup.", vbExclamation
   End If
End Sub


Private Function SocketsInitialize() As Boolean
    Dim WSAD As WSAdata
    Dim szLoByte As String
    Dim szHiByte As String
    Dim szBuf As String
    If WSAStartup(WS_VERSION_REQD, WSAD) <> 0 Then
        MsgBox "Windows Sockets for 32 bit Windows environments is not successfully responding."
        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
        
        szHiByte = Trim$(Str$(HiByte(WSAD.wVersion)))
        szLoByte = Trim$(Str$(LoByte(WSAD.wVersion)))
        szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
        szBuf = szBuf & " is not supported by Windows " & _
        "Sockets for 32 bit Windows environments."
        MsgBox szBuf, vbExclamation
        Exit Function
    End If
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        szBuf = "This application requires a minimum of " & MIN_SOCKETS_REQD & " supported sockets."
        MsgBox szBuf, vbExclamation
        Exit Function
    End If
    SocketsInitialize = True
End Function


Public Function GetIPAddress(ByVal hostname As String, IPCollection() As String) As Long
Dim hostent_addr As Long
Dim Host As Hostent
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim X As Integer
Dim ip_address As String
ReDim IPCollection(1 To 1)
    If SocketsInitialize() Then
        hostent_addr = gethostbyname(hostname)
        If hostent_addr = 0 Then
            MsgBox "Error looking up requested host.", vbCritical
            SocketsCleanup
            Exit Function
        End If
        RtlMoveMemory Host, hostent_addr, LenB(Host)
        RtlMoveMemory hostip_addr, Host.hAddrList, 4
        Do
            X = X + 1
            ReDim temp_ip_address(1 To Host.hLength)
            RtlMoveMemory temp_ip_address(1), hostip_addr, Host.hLength
            For i = 1 To Host.hLength
                ip_address = ip_address & temp_ip_address(i) & "."
            Next
            ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
            ReDim Preserve IPCollection(1 To X)
            IPCollection(UBound(IPCollection)) = ip_address
            ip_address = ""
            Host.hAddrList = Host.hAddrList + LenB(Host.hAddrList)
            RtlMoveMemory hostip_addr, Host.hAddrList, 4
         Loop While (hostip_addr <> 0)
        SocketsCleanup
    End If
End Function
Public Function GetDNSname(ByVal IPAddress As String) As String
Dim hostip_addr As Long
Dim hostent_addr As Long
Dim newAddr As Long
Dim Host As Hostent
Dim strTemp As String
Dim strHost As String * 255
    If SocketsInitialize() Then
        newAddr = inet_addr(IPAddress)
        hostent_addr = gethostbyaddr(newAddr, Len(newAddr), AF_INET)
        If hostent_addr = 0 Then
            MsgBox "Error looking up requested IP address.", vbCritical
            SocketsCleanup
            Exit Function
        End If
        RtlMoveMemory Host, hostent_addr, Len(Host)
        RtlMoveMemory ByVal strHost, Host.hName, 255
        strTemp = strHost
        If InStr(strTemp, Chr(0)) <> 0 Then strTemp = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
        strTemp = Trim(strTemp)
        GetDNSname = strTemp
        SocketsCleanup
    End If
End Function

Download QuickQuery HL Edition/DNS Mod.bas

Back to file list

---

Back to project page