FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
|
#1
|
||||
|
||||
Si puedes subir el código fuente, mejor.
Si no puede ser, pues igualmente se agradece el aporte.
__________________
Germán Estévez => Web/Blog Guía de estilo, Guía alternativa Utiliza TAG's en tus mensajes. Contactar con el Clubdelphi P.D: Más tiempo dedicado a la pregunta=Mejores respuestas. |
#2
|
|||
|
|||
Cita:
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 |
#3
|
||||
|
||||
Gracias. He actualizado el hilo de los recursos. Para añadir link al código, al ejecutable y también he puesto la DLL (MSVBVM50.DLL) necesaria para los que no la tienen de VB.
__________________
Germán Estévez => Web/Blog Guía de estilo, Guía alternativa Utiliza TAG's en tus mensajes. Contactar con el Clubdelphi P.D: Más tiempo dedicado a la pregunta=Mejores respuestas. |
#4
|
|||
|
|||
Cita:
|
#5
|
|||
|
|||
pues no me deja, 624Kb
|
|
|
Temas Similares | ||||
Tema | Autor | Foro | Respuestas | Último mensaje |
SII -Nuevo sistema de la Agencia Tributaria española de envío de datos vía Webservice | newtron | Internet | 3557 | Hace 2 Semanas 17:42:47 |
Como utilizar la ayuda del nuevo Sistema Operativo | gluglu | Humor | 3 | 24-09-2007 09:39:05 |
Aplicacion Agencia De Viajes | ArdiIIa | Varios | 9 | 20-01-2007 16:49:53 |
El Vasco Aguirre | Al González | La Taberna | 5 | 26-05-2006 09:22:28 |
Microsoft ha lanzado su nuevo sistema operativo | DarkByte | Humor | 0 | 25-01-2004 09:21:14 |
|