?
Solved

Accessing The Computer ID using Visual Basic

Posted on 2003-02-18
4
Medium Priority
?
244 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
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:Glen A.
Glen A. 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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

616 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