home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD152552202001.psc / modMyComputer.bas < prev    next >
Encoding:
BASIC Source File  |  2001-02-21  |  11.0 KB  |  167 lines
  1. Attribute VB_Name = "modMyComputer"
  2. Option Explicit
  3. '==========================================================================================================='
  4. ' Local Constant declarations                                                                               '
  5. '==========================================================================================================='
  6. ' Version information constants                                                                             '
  7. '-----------------------------------------------------------------------------------------------------------'
  8. Private Const VER_PLATFORM_WIN32_NT = 2
  9. Private Const VER_PLATFORM_WIN32_WINDOWS = 1
  10. Private Const VER_PLATFORM_WIN32s = 0
  11. '-----------------------------------------------------------------------------------------------------------'
  12. ' Constants used to query the registry                                                                      '
  13. '-----------------------------------------------------------------------------------------------------------'
  14. ' Registry Key open mode
  15. Const KEY_QUERY_VALUE = &H1
  16. ' The Registry section we'll be visiting
  17. Public Const HKEY_LOCAL_MACHINE = &H80000002
  18. Public Const HKEY_DYN_DATA = &H80000006
  19. ' Root to the processor information
  20. Const RK_Processor = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
  21. ' Root to performance statistics
  22. Public Const RK_Performance = "PerfStats\StatData"
  23. ' Root to OS information on Win machines
  24. Const RK_WIN32_OS = "SOFTWARE\Microsoft\Windows\CurrentVersion"
  25. ' Root to OS information on NT machines
  26. Const RK_WIN32_OS_NT = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
  27. '==========================================================================================================='
  28. ' API Declarations                                                                                          '
  29. '==========================================================================================================='
  30. ' System Information API declarations                                                                       '
  31. '-----------------------------------------------------------------------------------------------------------'
  32. Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
  33. Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
  34. Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
  35. '-----------------------------------------------------------------------------------------------------------'
  36. ' Registry queries API declarations                                                                         '
  37. '-----------------------------------------------------------------------------------------------------------'
  38. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  39. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  40. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  41. '==========================================================================================================='
  42. ' Type Declarations                                                                                         '
  43. '==========================================================================================================='
  44. Private Type OSVERSIONINFO
  45.         dwOSVersionInfoSize As Long
  46.         dwMajorVersion As Long
  47.         dwMinorVersion As Long
  48.         dwBuildNumber As Long
  49.         dwPlatformId As Long
  50.         szCSDVersion As String * 128
  51. End Type
  52. Private tmpVersionInfo As OSVERSIONINFO
  53. '==========================================================================================================='
  54. ' Local variable declarations                                                                               '
  55. '==========================================================================================================='
  56. Dim tmpRegKey As String
  57. Dim tmpBuffer As String * 255
  58.  
  59. Sub GetSysInfo()
  60. '==========================================================================================================='
  61. '==========================================================================================================='
  62.     GetComputerName tmpBuffer, 255
  63.     frmMain.lblComputerName.Caption = Trim$(tmpBuffer)
  64. '-----------------------------------------------------------------------------------------------------------'
  65.     GetUserName tmpBuffer, 255
  66.     frmMain.lblUserName.Caption = tmpBuffer
  67. '-----------------------------------------------------------------------------------------------------------'
  68.     tmpVersionInfo.dwOSVersionInfoSize = 148
  69.     GetVersionEx tmpVersionInfo
  70. '-----------------------------------------------------------------------------------------------------------'
  71.     If tmpVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
  72.         If tmpVersionInfo.dwMinorVersion = 0 Then
  73.             frmMain.lblOSPlatform.Caption = "Microsoft Windows '95"
  74.         Else
  75.             frmMain.lblOSPlatform.Caption = "Microsoft Windows '98"
  76.         End If
  77.     ElseIf tmpVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then
  78.         If tmpVersionInfo.dwMajorVersion = 4 Then
  79.             frmMain.lblOSPlatform.Caption = "Microsoft Windows NT"
  80.         Else
  81.             frmMain.lblOSPlatform.Caption = "Microsoft Windows 2000"
  82.         End If
  83.     End If
  84. '-----------------------------------------------------------------------------------------------------------'
  85.     frmMain.lblOSVersion.Caption = tmpVersionInfo.dwMajorVersion & "." & _
  86.         Format(tmpVersionInfo.dwMinorVersion, "00") & "." & _
  87.         tmpVersionInfo.dwBuildNumber
  88.     frmMain.lblOSUpdate.Caption = Left(tmpVersionInfo.szCSDVersion, InStr(1, tmpVersionInfo.szCSDVersion, Chr(0)))
  89. '-----------------------------------------------------------------------------------------------------------'
  90. ' Retrieve registration information, this is platform specific                                              '
  91. '-----------------------------------------------------------------------------------------------------------'
  92.     If tmpVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
  93.         tmpRegKey = RK_WIN32_OS
  94.     ElseIf tmpVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then
  95.         tmpRegKey = RK_WIN32_OS_NT
  96.     End If
  97.     frmMain.lblRegisteredOrganization.Caption = GetKeyValue(HKEY_LOCAL_MACHINE, tmpRegKey, "RegisteredOrganization")
  98.     frmMain.lblRegisteredUser.Caption = GetKeyValue(HKEY_LOCAL_MACHINE, tmpRegKey, "RegisteredOwner")
  99.     frmMain.lblProductID.Caption = GetKeyValue(HKEY_LOCAL_MACHINE, tmpRegKey, "ProductID")
  100. '-----------------------------------------------------------------------------------------------------------'
  101. ' Retrieve CPU information from the registry                                                                '
  102. '-----------------------------------------------------------------------------------------------------------'
  103.     frmMain.lblProcessorMake.Caption = GetKeyValue(HKEY_LOCAL_MACHINE, RK_Processor, "VendorIdentifier")
  104.     frmMain.lblProcessorModel.Caption = GetKeyValue(HKEY_LOCAL_MACHINE, RK_Processor, "Identifier")
  105.     tmpBuffer = GetKeyValue(HKEY_LOCAL_MACHINE, RK_Processor, "~MHZ")
  106.     If Len(Trim(tmpBuffer)) > 0 Then
  107.         frmMain.lblProcessorSpeed.Caption = Trim(tmpBuffer) & " MHz"
  108.     End If
  109.     
  110. End Sub
  111.  
  112. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
  113. '==========================================================================================================='
  114. ' Returns a specified key value from the registry                                                           '
  115. '==========================================================================================================='
  116. Dim lKey As Long
  117. Dim tmpVal As String
  118. Dim tmpKeySize As Long
  119. Dim tmpKeyType As Long
  120. Dim Counter As Integer
  121. '-----------------------------------------------------------------------------------------------------------'
  122. ' Set up needed variables                                                                                   '
  123. '-----------------------------------------------------------------------------------------------------------'
  124.     tmpVal = String(1024, 0)
  125.     tmpKeySize = 1024
  126. '-----------------------------------------------------------------------------------------------------------'
  127. ' Open the registry key. Any value other than zero means something went wrong                               '
  128. '-----------------------------------------------------------------------------------------------------------'
  129.     If RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_QUERY_VALUE, lKey) <> 0 Then
  130.         GetKeyValue = ""
  131.         RegCloseKey lKey
  132.         Exit Function
  133.     End If
  134. '-----------------------------------------------------------------------------------------------------------'
  135. ' Retrieve the registry value, any value other than zero means something went wrong                         '
  136. '-----------------------------------------------------------------------------------------------------------'
  137.     If RegQueryValueEx(lKey, SubKeyRef, 0, tmpKeyType, tmpVal, tmpKeySize) Then
  138.         GetKeyValue = ""
  139.         RegCloseKey lKey
  140.         Exit Function
  141.     End If
  142. '-----------------------------------------------------------------------------------------------------------'
  143. ' Extract the useful string from the garble                                                                 '
  144. '-----------------------------------------------------------------------------------------------------------'
  145.     If (Asc(Mid(tmpVal, tmpKeySize, 1)) = 0) Then
  146.         tmpVal = Left(tmpVal, tmpKeySize - 1)
  147.     Else
  148.         tmpVal = Left(tmpVal, tmpKeySize)
  149.     End If
  150. '-----------------------------------------------------------------------------------------------------------'
  151. ' If the returned value is a dword we need to format the value to something meaningful                      '
  152. '-----------------------------------------------------------------------------------------------------------'
  153.     If tmpKeyType = 4 Then
  154.         For Counter = Len(tmpVal) To 1 Step -1
  155.             GetKeyValue = GetKeyValue + Hex(Asc(Mid(tmpVal, Counter, 1)))
  156.         Next
  157.         GetKeyValue = Format("&h" + GetKeyValue)
  158.     Else
  159.         GetKeyValue = tmpVal
  160.     End If
  161. '-----------------------------------------------------------------------------------------------------------'
  162. ' Clean up                                                                                                  '
  163. '-----------------------------------------------------------------------------------------------------------'
  164.     RegCloseKey lKey
  165.     
  166. End Function
  167.