?
Solved

Accessing The Computer ID using Visual Basic

Posted on 2003-02-18
4
Medium Priority
?
235 Views
Last Modified: 2013-11-25
Hello, I have a need to access the computer's Hard Drive ID so I can use it within my programs for certain verification. I want to know the script or coding to use to see a local hard drive's ID information.  and possibly how to print it.  Thank You In Advance...

Sincerely AJ
0
Comment
Question by:AJ2003
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
4 Comments
 
LVL 2

Accepted Solution

by:
JoaTex earned 200 total points
ID: 7979159
Hi AJ2003

I'n going to send you a short program that is very useful.
I4m sorry to be in portuguese but you'll find it very easy to change in strings to English.

First open a module and copy the code module.

the form program uses 4 Labels and Drive list Box.

Module:

Option Explicit

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Public Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6

Public Function ObterDrives() As String
      Dim lngResultado&             'Chamar API e obter dados
      Dim StrDrives$                      'Resultados da Chamada
      Dim StrSoUmaDrive$             'Lidar com uma drive de cada vez
      Dim intPos%                         'Loop
      Dim lngTipoDrive&                   'Obter Tipo Drive
      Dim StrBuffer As String                   'Buffer
     
      StrDrives$ = Space$(255)
      lngResultado& = GetLogicalDriveStrings(Len(StrDrives$), StrDrives$)     'Chamando API
      StrDrives$ = Left$(StrDrives$, lngResultado&)               'Formatar resultado
      Do
            intPos% = InStr(StrDrives$, Chr$(0))                  'Contar Drives Achadas
            If intPos% Then
                  StrSoUmaDrive$ = Left$(StrDrives$, intPos% - 1)
                  StrDrives$ = Right$(StrDrives$, Len(StrDrives$) - intPos%)        'Retirar uma drive de cada vez
                  lngTipoDrive& = GetDriveType(StrSoUmaDrive$)                            'Obter tipo de drive
                  Select Case lngTipoDrive&                 'Verificar
                        Case DRIVE_CDROM
                              StrBuffer = StrBuffer & "CD Rom: " & StrSoUmaDrive$ & vbCrLf
                        Case DRIVE_REMOVABLE
                              StrBuffer = StrBuffer & "Drive Removmvel: " & StrSoUmaDrive$ & vbCrLf
                        Case DRIVE_FIXED
                              StrBuffer = StrBuffer & "Drive Local: " & StrSoUmaDrive$ & vbCrLf
                        Case DRIVE_REMOTE             'Drive de Rede
                              StrBuffer = StrBuffer & "Drive de Rede: " & StrSoUmaDrive$ & vbCrLf
                        Case DRIVE_RAMDISK
                              StrBuffer = StrBuffer & "Drive de RAM: " & StrSoUmaDrive$ & vbCrLf
                  End Select
            End If
      Loop Until StrDrives$ = ""
      ObterDrives = StrBuffer
End Function
Public Function ObterInfoDrive(Letra_Drive As String) As String
      Dim Serial As Long
      Dim dNome As String
      Dim sFicheiros As String
     
      Letra_Drive = Left(Trim(Letra_Drive), 1) & ":\"
      dNome = String$(255, Chr$(0))
      sFicheiros = String$(255, Chr$(0))
      GetVolumeInformation Letra_Drive, dNome, 255, Serial, 0, 0, sFicheiros, 255
      dNome = Left$(dNome, InStr(1, dNome, Chr$(0)) - 1)
      sFicheiros = Left$(sFicheiros, InStr(1, sFicheiros, Chr$(0)) - 1)
      ObterInfoDrive = "O Nome de " & Letra_Drive & " i: " & dNome & vbCrLf & "O Sistema de Ficheiros de " & Letra_Drive & " i: " & sFicheiros & vbCrLf _
      & "O Nzmero de Serial de " & Letra_Drive & " i: " & Trim(Str$(Serial))
End Function
Public Function ObterEspago(Letra_Drive As String) As String
      Dim Drive As String                 'Passar argumento da fungco
      Dim SectoresPorCluster As Long
      Dim BytesPorSector As Long
      Dim NClustersLivres As Long
      Dim TotalClusters As Long
      Dim Sts                 'Chamar API
      Dim DS                         'Formatar Resultado Final
     
      Drive = Left(Trim(Letra_Drive), 1) & ":\"             'Colocar na Raiz
      Sts = GetDiskFreeSpace(Drive, SectoresPorCluster, BytesPorSector, NClustersLivres, TotalClusters)
            If Sts <> 0 Then
                  ObterEspago = SectoresPorCluster * BytesPorSector * NClustersLivres
                  DS = Format$(ObterEspago, "###,###")
                  ObterEspago = "O Espago Livre de " & Letra_Drive & " i de: " & DS & " Bytes"
            Else
                  ObterEspago = "Erro"
            End If
End Function

Program:

Option Explicit

Dim Msg
Private Sub Drive1_Change()
      On Error GoTo Erro
      Drive1.Drive = Drive1.Drive
      Exit Sub
Erro:
      Msg = MsgBox("Drive Nco Esta Pronta!", 64, "Drives")
      Drive1 = "c:\"
End Sub

Private Sub NomDrive_Click()
      Msg = InputBox("Escreva Novo Nome Para Drive.", "Mudar Nome Drive")
      If Msg <> "" Then
            SetVolumeLabel Mid(Me.Drive1, 1, 2) & "\", Msg
      End If
      Drive1.Refresh
End Sub

Private Sub ObtDrives_Click()
      MsgBox ObterDrives
End Sub

Private Sub ObtEspago_Click()
      MsgBox ObterEspago(Me.Drive1), vbInformation, "Espago Livre:"
End Sub

Private Sub ObtInfo_Click()
      MsgBox ObterInfoDrive(Me.Drive1), vbInformation, "Info Volume Drive"
End Sub

Hope you enjoy it.
0
 
LVL 13

Assisted Solution

by:AlbertaBeef
AlbertaBeef earned 200 total points
ID: 7979197
Try this paq:

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_20370333.html

It has two different methods shown.  Hope that helps you.
0
 

Expert Comment

by:CleanupPing
ID: 8940471
AJ2003:
This old question needs to be finalized -- accept an answer, split points, or get a refund.  For information on your options, please click here-> http:/help/closing.jsp#1 
Experts: Post your closing recommendations!  Who deserves points here?
0
 
LVL 49

Expert Comment

by:DanRollins
ID: 8959591
Moderator, my recommended disposition is:

    Split points between: JoaTex and AlbertaBeef

DanRollins -- EE database cleanup volunteer
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question