1.获得版本和windows版本号等信息:Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long 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 Sub Form_Load() Dim OSInfo As OSVERSIONINFO, PId As String '[email protected] 'Set the graphical mode to persistent Me.AutoRedraw = True 'Set the structure size OSInfo.dwOSVersionInfoSize = Len(OSInfo) 'Get the Windows version Ret& = GetVersionEx(OSInfo) 'Chack for errors If Ret& = 0 Then MsgBox "Error Getting Version Information": Exit Sub 'Print the information to the form Select Case OSInfo.dwPlatformId Case 0 PId = "Windows 32s " Case 1 PId = "Windows 95/98" Case 2 PId = "Windows NT " End Select Print "OS: " + PId Print "Win version:" + str$(OSInfo.dwMajorVersion) + "." + LTrim(str(OSInfo.dwMinorVersion)) Print "Build: " + str(OSInfo.dwBuildNumber) End Sub2.获得系统目录信息(得到的系统目录比如是X:\windows\system32,需要用字串处理截取到你想要的部分): Private Declare Function GetCurrentDirectory Lib "kernel32" Alias "GetCurrentDirectoryA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Sub Form_Paint() 'E-Mail: [email protected] Dim sSave As String 'create a buffer sSave = String(255, 0) 'retrieve the current directory GetCurrentDirectory sSave,255 MsgBox sSave End Sub
引用: Microsoft WMI Scripting V1.1 Library 代码:(需要一个 TREEVIEW ,一个 COMMANDBUTTON) ============================ Option Explicit'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ?1996-2002 VBnet, Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you can not publish ' or reproduce this code on any web site, ' on any online service, or distribute on ' any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '/* Below used for listview column auto-resizing Private Const LVM_FIRST As Long = &H1000 Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30) Private Const LVSCW_AUTOSIZE As Long = -1 Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Sub Form_Load() With ListView1 .ListItems.Clear .ColumnHeaders.Clear .ColumnHeaders.Add , , "WMI Property" .ColumnHeaders.Add , , "Value(s)" .View = lvwReport .Sorted = False End With
Command1.Caption = "OS Info"End Sub Private Sub Command1_Click() ListView1.ListItems.Clear Call wmiOperatingSystemInfo Call lvAutosizeControl(ListView1)
End Sub Private Sub lvAutosizeControl(lv As ListView) Dim col2adjust As Long '/* Size each column based on the maximum of '/* EITHER the columnheader text width, or, '/* if the items below it are wider, the '/* widest list item in the column For col2adjust = 0 To lv.ColumnHeaders.Count - 1
Call SendMessage(lv.hwnd, _ LVM_SETCOLUMNWIDTH, _ col2adjust, _ ByVal LVSCW_AUTOSIZE_USEHEADER) Next
End Sub Private Function SplitDateTimeBias(ByVal leasedate As String, _ leasedatepart As String, _ leasetimepart As String) As Long 'takes a datetime returned by the 'Win32_NetworkAdapterConfiguration 'and splits out the date and time 'components, returns them in the 'leasedatepart and leasetimepart 'passed variables, and returns the 'bias to be applied to the resultant date. Dim pos As Long Dim bias As Long
SplitDateTimeBias = bias Else End IfEnd Function Private Function InsertInString(ByVal sOriginal As String, _ sReplace As String, _ nField As Long, _ sDelimeter As String) As String
'c 1998 Mario Lavignasse 'Abbott Scientific 'Replaces or inserts a string into a (any char) delimeted string ' 'Syntax: 'sOriginal: string of interest, returned unchanged 'sReplace: replacement or insert chr(s) 'nField: 1-based position for the insert/replace to begin 'sDelimeter: string to insert/replace. If empty, sReplace is ' inserted, if present sDelimeter is replaced by sReplace. ' 'Examples: 'Inserting: ' x = InsertInString("Hello World", "Hello ", 7, "") ' (x="Hello Hello World") ' 'Replacing: ' x = InsertInString("Hello World", "Hello ", 7, "World") ' (x="Hello Hello")
Dim nCount As Long Dim nStart As Long Dim nLast As Long
Do While InStr(nStart + 1, sOriginal, sDelimeter) > 0
3.取得用户名(两种,自己试试,程序写法和上例取系统目录是一样的):Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As LongPublic GetUserNameW Lib "advapi32.dll" (lpBuffer As Byte, nSize As Long) As Long 顺便纠正2中的 GetCurrentDirectory sSave,255 好象写反了。 应该是 255,sSave
Select Case nCount
Case 1 InsertInString = sReplace & Mid$(sOriginal, nStart)
Case Is >= nField InsertInString = Mid$(sOriginal, 1, nLast) & _ sReplace & Mid$(sOriginal, nStart) Case Else InsertInString = sOriginal & _ String$((nField - 1) - nCount, sDelimeter) & _ sReplace End Select
End Function Private Function StripTimeZoneBias(leasedate As String) As Long Dim pos As Long Dim tmp As String
'locale, language and codeset info Set itmx = ListView1.ListItems.Add(, , "OSLanguage") itmx.SubItems(1) = obj.OSLanguage Set itmx = ListView1.ListItems.Add(, , "CodeSet") itmx.SubItems(1) = obj.CodeSet Set itmx = ListView1.ListItems.Add(, , "Locale") itmx.SubItems(1) = obj.Locale Set itmx = ListView1.ListItems.Add(, , "CountryCode") itmx.SubItems(1) = obj.CountryCode Set itmx = ListView1.ListItems.Add(, , "CurrentTimeZone") itmx.SubItems(1) = obj.CurrentTimeZone
'performance and memory info Set itmx = ListView1.ListItems.Add(, , "ForegroundApplicationBoost") Select Case obj.ForegroundApplicationBoost Case 0: msg = "none" Case 1: msg = "minimum" Case 2: msg = "maximum (default)" End Select itmx.SubItems(1) = msg
Set itmx = ListView1.ListItems.Add(, , "TotalVisibleMemorySize") itmx.SubItems(1) = FormatNumber(obj.TotalVisibleMemorySize, 0) Set itmx = ListView1.ListItems.Add(, , "FreePhysicalMemory") itmx.SubItems(1) = FormatNumber(obj.FreePhysicalMemory, 0) Set itmx = ListView1.ListItems.Add(, , "TotalVirtualMemorySize") itmx.SubItems(1) = FormatNumber(obj.TotalVirtualMemorySize, 0) Set itmx = ListView1.ListItems.Add(, , "FreeVirtualMemory") itmx.SubItems(1) = FormatNumber(obj.FreeVirtualMemory, 0) Set itmx = ListView1.ListItems.Add(, , "FreeSpaceInPagingFiles") itmx.SubItems(1) = FormatNumber(obj.FreeSpaceInPagingFiles, 0) Set itmx = ListView1.ListItems.Add(, , "SizeStoredInPagingFiles") itmx.SubItems(1) = FormatNumber(obj.SizeStoredInPagingFiles, 0)
Next
End Sub '--end block--'
如果你对注册表熟悉的话,直接去访问注册表比较快!而且可以避免DLL:一个字:烦!
Private 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 Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)Private Sub Command1_Click() Dim len5 As Long, aa As Long Dim sysinfo As SYSTEM_INFO Call GetSystemInfo(sysinfo) End Sub注: dwProcessorType Platform Value ============ =============================== Windows 95 PROCESSOR_INTEL_386 = 386 PROCESSOR_INTEL_486 = 486 PROCESSOR_INTEL_PENTIUM = 586 Windows NT PROCESSOR_INTEL_386 PROCESSOR_INTEL_486 PROCESSOR_INTEL_PENTIUM PROCESSOR_MIPS_R4000 4000 PROCESSOR_ALPHA_21046 21046
Select Case nCount
Case 1 InsertInString = sReplace & Mid$(sOriginal, nStart)
Case Is >= nField InsertInString = Mid$(sOriginal, 1, nLast) & _ sReplace & Mid$(sOriginal, nStart) Case Else InsertInString = sOriginal & _ String$((nField - 1) - nCount, sDelimeter) & _ sReplace End Select
End Function Private Function StripTimeZoneBias(leasedate As String) As Long Dim pos As Long Dim tmp As String
'locale, language and codeset info Set itmx = ListView1.ListItems.Add(, , "OSLanguage") itmx.SubItems(1) = obj.OSLanguage Set itmx = ListView1.ListItems.Add(, , "CodeSet") itmx.SubItems(1) = obj.CodeSet Set itmx = ListView1.ListItems.Add(, , "Locale") itmx.SubItems(1) = obj.Locale Set itmx = ListView1.ListItems.Add(, , "CountryCode") itmx.SubItems(1) = obj.CountryCode Set itmx = ListView1.ListItems.Add(, , "CurrentTimeZone") itmx.SubItems(1) = obj.CurrentTimeZone
'performance and memory info Set itmx = ListView1.ListItems.Add(, , "ForegroundApplicationBoost") Select Case obj.ForegroundApplicationBoost Case 0: msg = "none" Case 1: msg = "minimum" Case 2: msg = "maximum (default)" End Select itmx.SubItems(1) = msg
Set itmx = ListView1.ListItems.Add(, , "TotalVisibleMemorySize") itmx.SubItems(1) = FormatNumber(obj.TotalVisibleMemorySize, 0) Set itmx = ListView1.ListItems.Add(, , "FreePhysicalMemory") itmx.SubItems(1) = FormatNumber(obj.FreePhysicalMemory, 0) Set itmx = ListView1.ListItems.Add(, , "TotalVirtualMemorySize") itmx.SubItems(1) = FormatNumber(obj.TotalVirtualMemorySize, 0) Set itmx = ListView1.ListItems.Add(, , "FreeVirtualMemory") itmx.SubItems(1) = FormatNumber(obj.FreeVirtualMemory, 0) Set itmx = ListView1.ListItems.Add(, , "FreeSpaceInPagingFiles") itmx.SubItems(1) = FormatNumber(obj.FreeSpaceInPagingFiles, 0) Set itmx = ListView1.ListItems.Add(, , "SizeStoredInPagingFiles") itmx.SubItems(1) = FormatNumber(obj.SizeStoredInPagingFiles, 0)
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 Sub Form_Load()
Dim OSInfo As OSVERSIONINFO, PId As String
'[email protected]
'Set the graphical mode to persistent
Me.AutoRedraw = True
'Set the structure size
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
'Get the Windows version
Ret& = GetVersionEx(OSInfo)
'Chack for errors
If Ret& = 0 Then MsgBox "Error Getting Version Information": Exit Sub
'Print the information to the form
Select Case OSInfo.dwPlatformId
Case 0
PId = "Windows 32s "
Case 1
PId = "Windows 95/98"
Case 2
PId = "Windows NT "
End Select
Print "OS: " + PId
Print "Win version:" + str$(OSInfo.dwMajorVersion) + "." + LTrim(str(OSInfo.dwMinorVersion))
Print "Build: " + str(OSInfo.dwBuildNumber)
End Sub2.获得系统目录信息(得到的系统目录比如是X:\windows\system32,需要用字串处理截取到你想要的部分):
Private Declare Function GetCurrentDirectory Lib "kernel32" Alias "GetCurrentDirectoryA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Sub Form_Paint()
'E-Mail: [email protected]
Dim sSave As String
'create a buffer
sSave = String(255, 0)
'retrieve the current directory
GetCurrentDirectory sSave,255
MsgBox sSave
End Sub
============================
Option Explicit''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ?1996-2002 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you can not publish
' or reproduce this code on any web site,
' on any online service, or distribute on
' any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'/* Below used for listview column auto-resizing
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Sub Form_Load() With ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "WMI Property"
.ColumnHeaders.Add , , "Value(s)"
.View = lvwReport
.Sorted = False
End With
Command1.Caption = "OS Info"End Sub
Private Sub Command1_Click() ListView1.ListItems.Clear
Call wmiOperatingSystemInfo
Call lvAutosizeControl(ListView1)
End Sub
Private Sub lvAutosizeControl(lv As ListView) Dim col2adjust As Long '/* Size each column based on the maximum of
'/* EITHER the columnheader text width, or,
'/* if the items below it are wider, the
'/* widest list item in the column
For col2adjust = 0 To lv.ColumnHeaders.Count - 1
Call SendMessage(lv.hwnd, _
LVM_SETCOLUMNWIDTH, _
col2adjust, _
ByVal LVSCW_AUTOSIZE_USEHEADER) Next
End Sub
Private Function SplitDateTimeBias(ByVal leasedate As String, _
leasedatepart As String, _
leasetimepart As String) As Long 'takes a datetime returned by the
'Win32_NetworkAdapterConfiguration
'and splits out the date and time
'components, returns them in the
'leasedatepart and leasetimepart
'passed variables, and returns the
'bias to be applied to the resultant date.
Dim pos As Long
Dim bias As Long
pos = InStr(leasedate, ".") If pos > 0 Then bias = StripTimeZoneBias(leasedate)
leasedatepart = Left$(leasedate, 8)
leasetimepart = Mid$(leasedate, 9, pos - Len(leasedatepart) - 1)
leasedatepart = InsertInString(leasedatepart, "-", 5, "")
leasedatepart = InsertInString(leasedatepart, "-", 8, "")
leasetimepart = InsertInString(leasetimepart, ":", 3, "")
leasetimepart = InsertInString(leasetimepart, ":", 6, "")
SplitDateTimeBias = bias Else End IfEnd Function
Private Function InsertInString(ByVal sOriginal As String, _
sReplace As String, _
nField As Long, _
sDelimeter As String) As String
'c 1998 Mario Lavignasse
'Abbott Scientific
'Replaces or inserts a string into a (any char) delimeted string
'
'Syntax:
'sOriginal: string of interest, returned unchanged
'sReplace: replacement or insert chr(s)
'nField: 1-based position for the insert/replace to begin
'sDelimeter: string to insert/replace. If empty, sReplace is
' inserted, if present sDelimeter is replaced by sReplace.
'
'Examples:
'Inserting:
' x = InsertInString("Hello World", "Hello ", 7, "")
' (x="Hello Hello World")
'
'Replacing:
' x = InsertInString("Hello World", "Hello ", 7, "World")
' (x="Hello Hello")
Dim nCount As Long
Dim nStart As Long
Dim nLast As Long
Do While InStr(nStart + 1, sOriginal, sDelimeter) > 0
nStart = InStr(nStart + 1, sOriginal, sDelimeter)
nCount = nCount + 1
If nCount >= nField Then
Exit Do
End If
nLast = nStart
Loop
顺便纠正2中的 GetCurrentDirectory sSave,255 好象写反了。 应该是 255,sSave
Case 1
InsertInString = sReplace & Mid$(sOriginal, nStart)
Case Is >= nField
InsertInString = Mid$(sOriginal, 1, nLast) & _
sReplace & Mid$(sOriginal, nStart)
Case Else
InsertInString = sOriginal & _
String$((nField - 1) - nCount, sDelimeter) & _
sReplace
End Select
End Function
Private Function StripTimeZoneBias(leasedate As String) As Long Dim pos As Long
Dim tmp As String
pos = InStr(leasedate, "-")
If pos = 0 Then
pos = InStr(leasedate, "+")
If pos = 0 Then
StripTimeZoneBias = 0
Else
End If
Else
tmp = Mid$(leasedate, pos, Len(leasedate))
leasedate = Mid$(leasedate, 1, pos - 1)
StripTimeZoneBias = CLng(tmp)
End IfEnd Function
Private Sub wmiOperatingSystemInfo() Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Dim msg As String
Dim itmx As ListItem
'working vars for returning the date info
Dim dtb As String
Dim d As String
Dim t As String
Dim bias As Long
On Local Error Resume Next Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_OperatingSystem")
For Each obj In wmiObjSet
'version info
Set itmx = ListView1.ListItems.Add(, , "Operating System")
itmx.SubItems(1) = obj.Caption
Set itmx = ListView1.ListItems.Add(, , "Version")
itmx.SubItems(1) = obj.Version
Set itmx = ListView1.ListItems.Add(, , "BuildNumber")
itmx.SubItems(1) = obj.BuildNumber
Set itmx = ListView1.ListItems.Add(, , "BuildType")
itmx.SubItems(1) = obj.BuildType
Set itmx = ListView1.ListItems.Add(, , "Latest Service Pack")
itmx.SubItems(1) = obj.CSDVersion
Set itmx = ListView1.ListItems.Add(, , "EncryptionLevel")
itmx.SubItems(1) = obj.EncryptionLevel & "-bit"
Set itmx = ListView1.ListItems.Add(, , "OSType")
Select Case obj.OSType
Case 15: msg = "WIN3x"
Case 16: msg = "WIN95"
Case 17: msg = "WIN98"
Case 18: msg = "WINNT"
Case 19: msg = "WINCE"
Case Else: msg = "non-windows - see MSDN for complete list"
End Select
itmx.SubItems(1) = msg
'system info
Set itmx = ListView1.ListItems.Add(, , "BootDevice")
itmx.SubItems(1) = obj.BootDevice
Set itmx = ListView1.ListItems.Add(, , "RegisteredUser")
itmx.SubItems(1) = obj.RegisteredUser
Set itmx = ListView1.ListItems.Add(, , "SerialNumber")
itmx.SubItems(1) = obj.SerialNumber
Set itmx = ListView1.ListItems.Add(, , "Status")
itmx.SubItems(1) = obj.Status
Set itmx = ListView1.ListItems.Add(, , "SystemDevice")
itmx.SubItems(1) = obj.SystemDevice
Set itmx = ListView1.ListItems.Add(, , "SystemDrive")
itmx.SubItems(1) = obj.SystemDrive
Set itmx = ListView1.ListItems.Add(, , "WindowsDirectory")
itmx.SubItems(1) = obj.WindowsDirectory
Set itmx = ListView1.ListItems.Add(, , "SystemDirectory")
itmx.SubItems(1) = obj.SystemDirectory
Set itmx = ListView1.ListItems.Add(, , "LocalDateTime")
dtb = obj.LocalDateTime
bias = SplitDateTimeBias(dtb, d, t)
itmx.SubItems(1) = Format$(d, "dddd mmm d, yyyy") & " " & _
Format$(t, "hh:mm") & _
" (includes " & bias & " bias)"
Set itmx = ListView1.ListItems.Add(, , "InstallDate")
dtb = obj.InstallDate
bias = SplitDateTimeBias(dtb, d, t)
itmx.SubItems(1) = Format$(d, "dddd mmm d, yyyy") & _
" at " & _
Format$(t, "hh:mm") & _
" (includes " & bias & " bias)"
Set itmx = ListView1.ListItems.Add(, , "LastBootUpTime")
dtb = obj.LastBootUpTime
bias = SplitDateTimeBias(dtb, d, t)
itmx.SubItems(1) = Format$(d, "dddd mmm d, yyyy") & _
" at " & _
Format$(t, "hh:mm") & _
" (includes " & bias & " bias)"
'locale, language and codeset info
Set itmx = ListView1.ListItems.Add(, , "OSLanguage")
itmx.SubItems(1) = obj.OSLanguage
Set itmx = ListView1.ListItems.Add(, , "CodeSet")
itmx.SubItems(1) = obj.CodeSet
Set itmx = ListView1.ListItems.Add(, , "Locale")
itmx.SubItems(1) = obj.Locale
Set itmx = ListView1.ListItems.Add(, , "CountryCode")
itmx.SubItems(1) = obj.CountryCode
Set itmx = ListView1.ListItems.Add(, , "CurrentTimeZone")
itmx.SubItems(1) = obj.CurrentTimeZone
'performance and memory info
Set itmx = ListView1.ListItems.Add(, , "ForegroundApplicationBoost")
Select Case obj.ForegroundApplicationBoost
Case 0: msg = "none"
Case 1: msg = "minimum"
Case 2: msg = "maximum (default)"
End Select
itmx.SubItems(1) = msg
Set itmx = ListView1.ListItems.Add(, , "TotalVisibleMemorySize")
itmx.SubItems(1) = FormatNumber(obj.TotalVisibleMemorySize, 0)
Set itmx = ListView1.ListItems.Add(, , "FreePhysicalMemory")
itmx.SubItems(1) = FormatNumber(obj.FreePhysicalMemory, 0)
Set itmx = ListView1.ListItems.Add(, , "TotalVirtualMemorySize")
itmx.SubItems(1) = FormatNumber(obj.TotalVirtualMemorySize, 0)
Set itmx = ListView1.ListItems.Add(, , "FreeVirtualMemory")
itmx.SubItems(1) = FormatNumber(obj.FreeVirtualMemory, 0)
Set itmx = ListView1.ListItems.Add(, , "FreeSpaceInPagingFiles")
itmx.SubItems(1) = FormatNumber(obj.FreeSpaceInPagingFiles, 0)
Set itmx = ListView1.ListItems.Add(, , "SizeStoredInPagingFiles")
itmx.SubItems(1) = FormatNumber(obj.SizeStoredInPagingFiles, 0)
Next
End Sub
'--end block--'
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
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)Private Sub Command1_Click()
Dim len5 As Long, aa As Long
Dim sysinfo As SYSTEM_INFO
Call GetSystemInfo(sysinfo)
End Sub注:
dwProcessorType
Platform Value
============ ===============================
Windows 95 PROCESSOR_INTEL_386 = 386
PROCESSOR_INTEL_486 = 486
PROCESSOR_INTEL_PENTIUM = 586
Windows NT PROCESSOR_INTEL_386
PROCESSOR_INTEL_486
PROCESSOR_INTEL_PENTIUM
PROCESSOR_MIPS_R4000 4000
PROCESSOR_ALPHA_21046 21046
Case 1
InsertInString = sReplace & Mid$(sOriginal, nStart)
Case Is >= nField
InsertInString = Mid$(sOriginal, 1, nLast) & _
sReplace & Mid$(sOriginal, nStart)
Case Else
InsertInString = sOriginal & _
String$((nField - 1) - nCount, sDelimeter) & _
sReplace
End Select
End Function
Private Function StripTimeZoneBias(leasedate As String) As Long Dim pos As Long
Dim tmp As String
pos = InStr(leasedate, "-")
If pos = 0 Then
pos = InStr(leasedate, "+")
If pos = 0 Then
StripTimeZoneBias = 0
Else
End If
Else
tmp = Mid$(leasedate, pos, Len(leasedate))
leasedate = Mid$(leasedate, 1, pos - 1)
StripTimeZoneBias = CLng(tmp)
End IfEnd Function
Private Sub wmiOperatingSystemInfo() Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Dim msg As String
Dim itmx As ListItem
'working vars for returning the date info
Dim dtb As String
Dim d As String
Dim t As String
Dim bias As Long
On Local Error Resume Next Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_OperatingSystem")
For Each obj In wmiObjSet
'version info
Set itmx = ListView1.ListItems.Add(, , "Operating System")
itmx.SubItems(1) = obj.Caption
Set itmx = ListView1.ListItems.Add(, , "Version")
itmx.SubItems(1) = obj.Version
Set itmx = ListView1.ListItems.Add(, , "BuildNumber")
itmx.SubItems(1) = obj.BuildNumber
Set itmx = ListView1.ListItems.Add(, , "BuildType")
itmx.SubItems(1) = obj.BuildType
Set itmx = ListView1.ListItems.Add(, , "Latest Service Pack")
itmx.SubItems(1) = obj.CSDVersion
Set itmx = ListView1.ListItems.Add(, , "EncryptionLevel")
itmx.SubItems(1) = obj.EncryptionLevel & "-bit"
Set itmx = ListView1.ListItems.Add(, , "OSType")
Select Case obj.OSType
Case 15: msg = "WIN3x"
Case 16: msg = "WIN95"
Case 17: msg = "WIN98"
Case 18: msg = "WINNT"
Case 19: msg = "WINCE"
Case Else: msg = "non-windows - see MSDN for complete list"
End Select
itmx.SubItems(1) = msg
'system info
Set itmx = ListView1.ListItems.Add(, , "BootDevice")
itmx.SubItems(1) = obj.BootDevice
Set itmx = ListView1.ListItems.Add(, , "RegisteredUser")
itmx.SubItems(1) = obj.RegisteredUser
Set itmx = ListView1.ListItems.Add(, , "SerialNumber")
itmx.SubItems(1) = obj.SerialNumber
Set itmx = ListView1.ListItems.Add(, , "Status")
itmx.SubItems(1) = obj.Status
Set itmx = ListView1.ListItems.Add(, , "SystemDevice")
itmx.SubItems(1) = obj.SystemDevice
Set itmx = ListView1.ListItems.Add(, , "SystemDrive")
itmx.SubItems(1) = obj.SystemDrive
Set itmx = ListView1.ListItems.Add(, , "WindowsDirectory")
itmx.SubItems(1) = obj.WindowsDirectory
Set itmx = ListView1.ListItems.Add(, , "SystemDirectory")
itmx.SubItems(1) = obj.SystemDirectory
Set itmx = ListView1.ListItems.Add(, , "LocalDateTime")
dtb = obj.LocalDateTime
bias = SplitDateTimeBias(dtb, d, t)
itmx.SubItems(1) = Format$(d, "dddd mmm d, yyyy") & " " & _
Format$(t, "hh:mm") & _
" (includes " & bias & " bias)"
Set itmx = ListView1.ListItems.Add(, , "InstallDate")
dtb = obj.InstallDate
bias = SplitDateTimeBias(dtb, d, t)
itmx.SubItems(1) = Format$(d, "dddd mmm d, yyyy") & _
" at " & _
Format$(t, "hh:mm") & _
" (includes " & bias & " bias)"
Set itmx = ListView1.ListItems.Add(, , "LastBootUpTime")
dtb = obj.LastBootUpTime
bias = SplitDateTimeBias(dtb, d, t)
itmx.SubItems(1) = Format$(d, "dddd mmm d, yyyy") & _
" at " & _
Format$(t, "hh:mm") & _
" (includes " & bias & " bias)"
'locale, language and codeset info
Set itmx = ListView1.ListItems.Add(, , "OSLanguage")
itmx.SubItems(1) = obj.OSLanguage
Set itmx = ListView1.ListItems.Add(, , "CodeSet")
itmx.SubItems(1) = obj.CodeSet
Set itmx = ListView1.ListItems.Add(, , "Locale")
itmx.SubItems(1) = obj.Locale
Set itmx = ListView1.ListItems.Add(, , "CountryCode")
itmx.SubItems(1) = obj.CountryCode
Set itmx = ListView1.ListItems.Add(, , "CurrentTimeZone")
itmx.SubItems(1) = obj.CurrentTimeZone
'performance and memory info
Set itmx = ListView1.ListItems.Add(, , "ForegroundApplicationBoost")
Select Case obj.ForegroundApplicationBoost
Case 0: msg = "none"
Case 1: msg = "minimum"
Case 2: msg = "maximum (default)"
End Select
itmx.SubItems(1) = msg
Set itmx = ListView1.ListItems.Add(, , "TotalVisibleMemorySize")
itmx.SubItems(1) = FormatNumber(obj.TotalVisibleMemorySize, 0)
Set itmx = ListView1.ListItems.Add(, , "FreePhysicalMemory")
itmx.SubItems(1) = FormatNumber(obj.FreePhysicalMemory, 0)
Set itmx = ListView1.ListItems.Add(, , "TotalVirtualMemorySize")
itmx.SubItems(1) = FormatNumber(obj.TotalVirtualMemorySize, 0)
Set itmx = ListView1.ListItems.Add(, , "FreeVirtualMemory")
itmx.SubItems(1) = FormatNumber(obj.FreeVirtualMemory, 0)
Set itmx = ListView1.ListItems.Add(, , "FreeSpaceInPagingFiles")
itmx.SubItems(1) = FormatNumber(obj.FreeSpaceInPagingFiles, 0)
Set itmx = ListView1.ListItems.Add(, , "SizeStoredInPagingFiles")
itmx.SubItems(1) = FormatNumber(obj.SizeStoredInPagingFiles, 0)
Next
End Sub