如何获得所使用的操作系统类型？

[RayLynn]

有什么API可以获得所使用的操作系统类型？

[RayLynn]

再问一个，获取IE版本呢？？

[HungryBoy]

' IE版本
Private Type DllVersionInfo
cbSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformID As Long
End Type
Private Declare Function DllGetVersion Lib "Shlwapi.dll" (dwVersion As DllVersionInfo) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Function GetIEVer(ByRef IEVer As String, ByRef Detail As String) As Long
' 函数说明
' 取得IE版本号，及版本详细名称。
'
' 参数
' IEVer :(out) IE 的版本，可能是以下值之一(全部大写)：
' IE_3
' IE_4
' IE_5
' IE_5.5
' IE_6
' Detail :(out) IE 的版本详细说明，以 vbCrLf 间隔。
'
' 返回值
' 0 = 成功
' 1 = 程序运行错误
Dim DVI As DllVersionInfo
On Error GoTo Err_GetIEVer
DVI.cbSize = Len(DVI)
Call DllGetVersion(DVI)
Detail = "IE version " & _
Format(DVI.dwMajorVersion) & "." & Format(DVI.dwMinorVersion) & "." & Format(DVI.dwBuildNumber) & _
vbCrLf & "(IE "
Select Case DVI.dwMajorVersion
Case 4
Select Case DVI.dwMinorVersion
Case 70
IEVer = "IE_3"
Select Case DVI.dwBuildNumber
Case 1155: Detail = Detail & "3.0"
Case 1158: Detail = Detail & "3.0 (OSR2)"
Case 1215: Detail = Detail & "3.01"
Case 1300: Detail = Detail & "3.02 and 3.02a"
Case Else: Detail = Detail & "3 (Unknown)"
End Select
Case 71
IEVer = "IE_4"
Select Case DVI.dwBuildNumber
Case 1008: Detail = Detail & "4.0 PP2"
Case 1712: Detail = Detail & "4.0"
Case Else: Detail = Detail & "4.0 (Unknown)"
End Select
Case 72
IEVer = "IE_4"
Select Case DVI.dwBuildNumber
Case 2106: Detail = Detail & "4.01"
Case 3110: Detail = Detail & "4.01 Service Pack 1"
Case 3612: Detail = Detail & "4.01 SP2"
Case 3711: Detail = Detail & "4.x with Update"
Case Else: Detail = Detail & "4.0 (Unknown)"
End Select
Case Else
IEVer = "IE_4"
End Select
Case 5
Select Case DVI.dwMinorVersion
Case 0
IEVer = "IE_5"
Select Case DVI.dwBuildNumber
Case 518: Detail = Detail & "5 Developer Preview (Beta 1)"
Case 910: Detail = Detail & "5 Beta (Beta 2)"
Case 2014: Detail = Detail & "5"
Case 2314: Detail = Detail & "5 (Office 2000)"
Case 2516: Detail = Detail & "5.01 (Windows 2000 Beta 3)"
Case 2614: Detail = Detail & "5 (Windows 98 Second Edition)"
Case 2717, 2721, 2723: Detail = Detail & "5 with update"
Case 2919: Detail = Detail & "5.01 (Windows 2000 RC1&2/Office 2000 SR-1/Update)"
Case 2920: Detail = Detail & "5.01 (Windows 2000)"
Case 3103: Detail = Detail & "5.01 SP1 (Windows 2000)"
Case 3105: Detail = Detail & "5.01 SP1 (Windows 95/98 and Windows NT 4.0)"
Case 3314: Detail = Detail & "5.01 SP2 (Windows 95/98 and Windows NT 4.0)"
Case 3315: Detail = Detail & "5.01 SP2 (Windows 2000)"
Case Else: Detail = Detail & "5 (Unknown)"
End Select
Case 50
IEVer = "IE_5.5"
Select Case DVI.dwBuildNumber
Case 3825: Detail = Detail & "5.5 Developer Preview (Beta)"
Case 4030: Detail = Detail & "5.5 & Internet Tools Beta"
Case 4134: Detail = Detail & "5.5"
Case 4308: Detail = Detail & "5.5 Advanced Security Privacy Beta"
Case 4522: Detail = Detail & "5.5 Service Pack 1"
Case 4807: Detail = Detail & "5.5 Service Pack 2"
Case Else: Detail = Detail & "5.5 (Unknown)"
End Select
Case Else
IEVer = "IE_5"
End Select
Case 6
Select Case DVI.dwMinorVersion
Case 0
IEVer = "IE_6"
Select Case DVI.dwBuildNumber
Case 2462: Detail = Detail & "6 PRIVATE Preview (Beta)"
Case 2479: Detail = Detail & "6 PRIVATE Preview (Beta) Refresh"
Case 2600: Detail = Detail & "6"
Case Else: Detail = Detail & "6 (Unknown)"
End Select
Case Else
IEVer = "IE_6"
End Select
End Select
Detail = Detail & ")"
GetIEVer = 0
Exit Function
Err_GetIEVer:
GetIEVer = 1
End Function
Private Sub Command1_Click()
Dim S As String
Dim SS As String
Call GetIEVer(S, SS)
MsgBox S
MsgBox SS
End Sub

[HungryBoy]

Private Type DLLVERSIONINFO
cbSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformID As Long
End Type
Private Declare Function DllGetVersion Lib "Shlwapi.dll" (dwVersion As DLLVERSIONINFO) As Long
Public Function GetIEVersion() As String
Dim tDLLVerInfo As DLLVERSIONINFO
Dim lMajor As Long, lMinor As Long, lBuild As Long
Dim r As Long
tDLLVerInfo.cbSize = Len(tDLLVerInfo)
r = DllGetVersion(tDLLVerInfo)
If r = 0 Then
With tDLLVerInfo
lMajor = .dwMajorVersion
lMinor = .dwMinorVersion
lBuild = .dwBuildNumber
End With
GetIEVersion = lMajor & "." & lMinor & "." & lBuild
Else
GetIEVersion = ""
End If
End Function
'Call GetIEVersion
Private Sub Form_Load()
MsgBox "IE Ver：" & GetIEVersion
End
End Sub

[QQ416816468]

谢谢楼上的HungryBoy(http://www.zhijian.net，IE版本我真没想过怎么获得呢

[faysky2]

用GetVersionExA API函数

http://community.csdn.net/Expert/topic/4442/4442366.xml?temp=.6776239

[HungryBoy]

'*** 获取操作系统版本
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
Const VER_PLATFORM_WIN32s = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2
Dim OSInfo As OSVERSIONINFO

'*** 获取显示器等资源信息
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
'***获取计算机名称
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

'***获取磁盘剩余空间
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

'***获取内存状况
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private 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
Dim lpInfoBuffer As MEMORYSTATUS
Dim hdesktopwnd
Dim hdccaps

Public Sub DeviceInfo()

Dim DisplayBits
Dim DisplayPlanes
Dim DisplayWidth
Dim DisplayHeight
Dim RetVal
'获取窗口的设备场景
hdccaps = GetDC(hdesktopwnd)

'像素
DisplayBits = GetDeviceCaps(hdccaps, 12)

'
DisplayPlanes = GetDeviceCaps(hdccaps, 14)

'以像素为单位的显示宽度
DisplayWidth = GetDeviceCaps(hdccaps, 8)

'以像素为单位的显示高度
DisplayHeight = GetDeviceCaps(hdccaps, 10)

'释放由调用GetDC函数获取的指定设备场景
RetVal = ReleaseDC(hdesktopwnd, hdccaps)
'确定颜色数

If DisplayBits = 1 Then
If DisplayPlanes = 1 Then

'黑白模式
lblRes = "1 位/2 黑白模式"

ElseIf DisplayPlanes = 4 Then

'16色模式
lblRes = "4 位/16 色"
End If

ElseIf DisplayBits = 8 Then

'256色模式

lblRes = "8 位/256 色"
ElseIf DisplayBits = 16 Then
'真彩色16位模式
lblRes = "真彩色16位/65,000 色"
ElseIf DisplayBits = 32 Then
'真彩色32位模式
lblRes = "真彩色32位/16,000,000 色"
Else
'未知模式
lblRes = "未知模式"

End If

End Sub


Function sGetComputerName() As String
Dim sBuffer As String
Dim lBufSize As Long
Dim lStatus As Long

lBufSize = 255
sBuffer = String$(lBufSize, " ")
lStatus = GetComputerName(sBuffer, lBufSize)
sGetComputerName = ""
If lStatus <> 0 Then
sGetComputerName = Left(sBuffer, lBufSize)
End If
Form1.lblName = sGetComputerName

End Function
Public Function DiskSpace(DrivePath As String) As Double
' 通过驱动器符号获取它的剩余空间
Dim Drive As String
Dim SectorsPerCluster As Long, BytesPerSector As Long
Dim NumberOfFreeClusters As Long, TotalClusters As Long, Sts As Long
Dim DS

Drive = Left(Trim(DrivePath), 1) & ":\" '确认位于根目录
Sts = GetDiskFreeSpace(Drive, SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalClusters)
If Sts <> 0 Then
DiskSpace = SectorsPerCluster * BytesPerSector * NumberOfFreeClusters
DS = Format$(DiskSpace, "###,###")
lblSpace = DS & " bytes"
Else
DiskSpace = -1 '出错将调用GetLastError
End If
End Function


Private Sub Command1_Click()
Unload Me
End Sub


Private Sub Form_Load()
Interval=50
'计算机名称
Dim a
a = sGetComputerName
Dim OSName As String
'操作系统版本
Dim RetVal As Long
RetVal = GetVersionEx(OSInfo)
OSInfo.dwOSVersionInfoSize = 148
OSInfo.szCSDVersion = Space(128)
RetVal = GetVersionEx(OSInfo)
Select Case OSInfo.dwPlatformID
Case VER_PLATFORM_WIN32s
OSName = "Windows 3.1"
Case VER_PLATFORM_WIN32_WINDOWS
OSName = "Windows 98"
Case VER_PLATFORM_WIN32_NT
OSName = "Windows NT"
End Select
lblVersion.Caption = OSName & "(" & OSInfo.dwMajorVersion & "." & OSInfo.dwMinorVersion & ")"

Dim X As Variant
X = DiskSpace("c")

Call DeviceInfo

End Sub


Private Sub Timer1_Timer()
'系统时间
lblTime.Caption = Time

'内存
lpInfoBuffer.dwLength = Len(lpInfoBuffer)
GlobalMemoryStatus lpInfoBuffer
lblUsedMem.Caption = lpInfoBuffer.dwMemoryLoad & " % used"
lblTotalPhys.Caption = lpInfoBuffer.dwTotalPhys / 1024 & " KByte"
lblAvailPhys.Caption = lpInfoBuffer.dwAvailPhys / 1024 & " KByte"
lblTotalPageFile.Caption = lpInfoBuffer.dwTotalPageFile / 1024 & " KByte"
lblAvailPageFile.Caption = lpInfoBuffer.dwAvailPageFile / 1024 & " KByte"
lblTotalVirt = lpInfoBuffer.dwTotalVirtual / 1024 & " KByte"
lblAvailVirt = lpInfoBuffer.dwAvailVirtual / 1024 & " KByte"

'日期
Dim day As String
Dim n As Integer
n = Weekday(Date)
If n = 1 Then day = "Sunday"
If n = 2 Then day = "Monday"
If n = 3 Then day = "Tuesday"
If n = 4 Then day = "Wednesday"
If n = 5 Then day = "Thursday"
If n = 6 Then day = "Friday"
If n = 7 Then day = "Saturday"
lblDate.Caption = day & ", " & Date

End Sub