ReSQL.ru
     
powered by simpleCommunicator - 2.0.54     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / реестр. читаем все ключи в ветке
25 сообщений из 31, страница 1 из 2
  1  все
реестр. читаем все ключи в ветке
    #36029621
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
Вопрос в том, как получить список всех ключей в ветке реестра?
Т.е. есть, к примеру, адрес HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run . Как узнать, что у нас за ключи в авторане по этому адресу?
...
Рейтинг: 0 / 0
07.06.2009, 11:58
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
реестр. читаем все ключи в ветке
    #37394546
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
апну тему пожалуй)
снова потребовалось
...
Рейтинг: 0 / 0
14.08.2011, 15:14
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37394554
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
GetAllSettings, если не ошибаюсь
...
Рейтинг: 0 / 0
14.08.2011, 15:28
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37394572
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ципихович Эндрю
Участник
Чтение данных из реестра:
GetSetting AppName, Section, Key, Default
'// AppName - название вашей программы
Section - ключ, Key - имя параметра, Default - значение, которое будет возвращено функцией, если параметра не существует


Удаление данных из реестра:
DeleteSetting AppName, Section, Key
'// AppName - название вашей программы
Section - ключ, Key - имя параметра
Примечание: если вы хотите удалить подраздел целиком, то имя ключа указывать не нужно.


Получение всех имён и значений параметров заданного ключа:
GetAllSetting AppName, Section
'// AppName - название вашей программы
Section - ключ

Пример:
'// Объявляем переменные
Dim intKeys As Integer, strKeys As Variant
'// Используем функцию GetAllSettings
strKeys = GetAllSettings("MyApp", "MySection")
'// Получаем границы массива ключей и выполняем цикл
For intKeys = LBound(strKeys, 1) To UBound(strKeys, 1)
'// Выводим результат
Debug.Print strKeys(intKeys, 0), strKeys(intKeys, 1)

Next intKeys
...
Рейтинг: 0 / 0
14.08.2011, 15:54
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37394768
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
Не то.
Речь не идёт о тех ключах с которыми бэйсик без апи работает.
Там только его маленькая ветка.

интересует именно выбрать из произвольной ветки все её ключи

кто-то уже поднимал такие темы тут
http://bbs.vbstreets.ru/viewtopic.php?f=9&t=39191
и тут
http://www.vbnet.ru/forum/show.aspx?id=191903

но в обоих исходного кода уже нет.

вопрос открыт
...
Рейтинг: 0 / 0
14.08.2011, 20:54
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37394777
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
RegEnumKeyEx
...
Рейтинг: 0 / 0
14.08.2011, 21:10
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37394799
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
А нет простого примера для работы с RegEnumKeyEx ?

советуют подключить REGTOOL5.DLL, но не хочу привязывать сторонний хвост из библиотек.
...
Рейтинг: 0 / 0
14.08.2011, 21:49
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37394940
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
kalamfur,

Вот код,перебирающий все подключи. В моем случае выбирает только некоторые, но есть желание -переделаешь

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
Public Sub GetUninstallKeys()
    Dim I As Integer
    Dim strSearch As String
    Dim intSearchLen As Integer
    Dim lngResult As Long
    Dim lngKeyHandle As Long
    Dim lngCurIdx As Long
    Dim lngValueLen As Long
    Dim strValue As String
    Dim lngClassLen As Long
    Dim strClass As String
    Dim lngTime As FILETIME
    Dim strResult As String
    Dim blnMatch As Boolean
    
    HasUN = False 'нет точек входа
    I =  0 
    ' Assign the new string to search for
    strSearch = "TheProga"
    intSearchLen = Len(strSearch)
    
    ' Open the Root Branch to search
    lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
            "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall", _
              0 &, _
             KEY_READ, _
             lngKeyHandle)
    
    If lngResult <> ERROR_SUCCESS Then
        'MsgBox "Cannot open key.", , "Search Registry Keys"
    Else
    ' If the Root branch can be opened, begin the search
        lngCurIdx =  0 
        Do
            lngValueLen =  2000 
            strValue = String(lngValueLen,  0 )
            lngClassLen =  2000 
            strClass = String(lngClassLen,  0 )
        
            ' Enumerate all the sub keys
            lngResult = RegEnumKeyEx(lngKeyHandle, _
                 lngCurIdx, _
                 ByVal strValue, _
                 lngValueLen, _
                  0 &, _
                 ByVal strClass, _
                 lngClassLen, _
                 lngTime)
           
            ' Increment the index of found keys
            lngCurIdx = lngCurIdx +  1 
        
            If lngResult = ERROR_SUCCESS Then
                ' Trim the current key to its actual length
                strResult = Left(strValue, lngValueLen)
                
                ' Eliminate case if the search is insensitive
                blnMatch = False
                strValue = strResult
                
                strResult = LCase(strResult)
                strSearch = LCase(strSearch)

                ' Compare strings based upon search type
                ' Check if the search string matches the
                ' left portion of the key string.
                If Left(strResult, intSearchLen) = strSearch Then blnMatch = True
                
                ' Populate the list with keys that match
                ' the search criteria
                If blnMatch Then
                    I = I +  1 
                    HasUN = True 'есть хотя бы одна точка входа
                    ReDim Preserve UN( 1  To I)
                    UN(I).Key = strValue
                End If
            End If
        
        ' Keep looking for more keys
        Loop While lngResult = ERROR_SUCCESS
        ' Close the Root Branch
        lngResult = RegCloseKey(lngKeyHandle)
        
        ' Display the total matches
        'MsgBox "Total matches:" & Str(i), , "Search Registry Keys"
    End If
End Sub
...
Рейтинг: 0 / 0
15.08.2011, 00:31
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396794
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
2Дмитрий77
Спасибо за код, но никак не пойму, ругается на это:
Код: plaintext
Dim lngTime As FILETIME
...
Рейтинг: 0 / 0
15.08.2011, 23:08
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396800
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
Код: plaintext
1.
2.
3.
Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
...
Рейтинг: 0 / 0
15.08.2011, 23:11
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396809
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
итого получился вот такой модуль

 
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
    Dim I As Integer
    Dim strSearch As String
    Dim intSearchLen As Integer
    Dim lngResult As Long
    Dim lngKeyHandle As Long
    Dim lngCurIdx As Long
    Dim lngValueLen As Long
    Dim strValue As String
    Dim lngClassLen As Long
    Dim strClass As String
    Dim lngTime As FILETIME
    Dim strResult As String
    Dim blnMatch As Boolean
    Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME)

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public Sub GetUninstallKeys()

    HasUN = False 'íåò òî÷åê âõîäà
    I =  0 
    ' Assign the new string to search for
    strSearch = "TheProga"
    intSearchLen = Len(strSearch)
    
    ' Open the Root Branch to search
    lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
            "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall", _
              0 &, _
             KEY_READ, _
             lngKeyHandle)
    
    If lngResult <> ERROR_SUCCESS Then
        'MsgBox "Cannot open key.", , "Search Registry Keys"
    Else
    ' If the Root branch can be opened, begin the search
        lngCurIdx =  0 
        Do
            lngValueLen =  2000 
            strValue = String(lngValueLen,  0 )
            lngClassLen =  2000 
            strClass = String(lngClassLen,  0 )
        
            ' Enumerate all the sub keys
            lngResult = RegEnumKeyEx(lngKeyHandle, _
                 lngCurIdx, _
                 ByVal strValue, _
                 lngValueLen, _
                  0 &, _
                 ByVal strClass, _
                 lngClassLen, _
                 lngTime)
           
            ' Increment the index of found keys
            lngCurIdx = lngCurIdx +  1 
        
            If lngResult = ERROR_SUCCESS Then
                ' Trim the current key to its actual length
                strResult = Left(strValue, lngValueLen)
                
                ' Eliminate case if the search is insensitive
                blnMatch = False
                strValue = strResult
                
                strResult = LCase(strResult)
                strSearch = LCase(strSearch)

                ' Compare strings based upon search type
                ' Check if the search string matches the
                ' left portion of the key string.
                If Left(strResult, intSearchLen) = strSearch Then blnMatch = True
                
                ' Populate the list with keys that match
                ' the search criteria
                If blnMatch Then
                    I = I +  1 
                    HasUN = True 'åñòü õîòÿ áû îäíà òî÷êà âõîäà
                    ReDim Preserve UN( 1  To I)
                    UN(I).Key = strValue
                End If
            End If
        
        ' Keep looking for more keys
        Loop While lngResult = ERROR_SUCCESS
        ' Close the Root Branch
        lngResult = RegCloseKey(lngKeyHandle)
        
        ' Display the total matches
        'MsgBox "Total matches:" & Str(i), , "Search Registry Keys"
    End If
End Sub


RegOpenKeyEx sub or function not defined )-:
...
Рейтинг: 0 / 0
15.08.2011, 23:20
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396813
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
kalamfurитого получился вот такой модульпеременные необязательно было выносить на уровень модуля....

kalamfurRegOpenKeyEx sub or function not defined )-:
В комплекте поставки студии есть такая штука - API Text Viewer. Там есть все определения функций API для VB. Научись пользоваться - пригодится не раз.
...
Рейтинг: 0 / 0
15.08.2011, 23:24
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396814
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
Дополнил так:

 
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
    Dim I As Integer
    Dim strSearch As String
    Dim intSearchLen As Integer
    Dim lngResult As Long
    Dim lngKeyHandle As Long
    Dim lngCurIdx As Long
    Dim lngValueLen As Long
    Dim strValue As String
    Dim lngClassLen As Long
    Dim strClass As String
    Dim lngTime As FILETIME
    Dim strResult As String
    Dim blnMatch As Boolean
Option Explicit

Public Const REG_SZ As Long =  1 
Public Const REG_DWORD As Long =  4 


Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_USERS = &H80000003


Public Const ERROR_NONE =  0 
Public Const ERROR_BADDB =  1 
Public Const ERROR_BADKEY =  2 
Public Const ERROR_CANTOPEN =  3 
Public Const ERROR_CANTREAD =  4 
Public Const ERROR_CANTWRITE =  5 
Public Const ERROR_OUTOFMEMORY =  6 
Public Const ERROR_INVALID_PARAMETER =  7 
Public Const ERROR_ACCESS_DENIED =  8 
Public Const ERROR_INVALID_PARAMETERS =  87 
Public Const ERROR_NO_MORE_ITEMS =  259 

Public Const KEY_ALL_ACCESS = &H3F

Public 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 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
Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
    Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME)

Public Sub GetUninstallKeys()

    HasUN = False 'íåò òî÷åê âõîäà
    I =  0 
    ' Assign the new string to search for
    strSearch = "TheProga"
    intSearchLen = Len(strSearch)
    
    ' Open the Root Branch to search
    lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall",  0 &, KEY_READ, lngKeyHandle)
    
    If lngResult <> ERROR_SUCCESS Then
        'MsgBox "Cannot open key.", , "Search Registry Keys"
    Else
    ' If the Root branch can be opened, begin the search
        lngCurIdx =  0 
        Do
            lngValueLen =  2000 
            strValue = String(lngValueLen,  0 )
            lngClassLen =  2000 
            strClass = String(lngClassLen,  0 )
        
            ' Enumerate all the sub keys
            lngResult = RegEnumKeyEx(lngKeyHandle, _
                 lngCurIdx, _
                 ByVal strValue, _
                 lngValueLen, _
                  0 &, _
                 ByVal strClass, _
                 lngClassLen, _
                 lngTime)
           
            ' Increment the index of found keys
            lngCurIdx = lngCurIdx +  1 
        
            If lngResult = ERROR_SUCCESS Then
                ' Trim the current key to its actual length
                strResult = Left(strValue, lngValueLen)
                
                ' Eliminate case if the search is insensitive
                blnMatch = False
                strValue = strResult
                
                strResult = LCase(strResult)
                strSearch = LCase(strSearch)

                ' Compare strings based upon search type
                ' Check if the search string matches the
                ' left portion of the key string.
                If Left(strResult, intSearchLen) = strSearch Then blnMatch = True
                
                ' Populate the list with keys that match
                ' the search criteria
                If blnMatch Then
                    I = I +  1 
                    HasUN = True 'åñòü õîòÿ áû îäíà òî÷êà âõîäà
                    ReDim Preserve UN( 1  To I)
                    UN(I).Key = strValue
                End If
            End If
        
        ' Keep looking for more keys
        Loop While lngResult = ERROR_SUCCESS
        ' Close the Root Branch
        lngResult = RegCloseKey(lngKeyHandle)
        
        ' Display the total matches
        'MsgBox "Total matches:" & Str(i), , "Search Registry Keys"
    End If
End Sub


но ошибки никак не закончились.
...
Рейтинг: 0 / 0
15.08.2011, 23:25
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396816
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
kalamfurRegOpenKeyEx sub or function not defined )-:

Код: plaintext
Declare Function RegOpenKeyEx...  etc.
...
Рейтинг: 0 / 0
15.08.2011, 23:26
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396819
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
kalamfurно ошибки никак не закончились. их тексты требуется угадать?
...
Рейтинг: 0 / 0
15.08.2011, 23:29
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396820
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
kalamfurно ошибки никак не закончились.
ну и разбирайся дальше, я тебе идею дал и показал как перебирать, я код за тебя не писал
я тебе дал кусок своего рабочего кода выдранного из контекста
...
Рейтинг: 0 / 0
15.08.2011, 23:29
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396829
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Тебе в принципе достаточно все StrValue (strResult ? смотри сам) без анализа внутри Do Loop тупо добавить в какой-нибудь ListBox и будут там у тебя все подключи.
...
Рейтинг: 0 / 0
15.08.2011, 23:39
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396836
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
Про Do Loop в принципе ясно, просто пока разного рода ошибки,

 
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME)

Private Sub Form_Load()
GetUninstallKeys
End Sub

Public Sub GetUninstallKeys()
    Dim I As Integer
    Dim strSearch As String
    Dim intSearchLen As Integer
    Dim lngResult As Long
    Dim lngKeyHandle As Long
    Dim lngCurIdx As Long
    Dim lngValueLen As Long
    Dim strValue As String
    Dim lngClassLen As Long
    Dim strClass As String
    Dim lngTime As FILETIME
    Dim strResult As String
    Dim blnMatch As Boolean
    HasUN = False 'íåò òî÷åê âõîäà
    I =  0 
    ' Assign the new string to search for
    strSearch = "TheProga"
    intSearchLen = Len(strSearch)
    
    ' Open the Root Branch to search
    lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall",  0 &, KEY_READ, lngKeyHandle)
    
    If lngResult <> ERROR_SUCCESS Then
        'MsgBox "Cannot open key.", , "Search Registry Keys"
    Else
    ' If the Root branch can be opened, begin the search
        lngCurIdx =  0 
        Do
            lngValueLen =  2000 
            strValue = String(lngValueLen,  0 )
            lngClassLen =  2000 
            strClass = String(lngClassLen,  0 )
        
            ' Enumerate all the sub keys
            lngResult = RegEnumKeyEx(lngKeyHandle, lngCurIdx, ByVal strValue, lngValueLen,  0 &, ByVal strClass, lngClassLen, lngTime)
           
            ' Increment the index of found keys
            lngCurIdx = lngCurIdx +  1 
        
            If lngResult = ERROR_SUCCESS Then
                ' Trim the current key to its actual length
                strResult = Left(strValue, lngValueLen)
                
                ' Eliminate case if the search is insensitive
                blnMatch = False
                strValue = strResult
                
                strResult = LCase(strResult)
                strSearch = LCase(strSearch)

                ' Compare strings based upon search type
                ' Check if the search string matches the
                ' left portion of the key string.
                If Left(strResult, intSearchLen) = strSearch Then blnMatch = True
                
                ' Populate the list with keys that match
                ' the search criteria
                If blnMatch Then
                    I = I +  1 
                    HasUN = True 'åñòü õîòÿ áû îäíà òî÷êà âõîäà
                    ReDim Preserve UN( 1  To I)
                    UN(I).Key = strValue
                End If
            End If
        
        ' Keep looking for more keys
        Loop While lngResult = ERROR_SUCCESS
        ' Close the Root Branch
        lngResult = RegCloseKey(lngKeyHandle)
        
        ' Display the total matches
        'MsgBox "Total matches:" & Str(i), , "Search Registry Keys"
    End If
End Sub

'= = = = = = = = = = = КОД МОДУЛЯ  = = = = = = = = =



Option Explicit


Public Const REG_SZ As Long =  1 
Public Const REG_DWORD As Long =  4 


Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_USERS = &H80000003


Public Const ERROR_NONE =  0 
Public Const ERROR_BADDB =  1 
Public Const ERROR_BADKEY =  2 
Public Const ERROR_CANTOPEN =  3 
Public Const ERROR_CANTREAD =  4 
Public Const ERROR_CANTWRITE =  5 
Public Const ERROR_OUTOFMEMORY =  6 
Public Const ERROR_INVALID_PARAMETER =  7 
Public Const ERROR_ACCESS_DENIED =  8 
Public Const ERROR_INVALID_PARAMETERS =  87 
Public Const ERROR_NO_MORE_ITEMS =  259 

Public Const KEY_ALL_ACCESS = &H3F

Public 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 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
Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)


Сейчас ругается на то, что в Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME)
параметро - определенная юзером функция.
...
Рейтинг: 0 / 0
15.08.2011, 23:44
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396842
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
kalamfurпараметро - определенная юзером функция.
это и есть текст ошибки? у тебя испанский виндовс?

подозреваю, что он хочет тебе сказать, что declare разрешен только в модуле.... но вчитываться или не вчитываться в ошибку - дело твое, конечно....
...
Рейтинг: 0 / 0
15.08.2011, 23:49
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396853
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
а чему должна быть равна ERROR_SUCCESS ? т.е. у неё ведь индекс цифровой?
...
Рейтинг: 0 / 0
16.08.2011, 00:00
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396856
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
мой совет посмотреть API Text Viewer побоку?
...
Рейтинг: 0 / 0
16.08.2011, 00:05
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396861
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
нашел, спасибо, нулю она должна быть равна.
...
Рейтинг: 0 / 0
16.08.2011, 00:09
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396863
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
сейчас никаких ошибок, но результата никакого. пусто..

 
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
Private Type FILETIME
 lLowDateTime As Long
 lHighDateTime As Long
End Type
Private Declare Function RegEnumKeyEx& Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME)

Public Sub GetUninstallKeys()
    Dim I As Integer
    Dim strSearch As String
    Dim intSearchLen As Integer
    Dim lngResult As Long
    Dim lngKeyHandle As Long
    Dim lngCurIdx As Long
    Dim lngValueLen As Long
    Dim strValue As String
    Dim lngClassLen As Long
    Dim strClass As String
    Dim lngTime As FILETIME
    Dim strResult As String
    Dim blnMatch As Boolean
    
    HasUN = False 'íåò òî÷åê âõîäà
    I =  0 
    ' Assign the new string to search for
    strSearch = "flash"
    intSearchLen = Len(strSearch)
    
    ' Open the Root Branch to search
    lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion",  0 &, KEY_READ, lngKeyHandle)
    
    If lngResult = ERROR_SUCCESS Then
        MsgBox "Cannot open key.", , "Search Registry Keys"
    Else
    ' If the Root branch can be opened, begin the search
        lngCurIdx =  0 
        Do
            lngValueLen =  2000 
            strValue = String(lngValueLen,  0 )
            lngClassLen =  2000 
            strClass = String(lngClassLen,  0 )
        
            ' Enumerate all the sub keys
            lngResult = RegEnumKeyEx(lngKeyHandle, lngCurIdx, ByVal strValue, lngValueLen,  0 &, ByVal strClass, lngClassLen, lngTime)
           
            ' Increment the index of found keys
            lngCurIdx = lngCurIdx +  1 
        
            If lngResult = ERROR_SUCCESS Then
                ' Trim the current key to its actual length
                List1.AddItem strValue
            End If
        
        ' Keep looking for more keys
        Loop While lngResult = ERROR_SUCCESS
        ' Close the Root Branch
        lngResult = RegCloseKey(lngKeyHandle)
        
        ' Display the total matches
        'MsgBox "Total matches:" & Str(i), , "Search Registry Keys"
    End If
End Sub

Private Sub Form_Load()
GetUninstallKeys
End Sub
...
Рейтинг: 0 / 0
16.08.2011, 00:10
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396872
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
не верю

смотрим код Димы:
Код: plaintext
   If lngResult <> ERROR_SUCCESS Then

смотрим твой код:
Код: plaintext
1.
    If lngResult = ERROR_SUCCESS Then
        MsgBox "Cannot open key.", , "Search Registry Keys"
и что, совсем никаких ошибок?
...
Рейтинг: 0 / 0
16.08.2011, 00:23
| Ответить | Цитировать | Написать  
реестр. читаем все ключи в ветке
    #37396880
kalamfur
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kalamfur
Гость
lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", 0&, KEY_READ, lngKeyHandle)

If lngResult <> ERROR_SUCCESS Then
MsgBox "Cannot open key.", , "Search Registry Keys"

в таком случае он выдаёт мессадж даже на такой вложенности..
...
Рейтинг: 0 / 0
16.08.2011, 00:38
| Ответить | Цитировать | Написать  
25 сообщений из 31, страница 1 из 2
  1  все
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / реестр. читаем все ключи в ветке
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=37396809&tid=2158495]:
 0ms
get settings:
 9ms
get forum list:
 11ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 37ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 57ms
get tp. blocked users:
 1ms
others: 15ms
total:  149ms
созд. / загр.: 149ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]