Newsgroup: it.comp.appl.access
Titolo: Recuperare la versione di Windows  (win 10)

Attualmente utilizzo questo codice  opportunamente modificato per riconoscere Win7 e Win 8
' ******** Code Start ********
 'This code was originally written by Dev Ashish.
 'It is not to be altered or distributed,
 'except as part of an application.
 'You are free to use it in any application,
 'provided the copyright notice is left unchanged.
 '
 'Code Courtesy of
 'Dev Ashish
 '  
 
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 Declare Function apiGetVersionEx Lib "kernel32" _
    Alias "GetVersionExA" _
    (lpVersionInformation As Any) _
    As Long
 
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
 
Function fOSName() As String
    Dim osvi As OSVERSIONINFO
    Dim strOut As String
10    osvi.dwOSVersionInfoSize = Len(osvi)
20    If CBool(apiGetVersionEx(osvi)) Then
30      With osvi
            ' Vista
40          If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
               .dwMajorVersion = 6 And _
               .dwMinorVersion = 0 Then
50              strOut = "Windows  Vista (Version " & _
                         .dwMajorVersion & "." & .dwMinorVersion & _
                         ") Build " & .dwBuildNumber
60              If (Len(.szCSDVersion)) Then
70                  strOut = strOut & " (" & _
                             fTrimNull(.szCSDVersion) & ")"
80              End If
90          End If
            'Windows 7
100         If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
               .dwMajorVersion = 6 And _
               .dwMinorVersion = 1 Then
110             strOut = "Windows 7 (Version " & _
                         .dwMajorVersion & "." & .dwMinorVersion & _
                         ") Build " & .dwBuildNumber
120             If (Len(.szCSDVersion)) Then
130                 strOut = strOut & " (" & _
                             fTrimNull(.szCSDVersion) & ")"
140             End If
150         End If
 
            'Windows 8
160         If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
               .dwMajorVersion = 6 And _
               .dwMinorVersion = 2 Then
170             strOut = "Windows 8 (Version " & _
                         .dwMajorVersion & "." & .dwMinorVersion & _
                         ") Build " & .dwBuildNumber
180             If (Len(.szCSDVersion)) Then
190                 strOut = strOut & " (" & _
                             fTrimNull(.szCSDVersion) & ")"
200             End If
210         End If
 
 
            ' XP
220         If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
               .dwMajorVersion = 5 And _
               .dwMinorVersion = 1 Then
230             strOut = "Windows XP (Version " & _
                         .dwMajorVersion & "." & .dwMinorVersion & _
                         ") Build " & .dwBuildNumber
240             If (Len(.szCSDVersion)) Then
250                 strOut = strOut & " (" & _
                             fTrimNull(.szCSDVersion) & ")"
260             End If
270         End If
            ' .Net Server
280         If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
               .dwMajorVersion = 5 And _
               .dwMinorVersion = 2 Then
290             strOut = "Windows .NET Server (Version " & _
                         .dwMajorVersion & "." & .dwMinorVersion & _
                         ") Build " & .dwBuildNumber
300             If (Len(.szCSDVersion)) Then
310                 strOut = strOut & " (" & _
                             fTrimNull(.szCSDVersion) & ")"
320             End If
330         End If
            ' Win 2000
340         If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
               .dwMajorVersion = 5 Then
350             strOut = "Windows 2000 (Version " & _
                         .dwMajorVersion & "." & .dwMinorVersion & _
                         ") Build " & .dwBuildNumber
360             If (Len(.szCSDVersion)) Then
370                 strOut = strOut & " (" & _
                             fTrimNull(.szCSDVersion) & ")"
380             End If
390         End If
 
            ' Win ME
400         If (.dwMajorVersion = 4 And _
                (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
                 .dwMinorVersion = 90)) Then
410             strOut = "Windows Millenium"
420         End If
            ' Win 98
430         If (.dwMajorVersion = 4 And _
                (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
                 .dwMinorVersion = 10)) Then
440             strOut = "Windows 98"
450         End If
            ' Win 95
460         If (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
                .dwMinorVersion = 0) Then
470             strOut = "Windows 95"
480         End If
            ' Win NT
490         If (.dwPlatformId = VER_PLATFORM_WIN32_NT And _
                .dwMajorVersion <= 4) Then
500             strOut = "Windows NT " & _
                         .dwMajorVersion & "." & .dwMinorVersion & _
                       " Build " & .dwBuildNumber
510             If (Len(.szCSDVersion)) Then
520                 strOut = strOut & " (" & _
                             fTrimNull(.szCSDVersion) & ")"
530             End If
540         End If
550     End With
560   End If
570   fOSName = strOut
End Function
 
Private Function fTrimNull(strIn As String) As String
Dim intPos As Integer
    intPos = InStr(1, strIn, vbNullChar)
    If intPos Then
        fTrimNull = Mid$(strIn, 1, intPos - 1)
    Else
        fTrimNull = strIn
    End If
End Function
'   ********** Code End **********
 
Con Windows 10  mi restituisce
 
? fosname
Windows 8 (Version 6.2) Build 9200 ()
 
C'è qualche sistema per recuperare  la Versione se gira sotto WIN 10 ?

 C'è qualche sistema per recuperare  la Versione se gira sotto WIN 10 ?
 
Private Sub Command21_Click()
  Dim X
  X = CreateObject("WScript.Shell").Exec("cmd ver").StdOut.ReadLine
  MsgBox X
End Sub
 
Bruno

Vedi se questa funziona...
 
Function OpSystem() As String
 
    Dim objs            As Object
    Dim obj             As Object
 
    Dim strOS
 
    Set objs = GetObject("Winmgmts:").ExecQuery("SELECT * FROM Win32_OperatingSystem")
    For Each obj In objs
        strOS = strOS & obj.Caption & vbNewLine
        strOS = strOS & "Version " & obj.Version & " SP " & obj.ServicePackMajorVersion & "." & obj.ServicePackMinorVersion & vbNewLine
    Next
    Set objs = Nothing
    ' Get 32- versus 64-bit.
 
    Set objs = GetObject("Winmgmts:").ExecQuery("SELECT * FROM Win32_Processor")
    For Each obj In objs
        strOS = strOS & obj.AddressWidth & "-bit" & vbNewLine
    Next
    Set objs = Nothing
 
    OpSystem = strOS
End Function
 
 
@Alex


Perfetto Grazie
 
restituisce
? OpSystem
Microsoft Windows 10 Home
Version 10.0.10586 SP 0.0
64-bit