|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Arquivos/Diretórios)
|
|
 |
Título da Dica: Exibir informações do sistema
|
 |
|
|
|
Postada em 4/12/2002 por DTLucchesi
Option Explicit
Private Declare Function GetVersionEx& Lib "kernel32" Alias "GetVersionExA" (lpStruct As OsVersionInfo)
Private 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
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32.DLL" (ByVal hWndOwner As Long, ByVal SHFolder As Long, idl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.DLL" (ByVal idl As Long, ByVal Path As String) As Long
Private Declare Function GetDesktopWindow Lib "User32.DLL" () As Long
Private OsVers As OsVersionInfo
Private 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
Dim n As Long
strBuff = Space$(1024)
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
|
|
|
|
|
