如何在VB中得到当前操作系统的信息。

Question

如操作系统的版本（WINDOWS98/2000/XP）？
操作系统所在的目录？
当前的用户名？

Answer 1

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 Sub２．获得系统目录信息(得到的系统目录比如是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

Answer 2

引用： 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
  
   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
    
   

Answer 3

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
顺便纠正２中的　　GetCurrentDirectory sSave,255　好象写反了。　应该是 255,sSave

Answer 4

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
   
   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--'

Answer 5

如果你对注册表熟悉的话，直接去访问注册表比较快！而且可以避免DLL：一个字：烦！

Answer 6

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

Answer 7

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
   
   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

Answer 8

那如果在WIN2000下如何确定用户的“DOCUMENT AND SETTINGS”的目录位置呢？