Dicas do OsmarJr

Exibindo Informações do Sistema


Se você tem uma tela "Sobre" o seu sistema e deseja torná-la mais próxima àquelas do Windows/Office.

 

Se você tem uma tela "Sobre" o seu sistema e deseja torná-la mais próxima àquelas do Windows/Office, crie o form mostrando as suas informações e crie um botão "Sistema Operacional" e chame, a partir dele, "StartSysInfo" (sem as haspas, claro).

De um form Sobre... gerado pelo Visual Basic 6:

Option Compare Database
 				Option Explicit
 				' Opções de segurança da chave do Registry...
 	Const KEY_ALL_ACCESS = &H2003F
 	
 	
 	' Tipos de chave ROOT...
 	Const HKEY_LOCAL_MACHINE = &H80000002
 	Const ERROR_SUCCESS = 0
 	Const REG_SZ = 1 ' Unicode nul terminated string
 	Const REG_DWORD = 4 ' 32-bit number
 	
 	
 	Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
 	Const gREGVALSYSINFOLOC = "MSINFO"
 	Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
 	Const gREGVALSYSINFO = "PATH"
 	
 	
 	Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
     	ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
 	Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, _
     	ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
 	Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
 	
 	Public Sub StartSysInfo()
 	On Error GoTo SysInfoErr
 	
 	Dim rc As Long
 	Dim SysInfoPath As String
 	
 	' Tenta obter o Caminho\Nome do programa System Info do Registry...
 	    If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
 	' Tenta obter apenas o caminho do programa System Info do Registry...
 	        ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
 	' Valida a existência de versão 32 bit do programa
 	            If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
 	                SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
     ' Erro - Arquivo não encontrado...
 	            Else
 	                 GoTo SysInfoErr
 	            End If
 	' Erro - Entrada no Registry não encontrada...
 	    Else
 	          GoTo SysInfoErr
 	    End If
 	
 	    Call Shell(SysInfoPath, vbNormalFocus)
 	
 	    Exit Sub
 	SysInfoErr:
 	    MsgBox "Informações do sistema não disponível", vbOKOnly
 	End Sub
 	
 	
 	Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
 	Dim i As Long  ' Contador 
 	Dim rc As Long ' Código de retorno
 	Dim hKey As Long ' Handle para uma chave aberta do registry
 	Dim hDepth As Long '
 	Dim KeyValType As Long ' Tipo de dados de uma chave do registry
 	Dim tmpVal As String ' Armazenagem temporária para um valor de chave do Registry
 	Dim KeyValSize As Long ' Tamanho da variável da chave do registry
 	'------------------------------------------------------------
 	' Abre RegKey sob KeyRoot {HKEY_LOCAL_MACHINE...}
 	'------------------------------------------------------------
 	    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Abre a chave do Registry
    	If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Erro de Handle...
    	tmpVal = String$(1024, 0) ' Aloca espaço variável
 	    KeyValSize = 1024 ' Marca o tamanho da variável
     	'------------------------------------------------------------
 	' Recupera o valor de chave do registry...
 	'------------------------------------------------------------
 	    rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value
    	If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Erros de Handle
    	tmpVal = VBA.Left(tmpVal, InStr(tmpVal, VBA.Chr(0)) - 1)
 	'------------------------------------------------------------
 	' Determina o tipo de valor de chave para conversão
 	'------------------------------------------------------------
 	    Select Case KeyValType ' Procura o tipo de dados...
 	        Case REG_SZ ' Tipo de dados da chave do Registry
 	            KeyVal = tmpVal ' Copia o valor da string
 	    Case REG_DWORD ' Tipo de dados de chave Double Word
 	        For i = Len(tmpVal) To 1 Step -1 ' Converte cada Bit
 	            KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Monta o valor caracter a caracter
 	        Next
 	            KeyVal = Format$("&h" + KeyVal) ' Converte a palavra dupla para string
 	    End Select
 	
 	    GetKeyValue = True ' Return Success
 	    rc = RegCloseKey(hKey) ' Fecha a chave do Registry
 	    Exit Function ' Exit
 	
 	GetKeyError: ' Limpeza após a ocorrencia de erro
 	    KeyVal = "" ' Deixa o valor de retorno como string vazia
 	    GetKeyValue = False ' Devolve a falha 
 	    rc = RegCloseKey(hKey) ' Fecha a chave do registry
 	End Function
 			
 			
 			
 			
 			insira esta brincadeira toda em um módulo padrão e chame StartSysInfo a partir de um botão.
 
 Funciona no Access 97/2K/2K3. 

 

 

Home

Contato | Copyright©Osmar José Correia Júnior | 24-Nov-2005 18:24