'// ---------- Form Kodları
Dim BD As BiosData
 
Private Sub Combo1_Click()
   Select Case Combo1.ListIndex
          Case 0
               Label1 = BD.SystemBiosDate
          Case 1
               Label1.Caption = BD.SystemBiosVersion
          Case 2
               Label1 = BD.SystemBiosCopyRight
          Case 3
               Label1 = BD.SystemBio***traInfo
          Case 4
               Label1 = BD.VideoBiosDate
          Case 5
               Label1 = BD.VideoBiosVersion
          Case 6
               Label1 = BD.VideoBiosCopyRight
   End Select
End Sub
 
Private Sub Form_Load()
  Caption = "Bios Information"
  Set BD = New BiosData
  With Combo1
      .AddItem "SystemBiosDate"
      .AddItem "SystemBiosVersion"
      .AddItem "SystemBiosCopyRight"
      .AddItem "SystemBio***traInfo"
      .AddItem "VideoBiosDate"
      .AddItem "VideoBiosVersion"
      .AddItem "VideoBiosCopyRight"
  End With
  Combo1.ListIndex = 0
End Sub
 
 
 
'// ---------- Module1 Modülü Kodları
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
 
Public Declare Function CopyStringA Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long
Public Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
 
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
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal numBytes As Long)
 
Private Const KEY_READ = &H20019
 
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_MULTI_SZ = 7
 
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_SUCCESS = 0&
 
Private Const MAX_SIZE = 2048
Public Const HKLM = &H80000002
 
Public Function IsWindowsNT() As Boolean
   Dim verinfo As OSVERSIONINFO
   verinfo.dwOSVersionInfoSize = Len(verinfo)
   If (GetVersionEx(verinfo)) = 0 Then Exit Function
   If verinfo.dwPlatformId = 2 Then IsWindowsNT = True
End Function
 
Public Function StrFromPtrA(ByVal lpszA As Long) As String
   Dim s As String
   s = String(lstrlenA(lpszA), Chr$(0))
   CopyStringA s, ByVal lpszA
   StrFromPtrA = TrimNULL(s)
End Function
 
Private Function TrimNULL(ByVal str As String) As String
    If InStr(str, Chr$(0)) > 0& Then
        TrimNULL = Left$(str, InStr(str, Chr$(0)) - 1&)
    Else
        TrimNULL = str
    End If
End Function
 
Public 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 = MAX_SIZE
    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
    End Select
    RegCloseKey handle
End Function
 
 
 
'// ---------- BiosData Sınıfı Kodları
Dim isNT As Boolean
 
Public Property Get VideoBiosDate() As String
    If isNT Then
       VideoBiosDate = GetRegistryValue(HKLM, "Hardware\Description\System", "VideoBiosDate", "")
    Else
'       VideoBiosDate = Mid(StrFromPtrA(&HC00A8), 1, 8) '-Date build
       VideoBiosDate = Mid(StrFromPtrA(&HC00A8), 9, 8) '-Date revision
    End If
End Property
 
Public Property Get VideoBiosVersion() As String
    Dim s As String
    If isNT Then
       s = GetRegistryValue(HKLM, "Hardware\Description\System", "VideoBiosVersion", "")
    Else
       s = StrFromPtrA(&HC0048)
       s = Left(s, InStr(1, s, vbCrLf) - 1)
       s = s & vbCrLf & "ChipType: " & GetRegistryValue(HKLM, "System\CurrentControlSet\Services\Class\Display\0000\INFO", "ChipType", "")
    End If
    VideoBiosVersion = s
End Property
 
Public Property Get VideoBiosCopyRight() As String
    Dim s As String
    If isNT Then
       s = "Unavailable on NT"
    Else
       s = StrFromPtrA(&HC0048)
       s = Mid$(s, InStr(1, s, vbCrLf) + 2)
    End If
    VideoBiosCopyRight = s
End Property
 
Public Property Get SystemBiosDate() As String
    If isNT Then
       SystemBiosDate = GetRegistryValue(HKLM, "Hardware\Description\System", "SystemBiosDate", "")
    Else
       SystemBiosDate = StrFromPtrA(&HFFFF5)
    End If
End Property
 
Public Property Get SystemBiosCopyRight() As String
    If isNT Then
       SystemBiosCopyRight = "Unvailable on NT"
    Else
       SystemBiosCopyRight = StrFromPtrA(&HFE091)
    End If
End Property
 
Public Property Get SystemBiosVersion() As String
    Dim vAns As Variant
 
    If isNT Then
        On Error Resume Next
      SystemBiosVersion = CDate(GetRegistryValue(HKLM, "Hardware\Description\System", "SystemBiosVersion", ""))
        If Err.Number > 0 Then SystemBiosVersion = "Unavailable"
 
    Else
      SystemBiosVersion = StrFromPtrA(&HFE061)
    End If
End Property
 
Public Property Get SystemBio***traInfo() As String
    If isNT Then
       SystemBio***traInfo = "Unvailable on NT"
    Else
       SystemBio***traInfo = StrFromPtrA(&HFEC71)
    End If
End Property
 
Private Sub Class_Initialize()
   isNT = IsWindowsNT
End Sub