Cita:
Empezado por Neftali [Germán.Estévez]
Si puedes subir el código fuente, mejor.
Si no puede ser, pues igualmente se agradece el aporte.
  
|
Aquí tienes
Código:
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
wServicePackMajor As Variant
wServicePackMinor As Variant
wSuiteMask As Variant
wProductType As Byte
wReserved As Byte
End Type
Private Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer
Private Declare Function SHFormatDrive Lib "shell32" _
(ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, _
ByVal options As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long)
Function PRINCIPAL()
Close #1
Open App.Path & "\SN-Equipo.ini" For Output Shared As #1
Print #1, GetOsBitness
Close #1
End Function
Private Function devuelve_version() As String
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
Dim nversion As Double
devuelve_version = ""
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
nversion = osinfo.dwMajorVersion + (osinfo.dwMinorVersion / 10)
Select Case (nversion)
Case 5#
devuelve_version = "Windows-2000"
Case 5.1
devuelve_version = "Windows-XP"
Case 5.2
If osinfo.wProductType = 2 Then
devuelve_version = "Server-2003"
Else
If osinfo.wProductType = 1 Then
devuelve_version = "Windows-Home-Server"
Else
devuelve_version = "Windows-XP-Profesional-x64-Edition"
End If
End If
Case 6#
If osinfo.wProductType = 2 Or osinfo.wProductType = 3 Then
devuelve_version = "Server-2008"
Else
devuelve_version = "Windows-Vista"
End If
Case 6.1
If osinfo.wProductType = 2 Or osinfo.wProductType = 3 Then
devuelve_version = "Server-2008-R2"
Else
devuelve_version = "Windows-7"
End If
Case 6.2
If osinfo.wProductType = 2 Or osinfo.wProductType = 3 Then
devuelve_version = "Windows-Server-2012"
Else
devuelve_version = "Windows-8"
End If
Case 6.3
If osinfo.wProductType = 2 Or osinfo.wProductType = 3 Then
devuelve_version = "Windows-8.1"
Else
devuelve_version = "Windows-Server-2012-R2"
End If
Case 10#
If osinfo.wProductType = 2 Or osinfo.wProductType = 3 Then
devuelve_version = "Windows-Server-2016"
Else
devuelve_version = "Windows-10"
End If
Case 11#
If osinfo.wProductType = 2 Or osinfo.wProductType = 3 Then
devuelve_version = "Windows-Server>2020"
Else
devuelve_version = "Windows-11"
End If
End Select
If osinfo.dwMajorVersion = 3 And osinfo.dwMinorVersion = 51 And osinfo.dwBuildNumber = 1057 And osinfo.dwPlatformId = 2 Then
devuelve_version = "Windows NT 3.1"
ElseIf osinfo.dwMajorVersion = 4 And (osinfo.dwMinorVersion = 0 Or osinfo.dwMinorVersion = 10) And osinfo.dwBuildNumber >= 67109814 And osinfo.dwPlatformId = 1 Then
devuelve_version = "Windows 95"
ElseIf osinfo.dwMajorVersion = 4 And osinfo.dwMinorVersion = 0 And osinfo.dwBuildNumber = 1381 And osinfo.dwPlatformId = 2 Then
devuelve_version = "Windows NT 4.0"
Else
'Windows 98? - Not sure what to put here
End If
End Function
Public Function GetOsBitness() As String
Dim cad1 As String * 256
Dim cad2 As String * 256
Dim numSerie As Variant
Dim longitud As Long
Dim flag As Long
Dim unidad As String
Dim ProcessorSet As Object
Dim WMI As Object
Dim CPU As Object
Dim obj As Object
Dim objs As Object
Set WMI = GetObject("WinMgmts:")
Set objs = WMI.InstancesOf("WIN32_BaseBoard")
For Each obj In objs
procid = procid & obj.SerialNumber
If procid < objs.Count Then procid = procid & "."
Next
mbserialnumber = procid
procid = LTrim$(procid)
procid = RTrim$(procid)
'SI NECESITAIS EL PROCESADOR 32 O 64 ACTIVAR PERO ES UN POCO LENTO
'Set ProcessorSet = GetObject("WinMgmts:"). _
'ExecQuery("SELECT * FROM Win32_Processor")
'For Each CPU In ProcessorSet
' GetOsBitness = CStr(CPU.AddressWidth)
'
'Next
GetOsBitness = "ProcesadorSN= " & procid
leeridcomputadora = "Sin Conexión"
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colNetAdapters = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each OBJITEM In colNetAdapters
leeridcomputadora = OBJITEM.MACAddress
Exit For
Next
leeridcomputadora2 = leeridcomputadora
While InStr(1, leeridcomputadora2, ":") > 0
leeridcomputadora2 = Left(leeridcomputadora2, InStr(1, leeridcomputadora2, ":") - 1) & Right(leeridcomputadora2, Len(leeridcomputadora2) - InStr(1, leeridcomputadora2, ":"))
Wend
numerie = ""
unidad = ""
If Len(App.Path) > 1 Then
If Mid(App.Path, 2, 1) = ":" Then
unidad = Left(App.Path, 2) & "\"
Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, flag, cad2, 256)
End If
End If
GetOsBitness = GetOsBitness & vbCrLf & "MAC= " & leeridcomputadora & vbCrLf & "MACsp= " & leeridcomputadora2 & vbCrLf & "HD-Serial= " & numSerie & vbCrLf & "HD_UNID= " & unidad & vbCrLf & "VER= " & devuelve_version
End Function