Información
del equipo
Fecha: 05/Dic/98 (03/Dic/98)
Autor: Roberto Alvarez [email protected]
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
El
código:
' 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