Informace o BIOSu

Private 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

Private Declare Function RegCloseKey Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long

Private 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

Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (dest As  Any, source As Any, ByVal numBytes As Long)

Const KEY_READ = &H20019 
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234
Const HKEY_LOCAL_MACHINE = &H80000002

Function GetRegistryValue(ByVal hKey As Long, 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
    
    GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)
    
    If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
        Exit Function
    End If
    
    length = 1024
    ReDim resBinary(0 To length - 1) As Byte
    
    retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
        length)
    If retVal = ERROR_MORE_DATA Then
        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
            CopyMemory resLong, resBinary(0), 4
            GetRegistryValue = resLong
        Case REG_SZ, REG_EXPAND_SZ
            resString = Space$(length - 1)
            CopyMemory ByVal resString, resBinary(0), length - 1
            GetRegistryValue = resString
        Case REG_BINARY
            If length <> UBound(resBinary) + 1 Then
                ReDim Preserve resBinary(0 To length - 1) As Byte
            End If
            GetRegistryValue = resBinary()
        Case REG_MULTI_SZ
            resString = Space$(length - 2)
            CopyMemory ByVal resString, resBinary(0), length - 2
            GetRegistryValue = resString
        Case Else
            RegCloseKey handle
            Err.Raise 1001, , "Neznámý typ hodnoty"
    End Select
    
    RegCloseKey handle

End Function


Sub GetBiosInfo(BiosDate As String, BiosVersion As String)

    BiosDate = GetRegistryValue(HKEY_LOCAL_MACHINE, _
        "Hardware\Description\System", "SystemBiosDate", "")
    BiosVersion = GetRegistryValue(HKEY_LOCAL_MACHINE, _
        "Hardware\Description\System", "SystemBiosVersion", "")

End Sub

Použití:
Na formulář přidejte tlačítko a na jeho událost Click zapište:

Dim Datum as String
Dim Verze as String

Call GetBiosInfo (Datum, Verze)
MsgBox Verze & Chr(13) & Datum

Zpět