''''-------------------------------------------------------------------------------------------------------------
''''- 导出注册表关键字的值
''''- 参数说明: KeyRoot--根类型, KeyName--子项名称, FileName--导出的文件路径及文件名(原始数据库格式)
''''-------------------------------------------------------------------------------------------------------------
Public Function SaveKey(KeyRoot As KeyRoot, KeyName As String, FileName As String) As Boolean
    On Error Resume Next
   
    Dim lpAttr As SECURITY_ATTRIBUTES                   '''' 注册表安全类型
    lpAttr.nLength = 50                                 '''' 设置安全属性为缺省值...
    lpAttr.lpSecurityDescriptor = 0                     '''' ...
    lpAttr.bInheritHandle = True                        '''' ...
   
    If EnablePrivilege(SE_BACKUP_NAME) = False Then
        SaveKey = False
        Exit Function
    End If
   
    Success = RegOpenKeyEx(KeyRoot, KeyName, 0&, KEY_ALL_ACCESS, hKey)
    If Success <> 0 Then
        SaveKey = False
        Success = RegCloseKey(hKey)
        Exit Function
    End If
   
    Success = RegSaveKey(hKey, FileName, lpAttr)
    If Success = 0 Then SaveKey = True Else SaveKey = False
   
    Success = RegCloseKey(hKey)
End Function

''''-------------------------------------------------------------------------------------------------------------
''''- 导入注册表关键字的值
''''- 参数说明: KeyRoot--根类型, KeyName--子项名称, FileName--导入的文件路径及文件名(原始数据库格式)
''''-------------------------------------------------------------------------------------------------------------
Public Function RestoreKey(KeyRoot As KeyRoot, KeyName As String, FileName As String) As Boolean
    On Error Resume Next
   
    If EnablePrivilege(SE_RESTORE_NAME) = False Then
        RestoreKey = False
        Exit Function
    End If
   
    Success = RegOpenKeyEx(KeyRoot, KeyName, 0&, KEY_ALL_ACCESS, hKey)
    If Success <> 0 Then
        RestoreKey = False
        Success = RegCloseKey(hKey)
        Exit Function
    End If
   
    Success = RegRestoreKey(hKey, FileName, REG_FORCE_RESTORE)
    If Success = 0 Then RestoreKey = True Else RestoreKey = False
   
    Success = RegCloseKey(hKey)
End Function

''''-------------------------------------------------------------------------------------------------------------
''''- 使注册表允许导入/导出
''''-------------------------------------------------------------------------------------------------------------
Private Function EnablePrivilege(seName As String) As Boolean
    On Error Resume Next
   
    Dim p_lngRtn As Long
    Dim p_lngToken As Long
    Dim p_lngBufferLen As Long
    Dim p_typLUID As LUID
    Dim p_typTokenPriv As TOKEN_PRIVILEGES
    Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
   
    p_lngRtn = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, p_lngToken)
    If p_lngRtn = 0 Then
        EnablePrivilege = False
        Exit Function
    End If
    If Err.LastDllError <> 0 Then
        EnablePrivilege = False
        Exit Function
    End If
   
    p_lngRtn = LookupPrivilegeValue(0&, seName, p_typLUID)
    If p_lngRtn = 0 Then
      EnablePrivilege = False
      Exit Function
    End If
   
    p_typTokenPriv.PrivilegeCount = 1
    p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED
    p_typTokenPriv.Privileges.pLuid = p_typLUID
   
    EnablePrivilege = (AdjustTokenPrivileges(p_lngToken, False, p_typTokenPriv, Len(p_typPrevTokenPriv), p_typPrevTokenPriv, p_lngBufferLen) <> 0)
End Function

''''-------------------------------------------------------------------------------------------------------------
''''- 将 Double 型( 限制在 0--2^32-1 )的数字转换为十六进制并在前面补零
''''- 参数说明: Number--要转换的 Double 型数字
''''-------------------------------------------------------------------------------------------------------------
Private Function DoubleToHex(ByVal Number As Double) As String
    Dim strHex As String
    strHex = Space(8)
    For i = 1 To 8
        Select Case Number - Int(Number / 16) * 16
            Case 10
                Mid(strHex, 9 - i, 1) = "A"
            Case 11
                Mid(strHex, 9 - i, 1) = "B"
            Case 12
                Mid(strHex, 9 - i, 1) = "C"
            Case 13
                Mid(strHex, 9 - i, 1) = "D"
            Case 14
                Mid(strHex, 9 - i, 1) = "E"
            Case 15
                Mid(strHex, 9 - i, 1) = "F"
            Case Else
                Mid(strHex, 9 - i, 1) = CStr(Number - Int(Number / 16) * 16)
        End Select
        Number = Int(Number / 16)
    Next i
    DoubleToHex = strHex
End Function

上一页  [1] [2] [3] [4]