'Recopilación de múltiples ejemplos sobre el manejo de información.
'Recopilado y modificado por WHK.
Option Explicit
Private m_os As OSVERSIONINFO
Private m_NT As Boolean
Private m_95 As Boolean
Private m_98 As Boolean
Private Sub Class_Initialize()
Dim nNull As Long
m_os.dwOSVersionInfoSize = Len(m_os)
Call GetVersionEx(m_os)
nNull = InStr(m_os.szCSDVersion, vbNullChar)
If nNull > 1 Then
m_os.szCSDVersion = Left(m_os.szCSDVersion, nNull - 1)
ElseIf nNull = 1 Then
m_os.szCSDVersion = ""
End If
Select Case m_os.dwPlatformId
Case VER_PLATFORM_WIN32_WINDOWS
If m_os.dwMinorVersion >= 10 Then
m_95 = False
m_98 = True
Else
m_95 = True
m_98 = False
End If
m_NT = False
Case VER_PLATFORM_WIN32_NT
m_95 = False
m_98 = False
m_NT = True
End Select
End Sub
Public Property Get PlatformID() As Long
PlatformID = m_os.dwPlatformId
End Property
Public Property Get Platform() As String
If m_95 Then
Platform = "Windows 95"
ElseIf m_98 Then
Platform = "Windows 98"
ElseIf m_NT Then
Platform = "Windows NT"
Else
Platform = "Desconocido"
End If
End Property
Public Property Get Version() As String
Version = Platform & " v" & m_os.dwMajorVersion & "." & m_os.dwMinorVersion & ", Build " & WordLo(m_os.dwBuildNumber)
End Property
Public Property Get CSDVersion() As String
CSDVersion = Trim(m_os.szCSDVersion)
End Property
Public Property Get ComputerName() As String
Dim X As Integer
Dim Y As String
Y = String(255, " ")
X = GetComputerName(Y, 256)
Y = Trim(Y)
If Len(Y) > 0 Then
ComputerName = Left(Y, Len(Y) - 1)
End If
If Trim(ComputerName) = "" Then
ComputerName = "Desconocido"
End If
End Property
Public Property Get UserName() As String
Dim X As Integer
Dim Y As String
Y = String(255, " ")
X = GetUserName(Y, 256)
Y = Trim(Y)
If Len(Y) > 0 Then
UserName = Left(Y, Len(Y) - 1)
End If
If Trim(UserName) = "" Then
UserName = "Desconocido"
End If
End Property
Public Property Get RegCompany() As String
RegCompany = GetStringKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion", "RegisteredOrganization")
If Trim(RegCompany) = "" Then
RegCompany = GetStringKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "RegisteredOrganization")
End If
If Trim(RegCompany) = "" Then
RegCompany = "Desconocido"
End If
End Property
Public Property Get Sistema_Operativo() As String
Sistema_Operativo = GetStringKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion", "ProductName")
If Trim(Sistema_Operativo) = "" Then
Sistema_Operativo = GetStringKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductName")
End If
If Trim(Sistema_Operativo) = "" Then
Sistema_Operativo = "Desconocido"
End If
End Function
Public Property Get ProgramsPath() As String
ProgramsPath = GetStringKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion", "ProgramFilesDir")
If Trim(ProgramsPath) = "" Then
ProgramsPath = "Desconocido"
Exit Property
End If
If Right(ProgramsPath, 1) <> "\" Then
ProgramsPath = ProgramsPath & "\"
End If
End Property
Public Property Get WinPath() As String
Dim RTN
Dim Buffer As String
Buffer = Space(144)
RTN = GetWindowsDirectory(Buffer, Len(Buffer))
WinPath = Left(Buffer, RTN)
If Trim(WinPath) = "" Then
WinPath = "Desconocido"
Exit Property
End If
If Right(WinPath, 1) <> "\" Then
WinPath = WinPath & "\"
End If
End Property
Public Property Get TempPath() As String
Dim RTN
Dim Buffer As String
Buffer = Space(255)
RTN = GetTempPath(Len(Buffer), Buffer)
TempPath = Left(Buffer, RTN)
If Trim(TempPath) = "" Then
TempPath = "Desconocido"
Exit Property
End If
If Right(TempPath, 1) <> "\" Then
TempPath = TempPath & "\"
End If
End Property
Public Property Get SysPath() As String
Dim RTN
Dim Buffer As String
Buffer = Space(144)
RTN = GetSystemDirectory(Buffer, Len(Buffer))
SysPath = Left(Buffer, RTN)
If Trim(SysPath) = "" Then
SysPath = "Desconocido"
Exit Property
End If
If Right(SysPath, 1) <> "\" Then
SysPath = SysPath & "\"
End If
End Property
Public Property Get DirectXVer() As String
DirectXVer = GetStringKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\DirectX", "Version")
DirectXVer = "DirectX " & Mid(DirectXVer, 4, 3) & " (" & DirectXVer & ")"
If Trim(DirectXVer) = "" Then
DirectXVer = "Desconocido"
End If
End Property
Public Property Get ScrResolution() As String
Dim iWidth As Integer
Dim iHeight As Integer
iWidth = Screen.Width / Screen.TwipsPerPixelX
iHeight = Screen.Height / Screen.TwipsPerPixelY
ScrResolution = iWidth & "x" & iHeight & "x" & ColorDepth
End Property
Public Property Get ColorDepth() As String
Dim lhDC As Long, lPlanes As Long, lBitsPerPixel As Integer
lhDC = CreateIC("DISPLAY", 0&, 0&, 0&)
If lhDC = 0 Then ColorDepth = "Desconocido": Exit Property
lPlanes = GetDeviceCaps(lhDC, PLANES)
lBitsPerPixel = GetDeviceCaps(lhDC, BITSPIXEL)
lhDC = DeleteDC(lhDC)
Select Case lPlanes
Case 1
Select Case lBitsPerPixel
Case 4: ColorDepth = "4 Bit 16 Colors"
Case 8: ColorDepth = "8 Bit 256 Colors"
Case 16: ColorDepth = "16 Bit High Color"
Case 24: ColorDepth = "24 Bit True Color"
Case 32: ColorDepth = "32 Bit True Color"
End Select
Case 4
ColorDepth = "16 Bit High Color"
Case Else
ColorDepth = "Undetermined"
End Select
End Property
Public Property Get CPU_Modelo() As String
CPU_Modelo = GetStringKey(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", "Identifier")
If Trim(CPU_Modelo) = "" Then
CPU_Modelo = GetStringKey(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", "VendorIdentifier")
End If
If Trim(CPU_Modelo) = "" Then
CPU_Modelo = "Desconocido"
End If
End Property
Public Property Get CPU_Nombre() As String
CPU_Nombre = GetStringKey(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", "ProcessorNameString")
If Trim(CPU_Nombre) = "" Then
CPU_Nombre = "Desconocido"
End If
End Property
Public Property Get CPU_Velocidad() As String
CPU_Velocidad = GetDWORDKey(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", Chr(126) & "MHz")
If Trim(CPU_Velocidad) = "" Then
CPU_Velocidad = "Desconocido"
End If
End Function
Public Property Get Memoria_RAM_Total() As Double
Dim InfoMemoria As MEMORYSTATUS
Call GlobalMemoryStatus(InfoMemoria)
Memoria_RAM_Total = Format(InfoMemoria.dwTotalPhys / 1024 / 1021.45, "###.##")
End Property
Public Property Get Memoria_RAM_Libre() As Double
Dim InfoMemoria As MEMORYSTATUS
Call GlobalMemoryStatus(InfoMemoria)
Memoria_RAM_Libre = Format(InfoMemoria.dwAvailPhys / 1024 / 1021.45, "###.##")
End Property
Public Property Get Memoria_Virtual_Total() As Double
Dim InfoMemoria As MEMORYSTATUS
Call GlobalMemoryStatus(InfoMemoria)
Memoria_Virtual_Total = Format(InfoMemoria.dwTotalVirtual / 1024 / 1021.45, "###.##")
End Property
Public Property Get Memoria_Virtual_Libre() As Double
Dim InfoMemoria As MEMORYSTATUS
Call GlobalMemoryStatus(InfoMemoria)
Memoria_Virtual_Libre = Format(InfoMemoria.dwAvailVirtual / 1024 / 1021.45, "###.##")
End Property
Public Property Get Memoria_PaginacionArchivo_Total() As Double
Dim InfoMemoria As MEMORYSTATUS
Call GlobalMemoryStatus(InfoMemoria)
Memoria_PaginacionArchivo_Total = Format(InfoMemoria.dwTotalPageFile / 1024 / 1021.45, "###.##")
End Property
Public Property Get Memoria_PaginacionArchivo_Libre() As Double
Dim InfoMemoria As MEMORYSTATUS
Call GlobalMemoryStatus(InfoMemoria)
Memoria_PaginacionArchivo_Libre = Format(InfoMemoria.dwAvailPageFile / 1024 / 1021.45, "###.##")
End Property
Public Property Get Mouse_Coordenadas() As String
Dim Coordenadas As POINTAPI
Call GetCursorPos(Coordenadas)
Mouse_Coordenadas = Coordenadas.X & ", " & Coordenadas.Y
End Property
Public Property Get Tiempo_PC_Encendido()
Dim MilloSec, Dias, Horas, Minutos, Segundos As Long
MilloSec = GetTickCount()
Segundos = MilloSec \ 1000
Dias = Segundos \ (24& * 3600&)
If Dias > 0 Then Segundos = Segundos - (24 * 3600 * Dias)
Horas = Segundos \ 3600
If Horas > 0 Then Segundos = Segundos - (3600 * Horas)
Minutos = Segundos \ 60
Segundos = Segundos Mod 60
Tiempo_PC_Encendido = "Dias:" & Dias & " Hrs:" & Horas & " Min:" & Minutos & " Seg:" & Segundos
End Property
Public Property Get HDDSpace() As String
Dim HD, Cuenta, Status As Long
Dim HDDLetter, GetHDD, HDS As String
Dim TotalBytes, FreeBytes, BytesAvailableToCaller, FreeMB, TotalMB As Currency
For Cuenta = Asc("C") To Asc("Z")
If GetDriveType(Chr(Cuenta) + ":\") = 3 Then
GetHDD = GetHDD & Chr(Cuenta)
End If
Next Cuenta
HD = Len(GetHDD)
For Cuenta = 1 To HD
HDDLetter = Mid(GetHDD, Cuenta, 1)
Status = GetDiskFreeSpaceEx(HDDLetter & ":", BytesAvailableToCaller, TotalBytes, FreeBytes)
If Status <> 0 Then
TotalMB = Format((TotalBytes * 10000) / 1000000, "###")
FreeMB = Format((FreeBytes * 10000) / 1000000, "###")
HDS = HDS & "Drive " & HDDLetter & ": " & FreeMB & " MB of " & TotalMB & " MB "
End If
Next Cuenta
HDDSpace = HDS
End Property
Public Property Get Tiempo_Local() As String
Tiempo_Local = Format(Time, "hh:mm:ss")
End Property
Private Function WordLo(LongIn As Long) As Integer
If (LongIn And &HFFFF&) > &H7FFF Then
WordLo = (LongIn And &HFFFF&) - &H10000
Else
WordLo = LongIn And &HFFFF&
End If
End Function