Getting the DNS of a computer

WSALookupServiceBegin/Next/End API Calls

I have found C source code for using these calls to get the DNS server ip's of the local machine. But I am no good at converting it. Anyone want to give me an example, or convert the code at: http://www.stardust.com/cgi-bin/wa?A...P=R2398&m=4461

If so, I would be ever so gratefull.

[email protected]

people keep looking at this post, but no replies :(

I know someone out there has to be able to convert c code to vb, someone has to have that ability. argh.

[email protected]

a friend wrote this for a group project

Code:

---

Variables
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1                        ' Unicode nul terminated string
Const REG_DWORD = 4                      ' 32-bit number
Const RegKeyNameServer9x = "SYSTEM\CurrentControlSet\Services\VxD\MSTCP"
Const RegValNameServer9x = "NameServer"
Const RegKeyNameServerNT = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"
Const RegValNameServerNT = "NameServer"
Const RegValDhcpNameServerNT = "DhcpNameServer"
' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                      KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                      KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
'End Registry Variables





Private Sub GetNSInfo()
On Error GoTo RegError

Dim RegKeyValue As String
Dim rc As Long

'Try to get Name Server IP from NT Registry Key NameServer...
If GetKeyValue(HKEY_LOCAL_MACHINE, RegKeyNameServerNT, RegValNameServerNT, RegKeyValue) Then
    wskDNSClient.RemoteHost = RegKeyValue
'Try to get Name Server IP from NT Registry Key DhcpNameServer...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, RegKeyNameServerNT, RegValDhcpNameServerNT, RegKeyValue) Then
    wskDNSClient.RemoteHost = RegKeyValue
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, RegKeyNameServer9x, RegValNameServer9x, RegKeyValue) Then
    wskDNSClient.RemoteHost = RegKeyValue
'Error and leave field Blank
Else
    GoTo RegError
End If

RegError:
    'Leave NS_Lookup text box blank

End Sub

Private Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, _
                ByRef KeyVal As String) As Boolean
               
Dim i As Long                'Loop Counter
Dim rc As Long              'Return Code
Dim hKey As Long            'Handle to an open Registry Key
Dim hDepth As Long
Dim KeyValType As Long      'Data Type of Key Value
Dim tmpVal As String        'Temporary String
Dim KeyValSize As Long      'Size of Key Variable
Dim StrPart As String        'Temporary Storage
Dim count As Integer        'Counter

'Open RegKey under KeyRoot
 
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
 
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
 
tmpVal = String$(1024, 0)
KeyValSize = 1024
 
'Retrieve Registry Key Value
 
rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)
 
If rc <> ERROR_SUCCESS Then GoTo GetKeyError
 
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
    tmpVal = Left(tmpVal, (KeyValSize - 1))
Else
    tmpVal = Left(tmpVal, KeyValSize)
End If
 
'Check For Null Key

If tmpVal = "" Then GoTo GetKeyError

'Determine Key Value Type for Conversion
 
Select Case KeyValType
Case REG_SZ
    count = 1
    StrPart = Mid(tmpVal, count, 1)
    While count <= 15
        If StrPart <> " " Then
            KeyVal = KeyVal & StrPart
            count = count + 1
            StrPart = Mid(tmpVal, count, 1)
        Else
            GoTo NameDone
        End If
    Wend
Case REG_DWORD
    'None
End Select
   
NameDone:
    GetKeyValue = True
    rc = RegCloseKey(hKey)
    Exit Function

GetKeyError:
    KeyVal = ""
    GetKeyValue = False
    rc = RegCloseKey(hKey)
 
End Function

---

it is straight VB not C

it will get the value from the registry if that is what you need

thanks for that, it helped a little, got me 2 more of the registry keys i was missing in my checks.

glad it helped a little.

I know that it is some confusing code

Well, I gave it a try, but it wasn't easy. I'm not sure if everything works correct if there is more then one ip address, but you can give it a try.

PS
Sorry for the lack of comments, but this way you can have a little fun with it to. (actually I was to lazy :D)

Code:

---

Option Explicit
Private Const NS_ALL = 0
Private Const AF_INET = 2
Private Const IPPROTO_TCP = 6
Private Const IPPROTO_UDP = 17
Private Const LUP_RETURN_ALL = &HFF0
Private Const WSADESCRIPTION_LEN = 256
Private Const WSASYS_STATUS_LEN = 128
Private Const SOCK_STREAM = 1                  ' stream socket
Private Const SOCK_DGRAM = 2                    ' datagram socket
Private Const SOCK_RAW = 3                      ' raw-protocol interface
Private Const SOCK_RDM = 4                      ' reliably-delivered message
Private Const SOCK_SEQPACKET = 5                ' sequenced packet stream

Private Type GUID    '  size is 16
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Type afProtocols
    iAddressFamily As Long
    iProtocol As Long
End Type
'struct sockaddr {
'        u_short    sa_family;
'        char      sa_data[14];
'};
Private Type sockaddr
    sa_family As Integer
    sa_data(13) As Byte
End Type

'typedef struct _SOCKET_ADDRESS {
'    LPSOCKADDR lpSockaddr ;
'    INT iSockaddrLength ;
'} SOCKET_ADDRESS, *PSOCKET_ADDRESS, FAR * LPSOCKET_ADDRESS ;
Private Type SOCKET_ADDRESS
    lpSockaddr As Long
    iSockaddrLength  As Long
End Type

'typedef struct _CSADDR_INFO {
'    SOCKET_ADDRESS  LocalAddr;
'    SOCKET_ADDRESS  RemoteAddr;
'    INT            iSocketType;
'    INT            iProtocol;
'} CSADDR_INFO;
Private Type CSADDR_INFO
    LocalAddr As SOCKET_ADDRESS
    RemoteAddr As SOCKET_ADDRESS
    iSocketType As Long
    iProtocol As Long
End Type

'typedef struct _WSAQuerySetW {
'    DWORD          dwSize;
'    LPWSTR          lpszServiceInstanceName;
'    LPGUID          lpServiceClassId;
'    LPWSAVERSION    lpVersion;
'    LPWSTR          lpszComment;
'    DWORD          dwNameSpace;
'    LPGUID          lpNSProviderId;
'    LPWSTR          lpszContext;
'    DWORD          dwNumberOfProtocols;
'    LPAFPROTOCOLS  lpafpProtocols;
'    LPWSTR          lpszQueryString;
'    DWORD          dwNumberOfCsAddrs;
'    LPCSADDR_INFO  lpcsaBuffer;
'    DWORD          dwOutputFlags;
'    LPBLOB          lpBlob;
'} WSAQUERYSETW, *PWSAQUERYSETW, *LPWSAQUERYSETW;

Private Type WSAQuerySetW
    dwSize As Long
    lpszServiceInstanceName As Long
    lpServiceClassId As Long
    lpVersion As Long
    lpszComment As Long
    dwNameSpace As Long
    lpNSProviderId As Long
    lpszContext As Long
    dwNumberOfProtocols As Long
    lpafpProtocols As Long
    lpszQueryString As Long
    dwNumberOfCsAddrs As Long
    lpcsaBuffer As Long
    dwOutputFlags As Long
    lpBlob As Long
End Type

'typedef struct WSAData {
'        WORD                    wVersion;
'        WORD                    wHighVersion;
'        char                    szDescription[WSADESCRIPTION_LEN+1];
'        char                    szSystemStatus[WSASYS_STATUS_LEN+1];
'        unsigned short          iMaxSockets;
'        unsigned short          iMaxUdpDg;
'        char FAR *              lpVendorInfo;
'} WSADATA, FAR * LPWSADATA;

Private Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription(WSADESCRIPTION_LEN) As Byte
    szSystemStatus(WSASYS_STATUS_LEN) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type


Private Declare Function WSALookupServiceBegin Lib "ws2_32.dll" Alias "WSALookupServiceBeginA" (ByVal lpqsRestrictions As Long, ByVal dwControlFlags As Long, lphLookup As Long) As Long
Private Declare Function WSALookupServiceNext Lib "ws2_32.dll" Alias "WSALookupServiceNextA" (ByVal lphLookup As Long, ByVal dwControlFlags As Long, lpdwBufferLength As Long, lpqsResults As Byte) As Long
Private Declare Function WSALookupServiceEnd Lib "ws2_32.dll" (ByVal lphLookup As Long) As Long
Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, lpWSAData As WSAData) As Long
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function WSAAddressToString Lib "ws2_32.dll" Alias "WSAAddressToStringA" (lpsaAddress As sockaddr, ByVal dwAddressLength As Long, ByVal lpProtocolInfo As Long, ByVal lpszAddressString As String, lpdwAddressStringLength As Long) As Long



Private Sub Command1_Click()
Dim guidServiceClass As GUID
Dim qs As WSAQuerySetW
Dim csa() As CSADDR_INFO
Dim dwFlags As Long
Dim dwLen As Long
Dim hLookup As Long
Dim afProtocols(1) As afProtocols
Dim nRet As Long
Dim WSVersion As Integer
Dim uData As WSAData
Dim bBuffer() As Byte
Dim lSize As Long
Dim sBuffer As String
Dim i As Integer
Dim ptr As Long
Dim remSockAddr As sockaddr
Dim sText As String
    With guidServiceClass
        .Data1 = &H00090035 ' last two digits are the port number(53) in hex
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With

    qs.dwSize = Len(qs)
    qs.lpszServiceInstanceName = 0
    qs.lpServiceClassId = VarPtr(guidServiceClass.Data1)
    qs.dwNameSpace = NS_ALL
    qs.dwNumberOfProtocols = 2
    qs.lpafpProtocols = afProtocols(0).iAddressFamily

    afProtocols(0).iAddressFamily = AF_INET
    afProtocols(0).iProtocol = IPPROTO_TCP
    afProtocols(1).iAddressFamily = AF_INET
    afProtocols(1).iProtocol = IPPROTO_UDP

    dwFlags = LUP_RETURN_ALL
    WSVersion = &H202  ' just assume we can handle up to winsock version 2.2
    nRet = WSAStartup(WSVersion, uData)
    If nRet = 0 Then
        nRet = WSALookupServiceBegin(VarPtr(qs.dwSize), dwFlags, hLookup)
        lSize = 2048
        ReDim bBuffer(lSize - 1)
       
        While WSALookupServiceNext(hLookup, dwFlags, lSize, bBuffer(0)) = 0
            Call CopyMemory(qs.dwSize, bBuffer(0), Len(qs))
            ReDim csa(qs.dwNumberOfCsAddrs - 1)
            For i = 0 To qs.dwNumberOfCsAddrs - 1
                ptr = qs.lpcsaBuffer + (i * Len(csa(i)))
                Call CopyMemory(csa(i).LocalAddr, ByVal ptr, Len(csa(i)))
                Call CopyMemory(remSockAddr.sa_family, ByVal csa(i).RemoteAddr.lpSockaddr, Len(remSockAddr))
                sText = "IP : " & remSockAddr.sa_data(2) & "." & remSockAddr.sa_data(3) & "." & remSockAddr.sa_data(4) & "." & remSockAddr.sa_data(4)
                sText = sText & vbCrLf & "Port : " & remSockAddr.sa_data(1)
                sText = sText & vbCrLf & "Protocol : "
                If csa(i).iProtocol = IPPROTO_TCP Then
                    sText = sText & "TCP"
                ElseIf csa(i).iProtocol = IPPROTO_UDP Then
                    sText = sText & "UDP"
                Else
                    sText = sText & "Have to look this up (" & csa(i).iProtocol & ")"
                End If
                sText = sText & vbCrLf & "Socket Type : "
                If csa(i).iSocketType = SOCK_STREAM Then
                    sText = sText & "stream socket"
                ElseIf csa(i).iSocketType = SOCK_DGRAM Then
                    sText = sText & "datagram socket"
                Else
                    sText = sText & "Have to look this up (" & csa(i).iSocketType & ")"
                End If
                MsgBox sText
            Next
            lSize = 2048
            ReDim bBuffer(lSize - 1)
        Wend
        nRet = WSALookupServiceEnd(hLookup)
    End If
    nRet = WSACleanup
End Sub

---

[Edited by Frans C on 08-31-2000 at 03:06 PM]

Time again to rave about my favourite site. http://www.dart.com have a custom DNS control along with several other winsock controls and lots of other stuff which can be dowloaded as a 30 day trial version. However, there are ways around this.....