VB读取注册表问题, 怎样通过数据得到数值名称

Posted 2023-04-17

比如 在注册表 HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\MUICache
下有一个字符串值, 我只知道 数值数据是 QQHXLogin Microsoft 基础类应用程序
怎样用VB 通过数值数据，得到数值名称
懂的给个代码吧，谢谢

比如一个窗体里，一个text 一个按钮 点一下按钮 text就显示上面指定的数值名称

在Windows出问题时，如果能够了解Windows系统的注册表，将更容易解决问题; 许多商品化的软件或专业化的软件在您的机器上首次安装的时候都会通过改写注册表来完成软件的正确安装运行，要成为编程高手当然需要掌握读写注册表这一技术。用好注册表将会为您的应用程序增色不少，下面笔者将具体介绍VB中与注册表有关的编程方法。
注册表的组织结构
存取注册表以前， 必须先了解注册表的组织结构， 而了解注册表的组织结构最简单的方法便是启动 Windows 提供的“注册表编辑器”， 启动的方法是单击“开始”菜单的“运行”命令，输入 RegEdit 之后确定，可看到“注册表编辑器”窗口(如图1所示)。

● 键(Key) 与子键(Subkey)
注册表编辑器的结构与资源管理器很类似， 左边窗口的每一个文件夹图标表示一个键，就像文件夹下还有子文件夹一样， 注册表的键下也有子键。为了完整地表示某一个子键，习惯上是采用文件夹的路径表示法。 举例来说， HKEY_LOCAL_MACHINE 之下的“Software”子键表示成 HKEY_LOCAL_
MACHINE\Software，而“Software”之下的 “Microsoft”子键则表示成 HKEY_LOCAL_
MACHINE\Software\Microsoft

● 键值()、键名( Name)、数据( Data) 与默认键值(Default )
当我们在注册表编辑器左边窗口选取某一个键(或子键) 之后， 出现在右边窗口中的是这个键的键值()，键值可分成键名(Name)及数据(Data)两部分。对每一个键而言， 至少都含有一个默认键值(Default ) ， 以 “HKEY_CLASSES_ROOT\
.bmp”子键为例， 其默认键值为 “ACDC_BMP”。 除了默认键值之外， 这个子键还含有名称 (Name)“Content Type”和数据 (Data）“image/bmp“

VB 自身提供的
关于注册表的函数
了解注册表的组织结构之后， 接下来讨论如何存取它。就像我们存取文件时必须指明文件所在文件夹(目录)一样， 存取注册表时， 则必须先指明键。键在注册表编辑器中所看到的是一长串的字符串，例如 “HKEY_LOCAL_MACHINE\SOFTWARE\
Microsoft\Windows\CurrentVersion”。在 Visual Basic 6.0 内部，已经提供了一个标准的注册位置，以存储创建于VB的应用程序的程序信息：HKEY_CURRENT_USER\Software\VB and VBA Program settings\(为了叙述简单，以下将这一位置简称“标准位置”)。VB 提供了两个语句和两个函数来处理存储在应用程序注册位置的程序设置值：
函数GetSetting(appname, section, key[, default]): 检索注册表设置值。
语句SaveSetting appname，section，key，: 保存或创建注册表设置值。
函数GetAllSettings(appname, section): 返回一个包含多项注册表设置值的数组。
语句DeleteSetting appname, section[, key]: 删除注册表设置值。
以上所用参数的说明：
[ ]: 表示可选项。
appname：字符串表达式，包含应用程序或工程的名称，是标准位置下的一个子键。
section：字符串表达式，包含区域名称，是 appname 下的一个子键。
key：字符串表达式，标准位置\appname\
section子键的键名( Name)。
：字符串表达式，标准位置\appname\
section子键对应于键名( Name)的键值()。
default：表达式，如果注册表项设置中没有设置值，则返回默认值。如果省略，则 default 取值为长度为零的字符串 (“”)。
GetAllSettings返回Variant，是内容为字符串的二维数组，该二维数组包含指定区域中的所有注册表项设置值及其对应值。 如果 appname 或 section 不存在，则GetAllSettings 返回未初始化的 Variant。
实例之一
在 VB6.0中新建一工程并命名为 vbreg.vbp，删去其中所有窗体，在工程资源管理器中点击右键，选择添加模块，并命名为 vbreg.bas。双击reg.bas，输入如下代码：
Dim avntSettings As Variant
Dim intX As Integer
avntSettings = GetAllSettings(“VB 6 API 声明加载器”, “File List”)
For intX = 0 To UBound(avntSettings, 1)
Debug.Print avntSettings(intX, 0), avntSettings(intX, 1)
Next intX
上面这段程序首先用 GetAllSettings 函数检索“VB 6 API 声明加载器”子键File List部分的两个注册表项的值，并将其结果显示在立即窗口中。开始运行前请按+确保立即窗口显示在屏幕上。同时请打开注册表，以便将标准位置\VB 6 API 声明加载器\File List的键值与结果进行对照。
下面这段程序用 SaveSetting 语句在标准位置下建立名为“我的工程\我的子键”的子键，然后使用 GetSetting 函数来得到其中一项设置值并显示出来。因为有传入参数default，GetSetting 函数一定会有返回值。
请注意，区域名称不能用GetSetting 函数取得。最后，使用 DeleteSetting 语句将该子键删除。
SaveSetting “我的工程”, “我的子键”, “Top”, 75
SaveSetting “我的工程”, “我的子键”, “Left”, 50
Debug.Print “Top”, GetSetting(“我的工程”, “我的子键”, “Top”, “25”)
Debug.Print “Left”, GetSetting(“我的工程”, “我的子键”, “Left”, “0”)
’为了便于观察，调试可以在此处设置断点，同时切换到注册表，按下键刷新，即可看到自己建立的子键及其键值
DeleteSetting “我的工程”, “我的子键”
’运行完毕后再次切换到注册表并按下键刷新，观察己建立的子键及其键值是否被删除
说明: 运行本程序前，需先确保启动VB时已自动加载“API文本浏览器”，且在API文本浏览器中的“文件”菜单下有打开过的“文本文件”列表。否则，请先打开“API文本浏览器”，并在“文件”菜单下选择“打开文本文件”，打开至少一个文本文件或数据库。
Windows API 的注册表编程
VB自身虽提供了四个关于注册表的函数，但是这些函数只能在“HKEY_CURRENT_USER\
Software\VB and VBA ProgramSettings”下读取、删除、修改键值。这对于一般的应用程序利用它们可以达到目的，如果想对其他的非“标准位置”的主键或子键进行访问，该怎么办？此时，必须借助Windows API的帮助。
在Windows内部， 每一个键都会对应到一个 Key Handle(等于一个长整数值，程序中通常以 hKey表示)，Windows之所以要以hKey来代表键是为了让注册表的存取更有效率，因为整数的操作效能要优于字符串， 所以我们首先来了解如何取得键的 Key Handle(即hKey)。位于最上层的键，有HKEY_CLASSES_ROOT、HKEY_CURRENT
_USER、HKEY_LOCAL_MACHINE等，这些键的hKey值是固定不变的，其值见下表:
－－－－－－－－－－－－－－－－－－－－－－－
Key Key Handle
－－－－－－－－－－－－－－－－－－－－－－－
HKEY_CLASSES_ROOT &H80000000
HKEY_CURRENT_CONFIG &H80000005 HKEY_CURRENT_USER &H80000001
HKEY_DYN_DATA &H80000006
HKEY_LOCAL_MACHINE &H80000002
HKEY_USERS &H80000003
－－－－－－－－－－－－－－－－－－－－
但如果要取得这些键的Subkey Handle，则必须调用RegOpenKey API函数，RegOpenKey含有三个参数，用法如下：
Private Declare RegOpenKey Lib “advapi32.dll” Alias “RegOpenKeyA” (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
这里hKey是Key Handle，lpSubkey是子键的字符串，PhkResult是函数返回值，若 RegOpenKey调用成功， 则此参数将传回子键的hKey。
举例来说，我们想取得HKEY_LOCAL_MA
CHINE之下的“SOFTWARE\Microsoft”子键， 则使用的声明是:
Dim ret As Long，hKey As Long
ret=RegOpenKey(HKEY_LOCAL_
MACHINE, “SOFTWARE\Microsoft”, hKey)
If ret = 0 Then
’ret=0表示成功，hKey的值等于“SOFTWARE
\Microsoft”Subkey的Key Handle
End If
请注意调用注册表API函数(例如以上的 RegOpenKey)之后，若成功将传回0，否则传回非0值，这一点与VB函数的惯例并不相同，请特别注意。
RegOpenKey 的第一个参数 hKey 除了可以指定最上层的Key Handle值(例如 HKEY_CLASSES
_ROOT、HKEY_LOCAL_MACHINE等)之外， 也可以是一个 Subkey Handle。如上例， hKey 等于“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft” 的 Subkey Handle， 接着如果我们要取得 “HKEY_
LOCAL_MACHINE\SOFTWARE\Microsoft\
Windows\CurrentVersion” 的 Subkey Handle， 则程序如下：
Dim ret As Long, hKey As Long, hKey2 As Long
ret=RegOpenKey(hKey, “Windows\Current
Version”, hKey2)
’hKey2将等于“HKEY_LOCAL_MAC
HINE\SOFTWARE\Microsoft”的“Windows\
CurrentVersion”的Subkey Handle
在以上程序中，请注意不要在“Windows\
CurrentVersion”之前加上“\”，使之成为“\Windows
\CurrentVersion”，这是错误的表示方法。
下面简单地介绍一下其他几个API(32位API):
● RegSetEx(): 在打开的注册表关键字的值域中存储数据；
● RegCloseKey(): 释放指定的关键字的句柄；
● RegQueryEx(): 在注册表中查找与您指定的键值相关的值；
● RegCreateKeyEx(): 建立并打开指定的关键字，若已存在则打开它；
● RegEnumKeyEx(): 枚举指定的注册表关键字的子关键字（32位）；
● RegEnum(): 每次调用枚举指定的注册表关键字的值，复制一个带索引的值的名称和数据块；
● RegDeletekey(): 删除一个关键字以及它的子关键字；
● RegDelete(): 在指定的注册表关键字中删除一个带名字的值。
结束语 参考技术A 新建一个模块
写入代码

Option Explicit
Public Const HKEY_CLASSES_ROOT = &H80000000

Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_MULTI_SZ = 7
'注意以下的函数声明须在一行内写完
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long

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

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

Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long

Sub MultiStringToStringArray(S As String, S2() As String)
'S为我们读取出来的多重字符串
'S2为转换后的字符串数组
Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer
pos = InStr(S, Chr(0))

While pos > 0
count = count + 1
pos = InStr(pos + 1, S, Chr(0))
Wend
'取得多重字符串中的字符串个数
count = count - 1

ReDim S2(0 To count - 1)
pos = 1
For idx = 0 To count - 1
pos2 = InStr(pos, S, Chr(0))
S2(idx) = Mid(S, pos, pos2 - pos)
pos = pos2 + 1
Next
End Sub

在form1里添加一个按钮
代码区写入：

Private Sub Command1_Click()
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
Dim Name As String
Dim lenName As Long
Dim idx As Integer, j As Integer
Dim bName(256) As Byte
ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\ShellNoRoam\MUICache", hKey)
If ret <> 0 Then Exit Sub

ret = 0
idx = 0
While ret = 0
lenName = 256

ret = RegEnumValueAsAny2(hKey, idx, bName(0), lenName, ByVal 0, typeData, ByVal vbNullString, lenData)
If ret <> 0 Then
RegCloseKey hKey
Exit Sub
End If
'上面的RegEnumValueAsAny2调用得到了第一个Name的长度lenName,不含chr(0)
Name = String(lenName + 1, Chr(0))
lenName = Len(Name)
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Dim S As String
S = String(lenData, Chr(0))
RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, ByVal S, lenData
If typeData = REG_SZ Then
S = Left(S, InStr(S, Chr(0)) - 1)
SHUJU = IIf(lenName = 0, "(预设值)", "") & S
If SHUJU = "QQ宠物启动程序" Then
Print Left(Name, InStr(Name, Chr(0)) - 1)
Exit Sub
End If
ElseIf typeData = REG_EXPAND_SZ Then
Dim S2 As String
S2 = String(Len(S) + 256, Chr(0))
ExpandEnvironmentStrings S, S2, Len(S2)
S = Left(S2, InStr(S2, Chr(0)) - 1)
SHUJU = S
ElseIf typeData = REG_MULTI_SZ Then
Dim SArr() As String
MultiStringToStringArray S, SArr
For j = 0 To UBound(SArr)
SHUJU = SArr(j)
Next
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN
Dim L As Long
RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, L, lenData
SHUJU = L
Case REG_BINARY
ReDim bArr(0 To lenData - 1) As Byte
RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, bArr(0), lenData

For j = 0 To UBound(bArr)
SHUJU = Hex(bArr(j)) & " "
Next

End Select
idx = idx + 1
Wend
RegCloseKey hKey
End Sub

其中把If SHUJU = "QQ宠物启动程序" Then 这句里的文字修改成你所要求的 参考技术B Const HKCU = &H80000001
Const REG_SZ = 1
strKey = "Software\Microsoft\Windows\ShellNoRoam\MUICache"
Set oReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
oReg.EnumValues HKCU, strKey, arrValues, arrTypes
For i = 0 To UBound(arrValues)
If arrTypes(i) = REG_SZ Then
oReg.GetStringValue HKCU, strKey, arrValues(i), strData
If strData = "QQHXLogin Microsoft 基础类应用程序" Then Text1.Text = arrValues(i)
End If
Next本回答被提问者采纳 参考技术C 加我百度HI 我可以帮你

VB.NET - 给定一个日期，我怎样才能得到最后四个星期五的日期？

【中文标题】VB.NET - 给定一个日期，我怎样才能得到最后四个星期五的日期？

【英文标题】：VB.NET - Given a date, how can I get the date of last four fridays?

【发布时间】：2015-07-22 09:28:35

【问题描述】：

给定今天的日期想要获取过去四个星期的每个星期五的日期。

【问题讨论】：

如果今天是星期五，是否包括在内？

Tim Schmelter - 是的，如果今天是星期五，它会捡起来的。但是如果你在 while 循环 "currentDate = currentDate.AddDays(-3)" 上面添加它，它不会选择本周的星期五。

【参考方案1】：

这是一个简单的 LINQ 方法：

Dim today = Date.Today
Dim lastFridays = From d In Enumerable.Range(0, Int32.MaxValue)
                  Let dt = today.AddDays(-d)
                  Where dt.DayOfWeek = DayOfWeek.Friday
                  Select dt
Dim lastFourFridays As Date() = lastFridays.Take(4).ToArray()

由于这不是最有效的方法，这里有一个仍然可读和可维护的查询，但只在第一个星期五搜索，然后每 7 天才需要一次：

Dim lastFriday = lastFridays.First()  ' reuse of above query '
Dim fridays = From d In Enumerable.Range(0, Int32.MaxValue)
              Let dt = lastFriday.AddDays(-d * 7)
              Select dt
Dim lastFourFridays As Date() = fridays.Take(4).ToArray()

【讨论】：

在找到四个星期五之前，查看前一天似乎不是很有效率。只是一个意见。

@dbasnett：这只是一个从 0 到 34 的循环（最多）。不要低估现代 CPU 的能力。所以在这不是一场表演比赛之前，我选择了最易维护和可读的方法。

我的第一台计算机 IBM 1620 让今天的 CPU 速度惊人。然而，我经常看到效率低下的小问题，当它们加在一起时，就会变得很大。你是正确的。

@dbasnett：好的，我添加了另一种保持可读性但更高效的 LINQ 方法。

可读性取决于读者，你不同意吗？你和我都明白......从可读性/维护的角度来看，其他答案是相同的，除了我的。我的可能需要更详细地解释数学，尽管我可能认为只有六个案例可以尝试。我会假设如果您需要基于每 5 秒随机开始日期的前四个星期五的 100 万个，您不会使用 LINQ。

【参考方案2】：

您可以使用这个，它会返回一个此类日期的列表，如果 specifiedDate 日期是 Frid​​ay，则排除该日期：

Public Shared Function GetLastFourFridays(specifiedDate As DateTime) As List(Of DateTime)
    Dim dtm As New List(Of DateTime)()
    Dim dt As DateTime = specifiedDate
    For i As Integer = 0 To 6
        dt = dt.AddDays(-1)
        If dt.DayOfWeek = DayOfWeek.Friday Then
            dtm.Add(dt)
            Exit For
        End If
    Next
    dtm.Add(dt.AddDays(-7))
    dtm.Add(dt.AddDays(-14))
    dtm.Add(dt.AddDays(-21))

    Return dtm
End Function

而你的使用方式是：

Dim dtm As List(Of DateTime) = GetLastFourFridays(DateTime.Now)

For Each d As var In dtm
    Console.WriteLine(String.Format("Date: 0, Day: 1", d.ToString(), [Enum].Parse(GetType(DayOfWeek), d.DayOfWeek.ToString())))
Next

【参考方案3】：

这是我的方式：

Function Last4Friday(ByVal StartDate As Date) As array
    Dim L4F()
    Dim mDate as date = StartDate
    For value As Integer = 1 To 7
        mDate = mDate.AddDays(-1)
        If mDate.DayOfWeek = DayOfWeek.Friday Then
        L4F = mDate, mDate.AddDays(-7), mDate.AddDays(-14), mDate.AddDays(-21)
        exit for
    End If
    Next
Return L4F

End Function

编辑：如果您需要检查插入的日期并且希望它在数组中返回，您可以简单地使用：

Dim mDate as date = StartDate.AddDays(1)

而不是

Dim mDate as date = StartDate

【参考方案4】：

试试这个。它不使用循环来查找开始的星期五。

        Dim someDate As DateTime = DateTime.Now

        If someDate.DayOfWeek <> DayOfWeek.Friday Then
            'do the math to get a Friday
            someDate = someDate.AddDays(DayOfWeek.Friday - someDate.AddDays(1).DayOfWeek - 6)
        End If

        Dim last4Fridays As New List(Of DateTime) From someDate, someDate.AddDays(-7), someDate.AddDays(-14), someDate.AddDays(-21)

所有其他建议都使用循环来查找开始的星期五。如果不经常使用此代码，那么如何确定开始的星期五可能无关紧要。

编辑：作为函数

Function FindLastFourFridays(someDate As DateTime) As List(Of DateTime)
    'Find first Friday to include
    If someDate.DayOfWeek <> DayOfWeek.Friday Then
        someDate = someDate.AddDays(DayOfWeek.Friday - someDate.AddDays(1).DayOfWeek - 6)

        ' uncomment these two lines if you do not want initial someDate.DayOfWeek = DayOfWeek.Friday to be included
        'Else 
        '    someDate = someDate.AddDays(-7)
    End If
    'build the return (four fridays)
    Dim last4Fridays As New List(Of DateTime) From someDate, someDate.AddDays(-7), someDate.AddDays(-14), someDate.AddDays(-21)
    Return last4Fridays
End Function

【讨论】：

我的代码的执行时间似乎相同（在 .net fiddle 上测试），但我喜欢你的公式

@genespos - 我们的返回类型不同。如果您将它们设为相同的返回类型并选择 2015 年 7 月 23 日作为日期，它们将如何比较？

【参考方案5】：

这个函数不需要传递一个日期，它选取今天的日期并获取从今天开始的最后四个星期五。它可以更改为一周中的任何一天。

    Dim todaysDate As Date = Date.Today
    Dim oldDay As Integer
    Dim thisWeek As Date

    Dim firstWeek As Date
    Dim secondWeek As Date
    Dim thirdWeek As Date
    Dim fourthWeek As Date


    'finds the Friday of the end of the current week No mattter what day you are working

    Dim daycount As Integer
    'use this to check specific dates "Dim datetime As New DateTime(2015, 4, 13)"
    oldDay = Weekday(todaysDate)
    thisWeek = todaysDate

    If oldDay < 6 Then
        daycount = 6 - oldDay
        thisWeek = thisWeek.AddDays(+daycount)
    ElseIf oldDay > 6 Then
        daycount = oldDay - 6
        thisWeek = thisWeek.AddDays(-daycount)
    End If

    Dim currentDate As Date = Now
    Do While Not currentDate.DayOfWeek = DayOfWeek.Friday
        currentDate = currentDate.AddDays(-1)
    Loop

    fourthWeek = currentDate.AddDays(-21)
    thirdWeek = currentDate.AddDays(-14)
    secondWeek = currentDate.AddDays(-7)
    firstWeek = currentDate