Exibindo informações sobre o sistema

Exibindo informações do sistema

Que tal obter algumas informações do sistema e exibí-las em um formulário do seu projeto Visual Basic. É só seguir a receita:

Inicie um novo projeto no VB
Inclua um módulo no seu projeto e insira o código exibido abaixo neste módulo:

Option Explicit
Private Declare Function GetVersionEx& Lib "kernel32" Alias "GetVersionExA" (lpStruct As OsVersionInfo)
Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long

Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function SHGetSpecialFolderLocation Lib "Shell32.DLL" (ByVal hWndOwner As Long, ByVal SHFolder As Long, idl As Long) As Long
Declare Function SHGetPathFromIDList Lib "Shell32.DLL" (ByVal idl As Long, ByVal Path As String) As Long
Declare Function GetDesktopWindow Lib "User32.DLL" () As Long

Private OsVers As OsVersionInfo

Type OsVersionInfo
dwVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatform As Long
szCSDVersion As String * 128
End Type

' Enumeração para diretorios especiais
Public Enum SystemFolder
CSIDL_DESKTOP = 0
CSIDL_INTERNET = 1
CSIDL_PROGRAMS = 2
CSIDL_CONTROLS = 3
CSIDL_PRINTERS = 4
CSIDL_PERSONAL = 5
CSIDL_FAVORITES = 6
CSIDL_STARTUP = 7
CSIDL_RECENT = 8
CSIDL_SENDTO = 9
CSIDL_BITBUCKET = 10
CSIDL_STARTMENU = 11
CSIDL_DESKTOPDIRECTORY = 16
CSIDL_DRIVES = 17
CSIDL_NETWORK = 18
CSIDL_NETHOOD = 19
CSIDL_FONTS = 20
CSIDL_TEMPLATES = 21
CSIDL_COMMON_STARTMENU = 22
CSIDL_COMMON_PROGRAMS = 23
CSIDL_COMMON_STARTUP = 24
CSIDL_COMMON_DESKTOPDIRECTORY = 25
CSIDL_APPDATA = 26
CSIDL_PRINTHOOD = 27
CSIDL_ALTSTARTUP = 29
CSIDL_COMMON_ALTSTARTUP = 30
CSIDL_COMMON_FAVORITES = 31
CSIDL_INTERNET_CACHE = 32
CSIDL_COOKIES = 33
CSIDL_HISTORY = 34
End Enum

Public Function GetVersion32() As String
' Os valores retornados sao "95" or "NT" or "Desconhecido"
' Examplo - MyString = GetVersion32
'
OsVers.dwVersionInfoSize = 148&
GetVersionEx OsVers
If OsVers.dwPlatform = 1& Then
GetVersion32 = "95/98"
ElseIf OsVers.dwPlatform = 2& Then
GetVersion32 = "NT"
Else
GetVersion32 = "Desconhecido"
End If
End Function

Public Function GetFreeDiskSpace(DiskID As String) As Double
' determinar espaco livre em disco ou drive : c:\, d:\ etc ( em bytes)
' Examplo - Myspace = GetFreeDiskSpaceEx("C:\")
' O valor retornado e do tipo long
Dim numSectorsPerCluster As Long
Dim numBytesPerSector As Long
Dim free_space As Double
Dim numFreeClusters As Long
Dim numTotalClusters As Long
Dim success As Boolean
success = GetDiskFreeSpaceEx(DiskID, numSectorsPerCluster, numBytesPerSector, numFreeClusters, numTotalClusters)
free_space = numSectorsPerCluster * numBytesPerSector * numFreeClusters
GetFreeDiskSpace = free_space
End Function

Function WindowsDir() As String
' diretorio atual do windows
' Examplo - Mydir = WindowsDir
Dim x As Long
Dim strPath As String
strPath = Space$(1024)
x = GetWindowsDirectory(strPath, Len(strPath))
strPath = Left$(strPath, x)
If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
WindowsDir = strPath
End Function

Function SystemDir() As String
' determina o atual diretorio system => windows\system
' Examplo - Mydir2 = SystemDir
Dim x As Long
Dim strPath As String
strPath = Space$(1024)
x = GetSystemDirectory(strPath, Len(strPath))
strPath = Left$(strPath, x)
If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
SystemDir = strPath
End Function

Function SystemPath(ByVal PathID As SystemFolder) As String
' determina o caminho de diretorios especiais ( veja lista )
' Examplo - MDir3 = SystemPath(CSIDL_PROGRAMS)
Dim lngIDL As Long
Dim strBuff As String
strBuff = Space$(1024)
Dim n As Long
n = SHGetSpecialFolderLocation(GetDesktopWindow(), PathID, lngIDL)
If n Then Exit Function
n = SHGetPathFromIDList(lngIDL, strBuff)
If n > 0 Then
n = InStr(strBuff, Chr$(0)) - 1
strBuff = Left$(strBuff, n)
If Right$(strBuff, 1) <> "\" Then strBuff = strBuff & "\"
SystemPath = strBuff
End If
End Function

No formulário padrão desenhe os seguintes controles: 4 caixas de texto, 5 labels, 1 listbox e 1 combobox, conforme layout abaixo:

Agora basta inserir o seguinte código no seu formulário:

Private Sub Combo1_Click()
Dim espaco As Long
espaco = GetFreeDiskSpace(Combo1.Text)
Text1(1).Text = Format(espaco, "###,###,###,###,###")
End Sub

Private Sub Form_Load()
Combo1.AddItem "C:\"
Combo1.AddItem "D:\"
Combo1.AddItem "E:\"
Combo1.ListIndex = 0

Text1(0).Text = GetVersion32
Text1(2).Text = WindowsDir
Text1(3).Text = SystemDir

For x = 0 To 34
List1.AddItem SystemPath(x)
Next

End Sub

Pressione F5 para executar o seu projeto e você obterá o resultado como exibido na tela a seguir:( no seu caso as informações podem ser diferentes)

Usamos cinco funções para obter o resultado. Se você gostou desta dica , saiba que você pode obter um resultado mais completo e com menos esforço: veja a dica - Exibindo informações sobre o sistema II.

Até a próxima dica...