Solved

[Help]Stocked in vb6 Project Get AdapterName

Posted on 2008-10-17
16
433 Views
Last Modified: 2013-11-27
Hi all i got one quetion and im stocked so i wanted to know an sollution to this problem so if somone feels able to help me please help

Ok my problem is that i want to creat an IP Tool application and i want to get the Adapter Name of each NIC so i know where they are stored in the registry
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0000
and it goes on to each new NIC 1 ,2 ,4 ,5
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0001
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0002
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0003
ok they are now 2 keys first called Name and the second is DriverDesc my problem is how to use

(wscript.shell) to loop through the registry key
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0000
and get the 2 keys into a listbox

ok ive tryed to so somthing but it faild take a look


Private Sub Command1_Click()
Dim Reg As Object
Dim i As Integer
Dim Adapter()
Dim StringDriver
Dim StringName
'Dim Itemtype

StringDriver = "\DriverDesc"
StringName = "\Name"
Itemtype = "String"

For i = 0 To 20

Reg = CreateObject("WScript.Shell")
Adapter() = Reg.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E972-E325-11CE-BFC1-08002BE10318}\" & "\000" & i & StringDriver & StringName)

List1.AddItem Adapter(i)
Next
End Sub

Please dont give me link to registry class modules or anything else i just want to make this work i dont cause its blowing my head up :H sorry for my bad english help if you know how
0
Comment
Question by:Kresha7
  • 9
  • 7
16 Comments
 
LVL 18

Expert Comment

by:mdougan
ID: 22741206
What, exactly, is the error you get when it fails?

Didn't you say that the Name was the first key and the description the second?  You've got description first followed by name, maybe you need to reverse them.

Adapter() = Reg.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E972-E325-11CE-BFC1-08002BE10318}\" & "\000" & i & StringName & StringDriver)

There are other ways of reading the registery through VB that are much easier.
0
 
LVL 1

Author Comment

by:Kresha7
ID: 22741406
example ?
the problem is the loop funtion in this beta code i did
0
 
LVL 18

Expert Comment

by:mdougan
ID: 22742152
Sorry, I thought it was your Registry Reading code that was giving you the problem, I didn't look closely at your Loop code.  The problem is with the way you are handling the Adapter array.  Since you do not declare it with a dimension, you need to dimension it before you use it, and then redim it on every iteration of the loop:

Dim i As Integer
Dim Adapter() as String

Redim Adapter(0) As String

For i = 0 To 20
   Reg = CreateObject("WScript.Shell")
   Adapter(i) = Reg.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E972-E325-11CE-BFC1-08002BE10318}\" & "\000" & i & StringDriver & StringName)
   List1.AddItem Adapter(i)
   if i = 20 Exit For
   Redim Adapter(UBound(Adapter) + 1) As String
Next
End Sub
0
 
LVL 1

Author Comment

by:Kresha7
ID: 22747503
mdougan did you try your code because it still dosent work im using vb6 please try it and if possible attach the project when its working
0
 
LVL 18

Accepted Solution

by:
mdougan earned 50 total points
ID: 22748471
Hi, I did forget one thing in the final Redim statement, and that was the Preserve keyword.  Without that, it wipes the contents of the array each time you re-dimension it.  I tested the following code in VB6 and it works as expected.  It is basically the same as your code, but I don't have the registery values you do, so, I just give you the example of re-dimensioning the array, the rest is up to you.

Private Sub Command1_Click()
Dim i As Long
Dim aLines() As String

ReDim aLines(0) As String
For i = 0 To 20
   aLines(i) = "Line No:" & i
   If i = 20 Then Exit For
   ReDim Preserve aLines(UBound(aLines) + 1) As String
Next

For i = 0 To UBound(aLines)
    MsgBox aLines(i)
Next
End Sub
0
 
LVL 1

Author Comment

by:Kresha7
ID: 22748561
thx mdougan the easi part was for me to do the loop but the hard one is the integration into the wscript.RegRead it dosent work :S thats the main problem but thx for your help anyway
0
 
LVL 1

Author Comment

by:Kresha7
ID: 22748582
so if you can intigrate your redim into my source code thx a lot :H
0
 
LVL 18

Expert Comment

by:mdougan
ID: 22749821
The original code I gave you was integrated with your registery reading code.  It was only missing the Preserve keyword on one of the Redim statements.

Dim i As Integer
Dim Adapter() as String

Redim Adapter(0) As String

For i = 0 To 20
   Reg = CreateObject("WScript.Shell")
   Adapter(i) = Reg.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E972-E325-11CE-BFC1-08002BE10318}\" & "\000" & i & StringDriver & StringName)
   List1.AddItem Adapter(i)
   if i = 20 Exit For
   Redim Preserve Adapter(UBound(Adapter) + 1) As String
Next
End Sub

If you want me to help you solve your problem, you have to be more descriptive than "It doesn't work"

What error are you getting?  Does it mention a line number?  What is the code on that line number?

Can you go to your registery and give me the exact key from the registry that you are trying to read the value from?  Just one should do.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 1

Author Comment

by:Kresha7
ID: 22750175
runtime error 438

i cant undestand why its not working :S





Private Sub Command1_Click()
Dim i As Integer
Dim Adapter() As String
Dim StringDriver
Dim StringName


StringDriver = "\DriverDesc"
StringName = "\Name"

ReDim Adapter(0) As String

For i = 0 To 20
   Reg = CreateObject("WScript.Shell")
   Adapter(i) = Reg.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E972-E325-11CE-BFC1-08002BE10318}\" & "\000" & i & StringDriver & StringName)
   List1.AddItem Adapter(i)
   If i = 20 Then Exit For
   ReDim Preserve Adapter(UBound(Adapter) + 1) As String
Next

End Sub
0
 
LVL 18

Expert Comment

by:mdougan
ID: 22750444
Well, if you google runtime error 438 it tells you that "object does not support this property or method".

If you step through your code in debug mode, you should be able to tell exactly what instruction you get the error on.  However, you have not yet provided that information.  So, I suggest that you step through this procedure one line at a time and tell me which line generates that error.

I suspect that the line that generates the error is the RegRead line.  Or, perhaps the CreateObject line.  If that is the case, then it points out that you either do not have WScript.Shell registered correctly on the machine.  Or, that you might have a version that is not compatible with your code.

I have other registery reading code... code that uses the Windows API to read from the registry.  However, I'd prefer that you verify that it is the registery reading code that is causing the error before I paste any of that.

You still haven't given me the exact KEY that you are searching for in the registry.  If you don't give me what I ask for, I can't help you.
0
 
LVL 1

Author Comment

by:Kresha7
ID: 22750454
Its excualy a subkey ok what i want is retriev the adapter name from the regkey
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}
so every NIC has it directory like you see 0000 then 0001 etc what i need is the subkey its a string key called Name and another called DriverDesc

this are example direcorys to an Network Adapter not including the subkey
-----------------------------------------------------------
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0000
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0001
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0002
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0003

im realy sorry for this is anoying to you i know :S but im not that skilled to get the answer on my own :S and realy sorry for my bad english
0
 
LVL 18

Expert Comment

by:mdougan
ID: 22750471
It's not annoying me, but I'm just trying to get you to provide enough information so that I can help you.

so, for example, you would like to get the values from a couple of keys called:

HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0000\Name

and

HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0000\DriverDesc

But, your sample code just shows you putting one value into a listbox... which value is it that you are trying to put into the listbox?

And, you have to tell me which line of code is generating the error.  You can find out by putting a breakpoint on the first line of the proceedure, then running until you get to that line, then use Shift-F8 to step through one line at a time until the error occurs.
0
 
LVL 1

Author Comment

by:Kresha7
ID: 22750490
yes i wanna loop through every key example
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0000\Name
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0000\DriverDesc

HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0001\Name
HKLM\SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\0001\DriverDesc

and get every adapter name unstil an error accures and tell's me that there is no wireless adapter anymore or NIC ok ok i stept through the code and the error is like you sad Reg.RegRead
0
 
LVL 18

Expert Comment

by:mdougan
ID: 22752722
OK, let's try this.  I dug up some old registry reading code (see code snippet).  Create a Visual Basic Module and paste that code into it.  Then, you can try this code to read the values from your registry.  I don't have the VB6 computer available to me today, so, no, I couldn't test it.  But, I've used this old code to read the registry before, so, it should work.

Private Sub Command1_Click()
Dim i As Integer
Dim Adapter() As String
Dim sValueName As String
Dim sKeyName As String

  sKeyName = "SYSTEM\CurrentControlSet\Control\Class\{4D36E 972-E325-11CE-BFC1-08002BE10318}\"
  sValueName = "Name"
 ReDim Adapter(0) As String

For i = 0 To 20
   Adapter(i) = QueryValue(sKeyName & format(i,"0000"), sValueName)
   If Adapter(i) <> "" Then
      List1.AddItem Adapter(i)
   End If
   If i = 20 Then Exit For
   ReDim Preserve Adapter(UBound(Adapter) + 1) As String
Next

End Sub
Option Explicit
 

' Reg Data Types...

Global Const REG_NONE = 0                       ' No value type

Global Const REG_SZ = 1                         ' Unicode nul terminated string

Global Const REG_EXPAND_SZ = 2                  ' Unicode nul terminated string

Global Const REG_BINARY = 3                     ' Free form binary

Global Const REG_DWORD = 4                      ' 32-bit number

Global Const REG_DWORD_LITTLE_ENDIAN = 4        ' 32-bit number (same as REG_DWORD)

Global Const REG_DWORD_BIG_ENDIAN = 5           ' 32-bit number

Global Const REG_LINK = 6                       ' Symbolic Link (unicode)

Global Const REG_MULTI_SZ = 7                   ' Multiple Unicode strings

Global Const REG_RESOURCE_LIST = 8              ' Resource list in the resource map

Global Const REG_FULL_RESOURCE_DESCRIPTOR = 9   ' Resource list in the hardware description
 

Global Const HKEY_CLASSES_ROOT = &H80000000

Global Const HKEY_CURRENT_USER = &H80000001

Global Const HKEY_LOCAL_MACHINE = &H80000002

Global Const HKEY_USERS = &H80000003
 

Global Const ERROR_NONE = 0

Global Const ERROR_BADDB = 1

Global Const ERROR_BADKEY = 2

Global Const ERROR_CANTOPEN = 3

Global Const ERROR_CANTREAD = 4

Global Const ERROR_CANTWRITE = 5

Global Const ERROR_OUTOFMEMORY = 6

Global Const ERROR_INVALID_PARAMETER = 7

Global Const ERROR_ACCESS_DENIED = 8

Global Const ERROR_INVALID_PARAMETERS = 87

Global Const ERROR_NO_MORE_ITEMS = 259
 

Global Const KEY_ALL_ACCESS = &H3F
 

Global Const SYNCHRONIZE = &H100000

Global Const STANDARD_RIGHTS_ALL = &H1F0000

' Reg Key Security Options

Global Const KEY_QUERY_VALUE = &H1

Global Const KEY_SET_VALUE = &H2

Global Const KEY_CREATE_SUB_KEY = &H4

Global Const KEY_ENUMERATE_SUB_KEYS = &H8

Global Const KEY_NOTIFY = &H10

Global Const KEY_CREATE_LINK = &H20

'Global Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
 
 

Global Const REG_OPTION_NON_VOLATILE = 0
 

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long

Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
 

Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long

Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
 

Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)

    Dim hNewKey As Long         'handle to the new key

    Dim lRetVal As Long         'result of the RegCreateKeyEx function

    

    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _

              vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _

              0&, hNewKey, lRetVal)

    RegCloseKey (hNewKey)

End Sub
 

Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)

    Dim Zero As Long, IRetVal As Long, hKey As Long, OrigKeyNam As String

    

'    OrigKeyNam = Left$(sKeyName, InStr(sKeyName + "\", "\") - 1)

    

     'open the specified key

    IRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, Zero, KEY_ALL_ACCESS, hKey)

    If IRetVal Then MsgBox "RegOpenKey error - " & IRetVal

    IRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)

    If IRetVal Then MsgBox "SetValue error - " & IRetVal

    RegCloseKey (hKey)

End Sub
 

Function QueryValue(sKeyName As String, sValueName As String) As String

       Dim lRetVal As Long         'result of the API functions

       Dim hKey As Long         'handle of opened key

       Dim vValue As Variant      'setting of queried value
 

       lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, KEY_QUERY_VALUE, hKey)

       lRetVal = QueryValueEx(hKey, sValueName, vValue)

       If lRetVal = ERROR_BADKEY Then

          vValue = ""

       End If

       RegCloseKey (hKey)

       QueryValue = CStr(vValue)

End Function
 

Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
 

    Dim lValue As Long

    Dim sValue As String

    Select Case lType

        Case REG_SZ

            sValue = vValue & Chr$(0)

            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))

        Case REG_DWORD

            lValue = vValue

            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
 

        End Select
 

End Function
 

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
 

    Dim cch As Long

    Dim lrc As Long

    Dim lType As Long

    Dim lValue As Long

    Dim sValue As String
 

    On Error GoTo QueryValueExError
 

    ' Determine the size and type of data to be read

    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)

    If lrc <> ERROR_NONE Then Error 5
 

    Select Case lType

        ' For strings

        Case REG_SZ:

            sValue = String(cch, 0)
 

 lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
 

            If lrc = ERROR_NONE Then

                vValue = Left$(sValue, cch)

            Else

                vValue = Empty

            End If

        ' For DWORDS

        Case REG_DWORD:
 

lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
 

            If lrc = ERROR_NONE Then vValue = lValue

        Case Else

            'all other data types not supported

            lrc = -1

    End Select
 

QueryValueExExit:
 

    QueryValueEx = lrc

    Exit Function
 

QueryValueExError:
 

    Resume QueryValueExExit
 

End Function

Open in new window

0
 
LVL 1

Author Comment

by:Kresha7
ID: 22756332
ok thx :D i wanted to do it with wscript but it seems it dosnt work so i do it with a class module that i got :D thx anyway you get 50 point for your help :D
0
 
LVL 1

Author Closing Comment

by:Kresha7
ID: 31507115
:D thx
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
sumDigits  challenge 7 62
endX challenge 2 50
firstChar challenge 13 86
Counting documents in a Domino View 3 36
Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now