| Windowsのバージョン情報を取得する |
| Windowsのバージョン情報を取得する |
| Windowsのバージョン情報を取得する （127） | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Option Explicit 'SampleNo=127 WindowsXP VB6.0(SP5) 2002.03.30 'OSのバージョン番号を取得する（P923) 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 'プラットフォームのID szCSDVersion As String * 128 'OSに関する付加情報 End Type '引数が違うので別名で定義 Private Declare Function GetVersionExEX Lib "kernel32" Alias _ "GetVersionExA" (lpVersionInformation As OSVERSIONINFOEX) As Long Private Type OSVERSIONINFOEX dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 wServicePackMajor As Integer wServicePackMinor As Integer wSuiteMask As Integer wProductType As Byte wReserved As Byte End Type Private Const VER_NT_WORKSTATION = &H1& Private Const VER_NT_SERVER = &H3 Private Const VER_SERVER_NT = &H80000000 Private Const VER_WORKSTATION_NT = &H40000000 Private Const VER_SUITE_SMALLBUSINESS = &H1 Private Const VER_SUITE_ENTERPRISE = &H2 Private Const VER_SUITE_BACKOFFICE = &H4 Private Const VER_SUITE_COMMUNICATIONS = &H8 Private Const VER_SUITE_TERMINAL = &H10 Private Const VER_SUITE_SMALLBUSINESS_RESTRICTED = &H20 Private Const VER_SUITE_EMBEDDEDNT = &H40 Private Const VER_SUITE_DATACENTER = &H80 Private Const VER_SUITE_SINGLEUSERTS = &H100 Private Const VER_SUITE_PERSONAL = &H200 Private Const VER_SUITE_BLADE = &H400 Private Const VER_PLATFORM_WIN32s = 0& 'WINDOWS3.1 Private Const VER_PLATFORM_WIN32_WINDOWS = 1& 'WINDOWS9x Private Const VER_PLATFORM_WIN32_NT = 2& 'WINDOWSNT,2000 XP Private Sub Command1_Click() Dim lngResult As Long Dim lpVerInfo As OSVERSIONINFO Dim strOSType As String Dim MajoVer As Long Dim MinoVer As Long Dim PlatformId As Long Dim CSDVer As String Dim strWorkst As String Label1.AutoSize = True Label1.Caption = "" lpVerInfo.dwOSVersionInfoSize = Len(lpVerInfo) lngResult = GetVersionEx(lpVerInfo) If lngResult = 0 Then Exit Sub 'lpVerInfo で Version を取得 With lpVerInfo MajoVer = CStr(.dwMajorVersion) MinoVer = CStr(.dwMinorVersion) CSDVer = fNullCut(.szCSDVersion) PlatformId = .dwPlatformId End With 'Windows2000 以上と以下で処理を分岐 Select Case MajoVer Case 3 strOSType = "Windows NT 3.51" Case 4 Select Case MinoVer Case 0 If CSDVer = "C" Then strOSType = "Windows 95 OSR2" ElseIf PlatformId = VER_PLATFORM_WIN32_NT Then strOSType = "Windows NT 4.0" Else strOSType = "Windows 95" End If Case 10 If CSDVer = "A" Then strOSType = "Windows 98 SE" Else strOSType = "Windows 98" End If Case 90 strOSType = "Windows Me" Case Else Label1.Caption = "Windows ??" End Select With lpVerInfo Label1.Caption = "OSType : " & strOSType _ & vbLf & "Major Version : " & CStr(.dwMajorVersion) _ & vbLf & "Minor Version : " & CStr(.dwMinorVersion) _ & vbLf & "Build Number : " & CStr(fLoWord(.dwBuildNumber)) _ & vbLf & "Platform ID : " & CStr(.dwPlatformId) _ & vbLf & "CSD Version : " & fNullCut(.szCSDVersion) End With 'Windows2000 以上の場合 lpVerInfoEX で再取得 Case 5 Dim lpVerInfoEX As OSVERSIONINFOEX Dim ProductType As Byte Dim SuiteMask As Integer lpVerInfoEX.dwOSVersionInfoSize = Len(lpVerInfoEX) lngResult = GetVersionExEX(lpVerInfoEX) If lngResult = 0 Then Exit Sub With lpVerInfoEX MajoVer = CStr(.dwMajorVersion) MinoVer = CStr(.dwMinorVersion) CSDVer = fNullCut(.szCSDVersion) ProductType = .wProductType SuiteMask = .wSuiteMask End With Select Case MinoVer Case 0 strOSType = "Windows 2000" '詳しくは下記同様で取得して下さい。 Case 1 'Workstation かどうかを取得 If ProductType = VER_NT_WORKSTATION Then strWorkst = "Workstation" ElseIf ProductType = VER_NT_SERVER Then strWorkst = "Server" End If 'wSuiteMask に VER_SUITE_PERSONAL がたっているかを調査 '調査方法はK.J.K.さんに教えて頂きました 02.03.28 投稿分 If (0& <> (VER_SUITE_PERSONAL And _ fLoWord(CLng(SuiteMask)))) Then strOSType = "Windows XP Home Edition" Else strOSType = "Windows XP Professional Edition" End If Case Else Label1.Caption = "Windows ??" End Select With lpVerInfoEX Label1.Caption = "OSType : " & strOSType _ & vbLf & "Major Version : " & CStr(.dwMajorVersion) _ & vbLf & "Minor Version : " & CStr(.dwMinorVersion) _ & vbLf & "Build Number : " & CStr(fLoWord(.dwBuildNumber)) _ & vbLf & "Platform ID : " & CStr(.dwPlatformId) _ & vbLf & "CSD Version : " & fNullCut(.szCSDVersion) _ & vbLf & "ServicePackMajor : " & CStr(.wServicePackMajor) _ & vbLf & "ServicePackMinor : " & CStr(.wServicePackMinor) _ & vbLf & "SuiteMask : " & CStr(.wSuiteMask) _ & vbLf & "ProductType : " & CStr(.wProductType) _ & vbLf & "Workstation or : " & strWorkst _ & vbLf & "Reserved : " & CStr(.wReserved) End With Case Else Label1.Caption = "Windows ??" End Select End Sub Private Function fLoWord(ByVal dwValue As Long) As Long '引数の下位16ビットを返す fLoWord = (dwValue And &HFFFF&) End Function Private Function fNullCut(ByVal myString As String) As String '文字列中の NullChar 及び前後の空白を取除く Dim i As Long i = InStr(myString, vbNullChar) If i > 0& Then fNullCut = Trim$(Left$(myString, i - 1&)) Else fNullCut = Trim$(myString) End If End Function 実行画面  |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
判別方法
その他の判別方法 wProductType = VER_NT_WORKSTATION は Workstation wProductType = VER_NT_SERVER は Serverエディション XPの場合、WorkstationでwSuiteMaskにVER_SUITE_PERSONALがたっていればXPの Home Edition、それ以外であれば、Professional Editionであると分かります。 又、BuildNumber で詳しく判別する方法やNT系のOSのサービスパック情報は szCSDVersionで得られます。 又、dwBuildNumberメンバーの下位ワードが1000より小さければWin95OSR2以前のバージョン。 Windows 2000 には "VerifyVersionInfo" という新しい API が追加されていますのそちらで取得 する方法等もあるようです。 上記、判別方法は、必ずしも正しいとは限りませんので、詳しくは各自確認願います。 又、確認された結果等は教えて頂けるとありがたいのですが！ 下記、機種では確認済み
簡便方法として下記のような方法もあります。 Private Sub Command2_Click() Label2.AutoSize = True Label2.Caption = "" With CreateObject("SysInfo.SYSINFO") Label2.Caption = "OSPlatform : " & .OSPlatform _ & vbLf & "OSBuild : " & .OSBuild _ & vbLf & "OSVersion : " & .OSVersion End With End Sub
但し、上記の場合配布等する場合配布先にMicrosoft SysInfo Control 6.0 (SysInfo.ocx) コントロールが入っている必要があります。通常のランタイムには含まれていない為に、配布される場合は、事前にFormにMicrosoft SysInfo Control コントロールを貼り付けて使用するようにして一緒に配布して下さい。 Private Sub Command1_Click() With SysInfo1 Debug.Print .OSPlatform Debug.Print .OSBuild Debug.Print .OSVersion End With End Sub |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
2005/2/24