USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Informações do Sistema
Bicicchi
SOROCABA
SP - BRASIL
Postada em 10/06/2005 16:00 hs            
Olá pessoal, quais funções devo usar no VB e como devo usá-las, para exibir as seguintes informações :
 
Windows Instalado na máquina
Service Pack Instalado
Tamanho do HD e Espaço Livre
Processador, Placa de Video, Rede, Som e Modem
 
Já tentei a dica do Caca (WMI) mas não dá certo, pois diz que o objeto não foi definido, não sei onde estou errando.
 
Se alguem puder me ajudar eu agradeço.
 
Sergio
     
Jayme
SÃO PAULO
SP - BRASIL
ENUNCIADA !
Postada em 10/06/2005 16:15 hs            
Acho que isto resolve:
 
Option Explicit
  Const READ_CONTROL = &H20000
  Const KEY_QUERY_VALUE = &H1
  Const KEY_SET_VALUE = &H2
  Const KEY_CREATE_SUB_KEY = &H4
  Const KEY_ENUMERATE_SUB_KEYS = &H8
  Const KEY_NOTIFY = &H10
  Const KEY_CREATE_LINK = &H20
  Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                         KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                         KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  Const HKEY_LOCAL_MACHINE = &H80000002
  Const ERROR_SUCCESS = 0
  Const REG_SZ = 1
  Const REG_DWORD = 4
  Const gREGKEYSYSINFOLOC = "SOFTWAREMicrosoftShared Tools Location"
  Const gREGVALSYSINFOLOC = "MSINFO"
  Const gREGKEYSYSINFO = "SOFTWAREMicrosoftShared ToolsMSINFO"
  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
  If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
      If (Dir(SysInfoPath & "MSINFO32.EXE") <> "") Then
          SysInfoPath = SysInfoPath & "MSINFO32.EXE"
      Else
          GoTo SysInfoErr
      End If
  Else
      GoTo SysInfoErr
  End If
  Call Shell(SysInfoPath, vbNormalFocus)
  Exit Sub
SysInfoErr:
  MsgBox "System Information Is Unavailable At This Time", 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
  Dim rc As Long
  Dim hKey As Long
  Dim hDepth As Long
  Dim KeyValType As Long
  Dim tmpVal As String
  Dim KeyValSize As Long
  rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
  If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
  tmpVal = String$(1024, 0)
  KeyValSize = 1024
  rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                       KeyValType, tmpVal, KeyValSize)
  If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
 
  If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
      tmpVal = Left(tmpVal, KeyValSize - 1)
  Else
      tmpVal = Left(tmpVal, KeyValSize)
  End If
  Select Case KeyValType
  Case REG_SZ
      KeyVal = tmpVal
  Case REG_DWORD
      For i = Len(tmpVal) To 1 Step -1
          KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
      Next
      KeyVal = Format$("&h" + KeyVal)
  End Select
  GetKeyValue = True
  rc = RegCloseKey(hKey)
  Exit Function
GetKeyError:
  KeyVal = ""
  GetKeyValue = False
  rc = RegCloseKey(hKey)
End Function
Private Sub Command1_Click()
  On Error Resume Next
  Call StartSysInfo
End Sub
 
   
ATS
OURINHOS
SP - BRASIL
ENUNCIADA !
Postada em 10/06/2005 16:55 hs            
   
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página