DNS

[minoad]

I am looking for a way to access DNS server through VB. Any ideas would be great. I am Currenlty using the a Class library provided by a third party, but i would prefer to not use this.

Thanks

Micah A. Norman

 

[case81]

um i think its a function of the winsock control winsock1.gethostbyname, not sure sorry try it out

 

[minoad]

Thanks for the input, but i am looking for a way to programatically acces DNS. I think WMI may be the way to go, but i havent really had a chance over the last day or so to really sink my teeth into it.

Micah A. Norman

 

[case81]

Option Explicit

Const WSADescription_Len = 256
Const WSASYS_Status_Len = 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 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 WSAStartup Lib "wsock32" _
(ByVal VersionReq As Long, WSADataReturn As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32" () As Long
Private Declare Function WSAGetLastError Lib "wsock32" () As Long
Private Declare Function gethostbyaddr Lib "wsock32" (addr As Long, addrLen As Long, _
addrType As Long) As Long
Private Declare Function gethostbyname Lib "wsock32" (ByVal hostname As String) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, _
ByVal cbCopy As Long)

Public Event Error(ByVal Number As Long, Description As String)
Public Event ResolveCompleted()

'checks if string is valid IP address
Private Function IsIP(ByVal strIP As String) As Boolean
On Error Resume Next
Dim t As String: Dim s As String: Dim i As Integer
s = strIP
While InStr(s, &quot;.&quot <> 0
t = Left(s, InStr(s, &quot;.&quot - 1)
If IsNumeric(t) And Val(t) >= 0 And Val(t) <= 255 Then s = Mid(s, InStr(s, &quot;.&quot + 1) _
Else Exit Function
i = i + 1
Wend
t = s
If IsNumeric(t) And InStr(t, &quot;.&quot = 0 And Len(t) = Len(Trim(Str(Val(t)))) And _
Val(t) >= 0 And Val(t) <= 255 And strIP <> &quot;255.255.255.255&quot; And i = 3 Then IsIP = True
If Err.Number > 0 Then
RaiseEvent Error(Err.Number, Err.Description)
Err.Clear
End If
End Function

'converts IP address from string to sin_addr
Private Function MakeIP(strIP As String) As Long
On Error Resume Next
Dim lIP As Long
lIP = Left(strIP, InStr(strIP, &quot;.&quot - 1)
strIP = Mid(strIP, InStr(strIP, &quot;.&quot + 1)
lIP = lIP + Left(strIP, InStr(strIP, &quot;.&quot - 1) * 256
strIP = Mid(strIP, InStr(strIP, &quot;.&quot + 1)
lIP = lIP + Left(strIP, InStr(strIP, &quot;.&quot - 1) * 256 * 256
strIP = Mid(strIP, InStr(strIP, &quot;.&quot + 1)
If strIP < 128 Then
lIP = lIP + strIP * 256 * 256 * 256
Else
lIP = lIP + (strIP - 256) * 256 * 256 * 256
End If
MakeIP = lIP
If Err.Number > 0 Then
RaiseEvent Error(Err.Number, Err.Description)
Err.Clear
End If
End Function

'resolves IP address to host name
Private Function NameByAddr(strAddr As String) As String
On Error Resume Next
Dim nRet As Long
Dim lIP As Long
Dim strHost As String * 255: Dim strTemp As String
Dim hst As HOSTENT

If IsIP(strAddr) Then
lIP = MakeIP(strAddr)
nRet = gethostbyaddr(lIP, 4, 2)
If nRet <> 0 Then
RtlMoveMemory hst, nRet, Len(hst)
RtlMoveMemory ByVal strHost, hst.hName, 255
strTemp = strHost
If InStr(strTemp, Chr(10)) <> 0 Then strTemp = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
strTemp = Trim(strTemp)
NameByAddr = strTemp
Else
RaiseEvent Error(9003, &quot;Host name not found&quot
Exit Function
End If
Else
RaiseEvent Error(9002, &quot;Invalid IP address&quot
Exit Function
End If
If Err.Number > 0 Then
RaiseEvent Error(Err.Number, Err.Description)
Err.Clear
End If
End Function

'resolves host name to IP address
Private Function AddrByName(ByVal strHost As String)
On Error Resume Next
Dim hostent_addr As Long
Dim hst As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String
If IsIP(strHost) Then
AddrByName = strHost
Exit Function
End If
hostent_addr = gethostbyname(strHost)
If hostent_addr = 0 Then
RaiseEvent Error(9001, &quot;Can't resolve hst&quot
Exit Function
End If
RtlMoveMemory hst, hostent_addr, LenB(hst)
RtlMoveMemory hostip_addr, hst.hAddrList, 4
ReDim temp_ip_address(1 To hst.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, hst.hLength
For i = 1 To hst.hLength
ip_address = ip_address & temp_ip_address(i) & &quot;.&quot;
Next
ip_address = Mid(ip_address, 1, Len(ip_address) - 1)
AddrByName = ip_address
If Err.Number > 0 Then
RaiseEvent Error(Err.Number, Err.Description)
Err.Clear
End If
End Function

Public Function AddressToName(strIP As String)
AddressToName = NameByAddr(strIP)
'RaiseEvent ResolveCompleted
End Function

Public Function NameToAddress(strName As String)
NameToAddress = AddrByName(strName)
'RaiseEvent ResolveCompleted
End Function

Private Sub Form_Load()
Dim udtWSAData As WSADATA
Dim reg_count As Integer
Dim reg_loop As Integer
Dim reg_val As String

If WSAStartup(257, udtWSAData) Then RaiseEvent Error(Err.LastDllError, Err.Description)

reg_loop = 1
reg_count = 0
reg_val = &quot;&quot;

While reg_loop = 1

reg_val = GetSetting(&quot;CHI NS Lookup&quot;, &quot;Recent&quot;, &quot;recent&quot; & reg_count)
reg_count = reg_count + 1
If reg_val <> &quot;&quot; Then
text1.AddItem (reg_val)
reg_val = &quot;&quot;
Else
reg_loop = 0
End If

Wend


End Sub

Private Sub Form_Terminate()
WSACleanup
End Sub

Private Sub Label2_Click()

Dim ipcheck As Boolean, Found As Integer, i As Integer
Dim retaddy As String
Dim requery As String
Dim recent_pos As Integer


Found = 0

ipcheck = IsIP(text1.Text)
If ipcheck = True Then
Label1.Caption = AddressToName(text1.Text)
Else
retaddy = NameToAddress(text1.Text)
Label1.Caption = retaddy
If retaddy <> &quot;&quot; Then
requery = AddressToName(retaddy)
If requery <> &quot;&quot; Then
Label1.Caption = Label1.Caption & &quot; - (&quot; & requery & &quot&quot;
End If
Else
Label1.Caption = &quot;Unable to resolve&quot;
End If


End If
If Trim(text1.Text) <> &quot;&quot; Then

For i = 0 To text1.ListCount Step 1
If text1.List(i) = text1.Text Then
Found = 1
End If
Next i
If Found <> 1 Then
recent_pos = text1.ListCount - 10
If recent_pos >= 0 Then
If recent_pos > 9 Then
SaveSetting &quot;CHI NS Lookup&quot;, &quot;Recent&quot;, &quot;recent0&quot;, text1.Text
Else
SaveSetting &quot;CHI NS Lookup&quot;, &quot;Recent&quot;, &quot;recent&quot; & recent_pos, text1.Text
End If
Else
SaveSetting &quot;CHI NS Lookup&quot;, &quot;Recent&quot;, &quot;recent&quot; & text1.ListCount, text1.Text
End If
text1.AddItem (text1.Text)
End If

End If
End Sub

Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label2.ForeColor = &HFFFFFF
End Sub


Private Sub Label2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label2.ForeColor = &H80000012
End Sub

Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Label2_Click
End If
End Sub

 

[zaff]

Hi,
In a project, I had to code a component to programmatically access DNS and add zones and records. I did it by running a .vbs file with shell command in VB. In Microsoft web site (msdn.microsoft.com/library), a script coded in VBScript is provided and it uses DNS WMI to access DNS Server.

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dns/dns_wmi_7cc7.asp)

I installed the DNS WMI provider and then did the things above. But after running smoothly for a couple of times, it began not to work. Script works fine individually. I don't think to modify DNS running a script with shell command works fine. So I need another solution or fix to my problem.
Maybe , my way is ok but I may be wrong in applying it.

Waiting for new ideas,

Zafer