| Cemalizim | 19 Temmuz 2008 17:01 |
BIOS Bilgisi
Alıntıdır. PHP- Kodu:
'// ---------- 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
|
