p; '''' 下面的二重循环对字符串数组进行冒泡排序 For i = 0 To UBound(ValueName) For j = i + 1 To UBound(ValueName) If ValueName(i) > ValueName(j) Then s = ValueName(i) ValueName(i) = ValueName(j) ValueName(j) = s End If Next j Next i End If '''' 关闭注册表关键字... RegCloseKey hKey GetKeyInfo = True '''' 返回函数值 End Function
''''------------------------------------------------------------------------------------------------------------- ''''- 导出注册表关键字的值 ''''- 参数说明: 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] 没有相关教程
|