Here I share source code how to get PC system information using visual basic programming. This information includes: display driver, total memory load, available page file, virtual memory available, total virtual memory, available physical memory, total physical memory, CPU processor, OS platforms and computer name.
Open your visual basic. In form1, create textbox as many as 10 pieces and one timer (timer1) [see example image below].
Timer1 [enable = true], [interval = 1000]
Double click timer1 to open code window!
Private Sub Timer1_Timer()
SysInfo.DisplayInfo
SysInfo.TotalMemLoad
SysInfo.AvailablePageFile
SysInfo.AvailableVirtualMem
SysInfo.TotVirtualMem
SysInfo.AvailablePhysicalMem
SysInfo.PhysicalMem
SysInfo.CPU
SysInfo.OS
SysInfo.comp
End Sub
Copy the code above and paste to timer1 code window!
After that, make/add one module (module is named with "sysinfo"). Open sysinfo code window.Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(LpVersionInformation As OSVERSIONINFO) As Long
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As _
MEMORYSTATUS)
Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As _
SYSTEM_INFO)
Public Const PROCESSOR_INTEL_386 = 386
Public Const PROCESSOR_INTEL_486 = 486
Public Const PROCESSOR_INTEL_PENTIUM = 586
Public Const PROCESSOR_MIPS_R4000 = 4000
Public Const PROCESSOR_ALPHA_21064 = 21064
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Declarations For Display Info
Const ENUM_CURRENT_SETTINGS As Long = -1&
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
'End Of Declaration For Display Info
'Declaration For Getting GUI Resources Info
Private Const GR_GDIOBJECTS = 0
Private Const GR_USEROBJECTS = 1
Const GFSR_SYSTEMRESOURCES = 0
Const GFSR_GDIRESOURCES = 1
Const GFSR_USERRESOURCES = 2
Private Declare Function GetGuiResources Lib "user32.dll" (ByVal hProcess As Long, ByVal uiFlags As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
'End of Getting GUI Resources Info
'Declaration For Processor Feature
Private Const PF_FLOATING_POINT_PRECISION_ERRATA = 0
Private Const PF_FLOATING_POINT_EMULATED = 1
Private Const PF_COMPARE_EXCHANGE_DOUBLE = 2
Private Const PF_MMX_INSTRUCTIONS_AVAILABLE = 3
Private Const PF_XMMI_INSTRUCTIONS_AVAILABLE = 6
Private Const PF_3DNOW_INSTRUCTIONS_AVAILABLE = 7
Private Const PF_RDTSC_INSTRUCTION_AVAILABLE = 8
Private Const PF_PAE_ENABLED = 9
Private Declare Function IsProcessorFeaturePresent Lib "kernel32.dll" (ByVal ProcessorFeature As Long) As Long
Dim CPUInfo As String
'End of Declaration For processor feature
'Declaration For Environment settings
Private Declare Function GetEnvironmentStrings Lib "kernel32" Alias "GetEnvironmentStringsA" () As Long
Private Declare Function FreeEnvironmentStrings Lib "kernel32" Alias "FreeEnvironmentStringsA" (ByVal lpsz As String) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
'End of Declaration For Environment settings
'Declerations For Enumerating Running Process
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
'End Declerations For Enumerating Running Process
'Decleration For Checking is administartor
Private Const ANYSIZE_ARRAY = 20 'Fixed at this size for comfort. Could be bigger or made dynamic.
'Security APIs
Private Const TokenUser = 1
Private Const TokenGroups = 2
Private Const TokenPrivileges = 3
Private Const TokenOwner = 4
Private Const TokenPrimaryGroup = 5
Private Const TokenDefaultDacl = 6
Private Const TokenSource = 7
Private Const TokenType = 8
Private Const TokenImpersonationLevel = 9
Private Const TokenStatistics = 10
'Token Specific Access Rights
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = &H2
Private Const TOKEN_IMPERSONATE = &H4
Private Const TOKEN_QUERY = &H8
Private Const TOKEN_QUERY_SOURCE = &H10
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_ADJUST_GROUPS = &H40
Private Const TOKEN_ADJUST_DEFAULT = &H80
' NT well-known SIDs
Private Const SECURITY_DIALUP_RID = &H1
Private Const SECURITY_NETWORK_RID = &H2
Private Const SECURITY_BATCH_RID = &H3
Private Const SECURITY_INTERACTIVE_RID = &H4
Private Const SECURITY_SERVICE_RID = &H6
Private Const SECURITY_ANONYMOUS_LOGON_RID = &H7
Private Const SECURITY_LOGON_IDS_RID = &H5
Private Const SECURITY_LOCAL_SYSTEM_RID = &H12
Private Const SECURITY_NT_NON_UNIQUE = &H15
Private Const SECURITY_BUILTIN_DOMAIN_RID = &H20
' Well-known domain relative sub-authority values (RIDs)
Private Const DOMAIN_ALIAS_RID_ADMINS = &H220
Private Const DOMAIN_ALIAS_RID_USERS = &H221
Private Const DOMAIN_ALIAS_RID_GUESTS = &H222
Private Const DOMAIN_ALIAS_RID_POWER_USERS = &H223
Private Const DOMAIN_ALIAS_RID_ACCOUNT_OPS = &H224
Private Const DOMAIN_ALIAS_RID_SYSTEM_OPS = &H225
Private Const DOMAIN_ALIAS_RID_PRINT_OPS = &H226
Private Const DOMAIN_ALIAS_RID_BACKUP_OPS = &H227
Private Const DOMAIN_ALIAS_RID_REPLICATOR = &H228
Private Const SECURITY_NT_AUTHORITY = &H5
Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type
Type TOKEN_GROUPS
GroupCount As Long
Groups(ANYSIZE_ARRAY) As SID_AND_ATTRIBUTES
End Type
Type SID_IDENTIFIER_AUTHORITY
Value(0 To 5) As Byte
End Type
'Declare Function GetCurrentProcess Lib "Kernel32" () As Long
Declare Function GetCurrentThread Lib "kernel32" () As Long
Declare Function OpenProcessToken Lib "Advapi32" ( _
ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
Declare Function OpenThreadToken Lib "Advapi32" ( _
ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, _
ByVal OpenAsSelf As Long, TokenHandle As Long) As Long
Declare Function GetTokenInformation Lib "Advapi32" ( _
ByVal TokenHandle As Long, TokenInformationClass As Integer, _
TokenInformation As Any, ByVal TokenInformationLength As Long, _
ReturnLength As Long) As Long
Declare Function AllocateAndInitializeSid Lib "Advapi32" ( _
pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, _
ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, _
ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, _
ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, _
ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, _
ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Declare Function RtlMoveMemory Lib "kernel32" ( _
Dest As Any, Source As Any, ByVal lSize As Long) As Long
Declare Function IsValidSid Lib "Advapi32" (ByVal pSid As Long) As Long
Declare Function EqualSid Lib "Advapi32" (pSid1 As Any, pSid2 As Any) As Long
Declare Sub FreeSid Lib "Advapi32" (pSid As Any)
'Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
'End checking IsAdmin
'Declaration For Getting Drives Info
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
'End of Declaration For Getting Drives Info
Public Function GetDisplayInfo() As String
Dim DispInfo As DEVMODE
Dim SDispRet As String
Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DispInfo)
SDispRet = SDispRet & "Display Driver: " & Trim(DispInfo.dmDeviceName)
'Return gathered info to calling function
GetDisplayInfo = SDispRet
End Function
Public Function GetCPUFeature() As String
GetCPUFeature = CPUInfo
End Function
Private Sub ShowFeature(lIndex As Long, Description As String)
If IsProcessorFeaturePresent(lIndex) = 0 Then
CPUInfo = CPUInfo & Description + " : False" & vbCrLf
Else
CPUInfo = CPUInfo & Description + " : True" & vbCrLf
End If
End Sub
Public Function GetEnvString() As String
Dim lngRet As Long, strDest As String, lLen As Long
Dim sEnvRet As String
'retrieve the initial pointer to the environment strings
lngRet = GetEnvironmentStrings
Do
'get the length of the following string
lLen = lstrlen(lngRet)
'if the length equals 0, we've reached the end
If lLen = 0 Then Exit Do
'create a buffer string
strDest = Space$(lLen)
'copy the text from the environment block
CopyMemory ByVal strDest, ByVal lngRet, lLen
sEnvRet = sEnvRet & strDest & vbCrLf
'move the pointer
lngRet = lngRet + lstrlen(lngRet) + 1
Loop
'GetEnvString = sEnvRet
'clean up
FreeEnvironmentStrings lngRet
'Return gathered info to calling function
GetEnvString = sEnvRet
End Function
Public Function GetProcessInfo() As String
Dim hSnapShot As Long, uProcess As PROCESSENTRY32
Dim sRetProcInfo As String
'Takes a snapshot of the processes and the heaps, modules, and threads used by the processes
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
'set the length of our ProcessEntry-type
uProcess.dwSize = Len(uProcess)
'Retrieve information about the first process encountered in our system snapshot
r = Process32First(hSnapShot, uProcess)
Do While r
sRetProcInfo = sRetProcInfo & Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) & vbCrLf
'Retrieve information about the next process recorded in our system snapshot
r = Process32Next(hSnapShot, uProcess)
Loop
'close our snapshot handle
CloseHandle hSnapShot
'Return gathered info to calling function
GetProcessInfo = sRetProcInfo
End Function
Public Function IsAdmin() As Boolean
'By Anderson Mesquita
Dim hProcessToken As Long
Dim BufferSize As Long
Dim psidAdmin As Long
Dim lResult As Long
Dim X As Integer
Dim tpTokens As TOKEN_GROUPS
Dim tpSidAuth As SID_IDENTIFIER_AUTHORITY
IsAdmin = False
tpSidAuth.Value(5) = SECURITY_NT_AUTHORITY
' Obtain current process token
If Not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hProcessToken) Then
Call OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hProcessToken)
End If
If hProcessToken Then
' Deternine the buffer size required
Call GetTokenInformation(hProcessToken, ByVal TokenGroups, 0, 0, BufferSize) ' Determine required buffer size
If BufferSize Then
ReDim InfoBuffer((BufferSize \ 4) - 1) As Long
' Retrieve your token information
lResult = GetTokenInformation(hProcessToken, ByVal TokenGroups, InfoBuffer(0), BufferSize, BufferSize)
If lResult <> 1 Then Exit Function
' Move it from memory into the token structure
Call RtlMoveMemory(tpTokens, InfoBuffer(0), Len(tpTokens))
' Retreive the admins sid pointer
lResult = AllocateAndInitializeSid(tpSidAuth, 2, SECURITY_BUILTIN_DOMAIN_RID, _
DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdmin)
If lResult <> 1 Then Exit Function
If IsValidSid(psidAdmin) Then
For X = 0 To tpTokens.GroupCount
' Run through your token sid pointers
If IsValidSid(tpTokens.Groups(X).Sid) Then
' Test for a match between the admin sid equalling your sid's
If EqualSid(ByVal tpTokens.Groups(X).Sid, ByVal psidAdmin) Then
IsAdmin = True
Exit For
End If
End If
Next
End If
If psidAdmin Then Call FreeSid(psidAdmin)
End If
Call CloseHandle(hProcessToken)
End If
End Function
Public Function GetOS() As String
Dim verinfo As OSVERSIONINFO
Dim sRetOS As String
Dim build As String, ver_major As String, ver_minor As String
Dim ret As Long
verinfo.dwOSVersionInfoSize = Len(verinfo)
ret = GetVersionEx(verinfo)
If ret = 0 Then
MsgBox "Error Getting Version Information"
End
End If
Select Case verinfo.dwPlatformId
Case 0
sRetOS = "Windows 32s "
Case 1
sRetOS = "Windows 95 "
Case 2
sRetOS = "Windows NT "
End Select
ver_major = verinfo.dwMajorVersion
ver_minor = verinfo.dwMinorVersion
build = verinfo.dwBuildNumber
sRetOS = sRetOS & ver_major & "." & ver_minor
sRetOS = sRetOS & " (Build " & build & ")" & vbCrLf & vbCrLf
'Return gathered info to calling function
GetOS = sRetOS
End Function
Public Function FormatFileSize(ByVal Size As Double) As String
Dim sRet As String
Const KB& = 1024
Const MB& = KB * KB
' Return size of file in kilobytes.
If Size < KB Then
sRet = Format(Size, "#,##0") & " bytes"
Else
Select Case Size / 1024
Case Is < 10
sRet = Format(Size / KB, "0.00") & " KB"
Case Is < 100
sRet = Format(Size / KB, "0.0") & " KB"
Case Is < 1000
sRet = Format(Size / KB, "0") & " KB"
Case Is < 10000
sRet = Format(Size / MB, "0.00") & " MB"
Case Is < 100000
sRet = Format(Size / MB, "0.0") & " MB"
Case Is < 1000000
sRet = Format(Size / MB, "0") & " MB"
Case Is < 10000000
sRet = Format(Size / MB / KB, "0.00") & " GB"
Case Else
sRet = " Error"
End Select
sRet = sRet '& " (" & Format(Size, "#,##0") & " bytes)"
End If
FormatFileSize = sRet
End Function
Public Function comp() As String
Dim strString As String
dwLen = MAX_COMPUTERNAME_LENGTH + 1
strString = String(dwLen, "X")
GetComputerName strString, dwLen
strString = Left(strString, dwLen)
Form1.Text10.Text = "Computer Name: " & strString
End Function
Public Function OS() As String
Form1.Text9.Text = "OS Platform: " & GetOS
End Function
Public Function CPU() As String
Dim SysInfo As SYSTEM_INFO
GetSystemInfo SysInfo
Msg = Msg & "CPU Processor: "
Select Case SysInfo.dwProcessorType
Case PROCESSOR_INTEL_386
Msg = Msg & "Intel 386"
Case PROCESSOR_INTEL_486
Msg = Msg & "Intel 486"
Case PROCESSOR_INTEL_PENTIUM
Msg = Msg & "Intel Pentium"
Case PROCESSOR_MIPS_R4000
Msg = Msg & "MIPS R4000"
Case PROCESSOR_ALPHA_21064
Msg = Msg & "DEC Alpha 21064"
Case Else
Msg = Msg & "(unknown)"
End Select
Form1.Text8.Text = Msg & GetCPUFeature
End Function
Public Function PhysicalMem() As String
Dim memsts As MEMORYSTATUS
Dim memory As Long
GlobalMemoryStatus memsts
memory = memsts.dwTotalPhys
Form1.Text7.Text = "Total Physical Memory: " & FormatFileSize(memory)
End Function
Public Function AvailablePhysicalMem() As String
Dim memsts As MEMORYSTATUS
Dim memory As Long
GlobalMemoryStatus memsts
memory = memsts.dwAvailPhys
Form1.Text6.Text = "Available Physical Memory: " & FormatFileSize(memory)
End Function
Public Function TotVirtualMem() As String
Dim memsts As MEMORYSTATUS
Dim memory As Long
GlobalMemoryStatus memsts
memory = memsts.dwTotalVirtual
Form1.Text5.Text = "Total Virtual Memory: " & FormatFileSize(memory)
End Function
Public Function AvailableVirtualMem() As String
Dim memsts As MEMORYSTATUS
Dim memory As Long
GlobalMemoryStatus memsts
memory = memsts.dwAvailVirtual
Form1.Text4.Text = "Available Virtual Memory: " & FormatFileSize(memory)
End Function
Public Function AvailablePageFile() As String
Dim memsts As MEMORYSTATUS
Dim memory As Long
GlobalMemoryStatus memsts
memory = memsts.dwAvailPageFile
Form1.Text3.Text = "Available Page File: " & FormatFileSize(memory)
End Function
Public Function TotalMemLoad() As String
Dim memsts As MEMORYSTATUS
Dim memory As Long
GlobalMemoryStatus memsts
memory& = memsts.dwMemoryLoad
Form1.Text2.Text = "Total Memory Load: " & FormatFileSize(memory)
End Function
Public Function DisplayInfo() As String
Form1.Text1.Text = GetDisplayInfo()
End Function
Copy the code above and paste to sysinfo code window! Good luck.
Keyword: sysinfo in visual basic | sysinfo source code | PC Specification Source Code | Computer Specification Source Code Tumpal Tambunan
|
You may also like: