Información del equipo

Fecha: 05/Dic/98 (03/Dic/98)
Autor: Roberto Alvarez roberto@aldeasa.es

Hola Guille, en primer lugar felicitarte por la página.
Como me sentía muy mal sacando información y no aportando nada a cambio, a continuación te envío un programa que genera un fichero de información acerca del equipo en el que se ejecute. El fichero tiene como nombre el Computer Name del equipo y además de este se incluyen datos como, el usuario con el que se ha iniciado la sesión, las unidades disponibles y su capacidad, el total de memoria RAM, etc...
En mi opinión, este programa puede ser útil para aquellas personas que estén realizando un inventario de los PC de los que disponen en su empresa (Se puede incluir su ejecución en el script de inicio de sesión, para que se genere cada vez que se inicie una sesión en la red y dejar los resultados en un servidor).
A continuación te envío el código fuente y adjunto un fichero de ejemplo, para que veas como queda.

Gracias y hasta pronto.

PD: Si alguien quiere mejorar el programa o añadir funcionalidad y adelante que nos lo cuente a todos.

El fichero con el resultado de la información:

Nombre del equipo:   ROBERTO ALVAREZ
Usuario actual:      Roberto 

--- Información del equipo ---
Espacio total en unidad C : 2047
Espacio libre en unidad C : 121
Espacio total en unidad D : 968
Espacio libre en unidad D : 968
Dispone de CDRom en la unidad E
Memoria Ram:          32188
Tipo de procesador:   586

--- Sistema Operativo ---
Versión:             4
CSDVersion:          B                                                                                                                              
Número fabricante:   67109975
ID de plataforma:    1

'
Attribute VB_Name = "Module1"
Option Explicit

Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long


Type MEMORYSTATUS
        dwLength As Long
        dwMemoryLoad As Long
        dwTotalPhys As Long
        dwAvailPhys As Long
        dwTotalPageFile As Long
        dwAvailPageFile As Long
        dwTotalVirtual As Long
        dwAvailVirtual As Long
End Type


Type SYSTEM_INFO
        dwOemID As Long
        dwPageSize As Long
        lpMinimumApplicationAddress As Long
        lpMaximumApplicationAddress As Long
        dwActiveProcessorMask As Long
        dwNumberOrfProcessors As Long
        dwProcessorType As Long
        dwAllocationGranularity As Long
        dwReserved As Long
End Type


Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128      '  Cadena de mantenimiento para uso de PSS
End Type


Public Sub Main()
    Dim ComputerName As String
    Dim Usuario As String
    Dim Tamaño As Long
    Dim Version As OSVERSIONINFO
    Dim SystemInfo As SYSTEM_INFO
    Dim Memoria As MEMORYSTATUS
    Dim Unidad(1 To 10) As String
    Dim Sectores As Long
    Dim Cluster As Long
    Dim Bytes As Long
    Dim ClusterLibres As Long
    Dim ClusterTotal As Long
    Dim EspacioLibre As Integer
    Dim EspacioTotal As Long
    Dim Mbytes As Integer
    Dim Fichero As String
    Dim Resultado As Long
    Dim TipoUnidad As Long
    Dim Ind As Integer
    
        
    'Unidades sobre las que se obtiene información
    Unidad(1) = "C:\"
    Unidad(2) = "D:\"
    Unidad(3) = "E:\"
    Unidad(4) = "F:\"
    Unidad(5) = "G:\"
    Unidad(6) = "H:\"
    Unidad(7) = "I:\"
    Unidad(8) = "J:\"
    Unidad(9) = "K:\"
    Unidad(10) = "L:\"
    Mbytes = 1024
    
    
    'Memoria
    Call GlobalMemoryStatus(Memoria)
    
    'Versión del Sistema Operativo
    Version.szCSDVersion = Space$(260)
    Tamaño = Len(Version)
    Version.dwOSVersionInfoSize = Tamaño
    Call GetVersionEx(Version)
    
    'Información del equipo
    Call GetSystemInfo(SystemInfo)
    
    'Usuario
    Usuario = Space$(260)
    Tamaño = Len(Usuario)
    Call GetUserName(Usuario, Tamaño)
    Usuario = Left$(Usuario, Tamaño)
    
    'Computer Name
    ComputerName = Space$(260)
    Tamaño = Len(ComputerName)
    Call GetComputerName(ComputerName, Tamaño)
    ComputerName = Left$(ComputerName, Tamaño)
    
    'Guardar la información en disco
    Fichero = ComputerName & ".txt"
    Open Fichero For Output As #1
    
    Print #1, "Nombre del equipo:   " & ComputerName
    Print #1, "Usuario actual:      " & Usuario
    Print #1, ""
    Print #1, "--- Información del equipo ---"
    For Ind = 1 To 10
        TipoUnidad = GetDriveType(Unidad(Ind))
        If TipoUnidad = 3 Then
            Call GetDiskFreeSpace(Unidad(Ind), Sectores, Bytes, ClusterLibres, ClusterTotal)
            EspacioLibre = (Sectores * Bytes * ClusterLibres) / Mbytes / Mbytes
            EspacioTotal = (Sectores * Bytes * ClusterTotal) / Mbytes / Mbytes
            Print #1, "Espacio total en unidad " & Left(Unidad(Ind), 1) & " : " & EspacioTotal
            Print #1, "Espacio libre en unidad " & Left(Unidad(Ind), 1) & " : " & EspacioLibre
        Else
            If TipoUnidad = 5 Then
                Print #1, "Dispone de CDRom en la unidad " & Left(Unidad(Ind), 1)
            End If
        End If
    Next
    Print #1, "Memoria Ram:          " & (Memoria.dwTotalPhys / 1024)
    Print #1, "Tipo de procesador:   " & SystemInfo.dwProcessorType
    Print #1, ""
    Print #1, "--- Sistema Operativo ---"
    Print #1, "Versión:             " & Version.dwMajorVersion
    Print #1, "CSDVersion:         " & Version.szCSDVersion
    Print #1, "Número fabricante:   " & Version.dwBuildNumber
    Print #1, "ID de plataforma:    " & Version.dwPlatformId
    
    Close #1

End Sub