Modules

5.45 API - Ricavare la versione del Sistema Operativo corrente
  Alessandro Baraldi
'------------------------------------------------------------------------------------------
'FUNZIONE PER OTTENERE LA VERSIONE DEL SISTEMA OPERATIVO
'Alessandro Baraldi
'------------------------------------------------------------------------------------------
Option Compare Database
Option Explicit


Public Declare Function GetVersionExA Lib "kernel32" _
               (lpVersionInformation As OSVERSIONINFO) As Integer
 
Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
 
Public Function getVersion() As String

Dim OSInfo As OSVERSIONINFO
Dim retvalue As Integer
 
OSInfo.dwOSVersionInfoSize = 148
OSInfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(OSInfo)
 
 With OSInfo
    Select Case .dwPlatformId
        Case 0
            getVersion = "Windows 3.x"
        Case 1
            Select Case .dwMinorVersion
                Case 0
                    getVersion = "Windows 95"
                Case 10
                    If .dwMajorVersion = 4 Then
                        getVersion = "Windows 98 OSR2"
                    Else
                        getVersion = "Windows 98"
                    End If
                Case 90
                    getVersion = "Windows Millenium"
            End Select
    
        Case 2
            Select Case .dwMajorVersion
                Case 3
                    getVersion = "Windows NT 3.51"
                Case 4
                    getVersion = "Windows NT 4.0"
                Case 5
                    If .dwMinorVersion = 0 Then
                        getVersion = "Windows 2000"
                    Else
                        getVersion = "Windows XP"
                    End If
            End Select
    
        Case Else
            getVersion = "Failed"
    End Select
 End With
End Function

'------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------


Se pensate di avere del materiale freeware interessante e volete pubblicarlo, allora leggete qui.