|
-
Aug 30th, 2000, 09:55 AM
#1
Thread Starter
Member
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]
-
Aug 30th, 2000, 01:21 PM
#2
Thread Starter
Member
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]
-
Aug 30th, 2000, 02:51 PM
#3
Lively Member
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
VB 6 Professional Edition
-
Aug 30th, 2000, 03:08 PM
#4
Thread Starter
Member
thanks for that, it helped a little, got me 2 more of the registry keys i was missing in my checks.
-
Aug 31st, 2000, 07:31 AM
#5
Lively Member
glad it helped a little.
I know that it is some confusing code
VB 6 Professional Edition
-
Aug 31st, 2000, 01:38 PM
#6
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 )
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]
-
Aug 31st, 2000, 01:55 PM
#7
Hyperactive Member
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.....
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|