p; Dim handle As Long Dim lngValue As Long Dim strValue As String Dim binValue() As Byte Dim length As Long Dim retVal As Long Dim SecAttr As SECURITY_ATTRIBUTES ''''//键的安全设置 ''''//设置新键值的名称和默认安全设置 SecAttr.nLength = Len(SecAttr) ''''//结构大小 SecAttr.lpSecurityDescriptor = 0 ''''//默认安全权限 SecAttr.bInheritHandle = True ''''//设置的默认值 ''''// 打开或创建键 ''''If RegOpenKeyEx(hKey, KeyName, 0, KEY_ALL_ACCESS, handle) Then Exit Function retVal = RegCreateKeyEx(hKey, KeyName, 0, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, SecAttr, handle, retVal) If retVal Then Exit Function ''''//3种数据类型 Select Case VarType(Value) Case vbByte, vbInteger, vbLong ''''// 若是字节, Integer值或Long值... lngValue = Value retVal = RegSetValueExLong(handle, ValueName, 0, REG_DWORD, lngValue, Len(lngValue)) Case vbString ''''// 字符串, 扩展环境字符串或多段字符串... strValue = Value Select Case Flag Case IsExpandableString retVal = RegSetValueEx(handle, ValueName, 0, REG_EXPAND_SZ, ByVal strValue, 255) Case IsMultiString retVal = RegSetValueEx(handle, ValueName, 0, REG_MULTI_SZ, ByVal strValue, 255) Case Else ''''// 正常 REG_SZ 字符串 retVal = RegSetValueEx(handle, ValueName, 0, REG_SZ, ByVal strValue, 255) End Select Case vbArray + vbByte ''''// 如果是字节数组... binValue = Value length = UBound(binValue) - LBound(binValue) + 1 retVal = RegSetValueExByte(handle, ValueName, 0, REG_BINARY, binValue(0), length) Case Else ''''// 如果其它类型 RegCloseKey handle ''''Err.Raise 1001, , "不支持的值类型" End Select ''''// 返回关闭结果 RegCloseKey handle ''''// 返回写入成功结果 SetRegistryValue = (retVal = 0) End Function Function GetRegistryValue(ByVal hKey As RootKeyEnum, ByVal KeyName As String, _ ByVal ValueName As String, Optional DefaultValue As Variant) As Variant Dim handle As Long Dim resLong As Long Dim resString As String Dim resBinary() As Byte Dim length As Long Dim retVal As Long Dim valueType As Long
Const KEY_READ = &H20019 ''''// 默认结果 GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue) ''''// 打开键, 不存在则退出 If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function ''''// 准备 1K resBinary 用于接收 length = 1024 ReDim resBinary(0 To length - 1) As Byte ''''// 读注册表值 retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), length) ''''// 若resBinary 太小则重读 If retVal = ERROR_MORE_DATA Then ''''// resBinary放大,且重新读取 ReDim resBinary(0 To length - 1) As Byte retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _ length) End If ''''// 返回相应值类型 Select Case valueType Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN ''''// REG_DWORD 和 REG_DWORD_LITTLE_ENDIAN 相同 CopyMemory resLong, resBinary(0), 4 GetRegistryValue = resLong Case REG_DWORD_BIG_ENDIAN ''''// Big Endian''''s 用在非-Windows环境, 如Unix系统, 本地计算机远程访问 CopyMemory resLong, resBinary(0), 4 GetRegistryValue = SwapEndian(resLong) Case REG_SZ, REG_EXPAND_SZ resString = Space$(length - 1) CopyMemory ByVal resString, resBinary(0), length - 1 If valueType = REG_EXPAND_SZ Then ''''// 查询对应的环境变量 GetRegistryValue = ExpandEnvStr(resString) Else GetRegistryValue = resString End If Case REG_MULTI_SZ ''''// 复制时需指定2个空格符 resString = Space$(length - 2) CopyMemory ByVal resString, resBinary(0), length - 2 GetRegistryValue = resString Case Else '''' 包含 REG_BINARY ''''// resBinary 调整 If length <> UBound(resBinary) + 1 Then ReDim Preserve resBinary(0 To length - 1) As Byte End If GetRegistryValue = resBinary() End Select ''''// 关闭 RegCloseKey handle End Function Public Function DeleteRegistryValueOrKey(ByVal hKey As RootKeyEnum, RegKeyName As String, _ ValueName As String) As Boolean ''''//删除注册表值和键,如果成功返回True
Dim lRetval As Long ''''//打开和输出注册表键的返回值 Dim lRegHWND As Long ''''//打开注册表键的句柄 Dim sREGSZData As String ''''//把获取值放入缓冲区 Dim lSLength As Long ''''//缓冲区大小. 改变缓冲区大小要在调用之后 ''''//打开键 lRetval = RegOpenKeyEx(hKey, RegKeyName, 0, KEY_ALL_ACCESS, lRegHWND) ''''//成功打开 If lRetval = ERR_NONE Then ''''//删除指定值 lRetval = RegDeleteValue(lRegHWND, ValueName) ''''//如果已存在则先删除 ''''//如出现错误则删除值并返回False If lRetval <> ERR_NONE Then Exit Function ''''//注意: 如果成功打开仅关闭注册表键 lRetval = RegCloseKey(lRegHWND) ''''//如成功关闭则返回 True 或者其它错误 If lRetval = ERR_NONE Then DeleteRegistryValueOrKey = True End If End Function Private Function ExpandEnvStr(sData As String) As String ''''// 查询环境变量和返回定义值 ''''// 如: %PATH% 则返回 "c:\;c:\windows;"
Dim c As Long, s As String s = "" ''''// 不支持Windows 95 ''''// get the length c = ExpandEnvironmentStrings(sData, s, c) ''''// 展开字符串 s = String$(c - 1, 0) c = ExpandEnvironmentStrings(sData, s, c) ''''// 返回环境变量 ExpandEnvStr = s End Function Private Function SwapEndian(ByVal dw As Long) As Long ''''// 转换大DWord 到小 DWord CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1 CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1 CopyMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1 CopyMemory SwapEndian, ByVal VarPtr(dw) + 3, 1
End Function
上一页 [1] [2] [VB.NET程序]GSM短信模块库函数,可以用VB,VC,调用简单实用 [办公软件]PowerPoint做交互课件之弃用VBA [办公软件]VBA获取U盘、主板、CPU序列号和网卡MAC地址 [办公软件]VBA设置文件属性及加密源代码示例 [办公软件]VBA中初始化ADO连接的几种方法 [网络安全]“VB破坏者变种N”病毒摘要 [Web开发]ASP.NET上传文件到数据库VB版 [办公软件]在Excel中利用VBA实现多表单元格数据的读取与赋值… [办公软件]使用Vba读取已关闭的Excel工作薄数据到当前工作表… [办公软件]Excel编程基础之VBA文件操作详解
|