Option Compare Database
Option Explicit

'Dati sistema operativo
Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type

'Dati utente (WinNT/2000)
Type WKSTA_USER_INFO_1
   wkui1_username As Long
   wkui1_logon_domain As Long
   wkui1_logon_server As Long
   wkui1_oth_domains As Long
End Type

'Rileva la versione del sistema operativo e memorizza i dati in OSVERSIONINFO
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
   (LpVersionInformation As OSVERSIONINFO) As Long

'rileva l'utente corrente (Win9x)
Declare Function WNetGetUser& Lib "Mpr" Alias "WNetGetUserA" _
   (lpName As Any, ByVal lpUserName$, lpnLength&)

'rileva le informazioni di logon correnti e le memorizza in WKSTA_USER_INFO_1
Declare Function NetWkstaUserGetInfo& Lib "Netapi32" _
   (reserved As Any, ByVal lLevel&, pbBuffer As Any) 'rileva i dati

'funzioni per il trattamento dei dati restituiti dalle altre funzioni
Declare Sub lstrcpyW Lib "kernel32" (dest As Any, ByVal Src As Any)
Declare Sub RtlMoveMemory Lib "kernel32" _
   (dest As Any, Src As Any, ByVal size&)
Declare Function NetApiBufferFree& Lib "Netapi32" (ByVal buffer&)

Function Utente(ByVal OS As Long, Optional ByVal bDomain As Boolean = False) As String
'lOS: versione del sistema operativo (1 per Win9x/ME; 2 per WinNT/2000)
'bDomain: restituisce anche il dominio (solo per WinNT)

Dim ret As Long, buffer(512) As Byte, i As Integer
Dim pwk101 As Long
Dim wk1 As WKSTA_USER_INFO_1
Dim pwk1 As Long
Dim cbusername As Long
Dim UserName As String
Dim computername As String, langroup As String, logondomain As String

   If OS = 1 Then
      UserName = Space$(256)
      ret = WNetGetUser(Null, UserName, Len(UserName))
      If ret = 0 Then
         UserName = Left(UserName, InStr(1, UserName, Chr(0)) - 1)
      Else
         UserName = "0"
      End If
   End If

   If OS = 2 Then
      ret = NetWkstaUserGetInfo(ByVal 0&, 1, pwk1)
      If ret = 0 Then
         RtlMoveMemory wk1, ByVal pwk1, Len(wk1)
         lstrcpyW buffer(0), wk1.wkui1_logon_domain
         If bDomain Then
            i = 0
            Do While buffer(i) <> 0
               UserName = UserName & Chr(buffer(i))
               i = i + 2
            Loop
            UserName = UserName & "\"
         End If
         lstrcpyW buffer(0), wk1.wkui1_username
         i = 0
         Do While buffer(i) <> 0
            UserName = UserName & Chr(buffer(i))
            i = i + 2
         Loop
         ret = NetApiBufferFree(pwk1)
      Else
         UserName = "0"
      End If
   End If
   Utente = LCase(UserName)
End Function

Public Function OsVer(Optional ByRef sVersion As String = "") As Long
'Rileva la versione del sistema operativo
'Se passata, nella variabile sVersion viene memorizzata la stringa 
corrispondente al S.O.
'Restituisce 0 se Win32s (Win3.xx)
' 1 se Win9x/ME
' 2 se WinNT/2000

Dim VerInfo As OSVERSIONINFO
Dim ver_major, ver_minor, build As String
Dim ret As Long

   VerInfo.dwOSVersionInfoSize = Len(VerInfo)
   ret = GetVersionEx(VerInfo)
   If ret = 0 Then
      MsgBox "Error Getting Version Information"
   Else
      Select Case VerInfo.dwPlatformId
         Case 0: sVersion = sVersion + "Windows 32s "
         Case 1: sVersion = sVersion + "Windows 95 "
         Case 2: sVersion = sVersion + "Windows NT "
      End Select
      sVersion = sVersion & VerInfo.dwMajorVersion & "." & 
      VerInfo.dwMinorVersion & " (Build " & VerInfo.dwBuildNumber & ")"
      OsVer = VerInfo.dwPlatformId
   End If
End Function

Public Function RilevaDati()
   Dim nVersioneSO As Long 'versione S.O. (numerico)
   Dim sVersioneSO As String 'versione S.O. (stringa)
   Dim sUtente As String 'utente corrente
   Dim sDominioeUtente As String 'dominio e utente correnti

   nVersioneSO = OsVer(sVersioneSO)
   sUtente = Utente(nVersioneSO)
   sDominioeUtente = Utente(nVersioneSO, True)

   MsgBox "Versione S.O. (numerico): " & nVersioneSO & vbCrLf & _
         "Versione S.O. (stringa): " & sVersioneSO & vbCrLf & _
         "Utente corrente: " & sUtente & vbCrLf & _
         "Dominio e utente correnti: " & sDominioeUtente, , "Rilevazione dati utente - by Pepin"
End Function