[AccessD] Track PC Number

For security reasons I sometimes use the hard drives serial number. Here's
some code to get that info:

Function lbf_GetFirstHardDriveInfo(strType As String) As Variant

  ''*******************************************************
''                         Procedure Identification
''---------------------------------------------------------
''    Name:         lbf_GetFirstHardDriveInfo
''
''    Purpose:	Retrieves info on the hard drive
''
''    Options: 	"FreeSpace", "FileSystem", "SerialNumber"
''			"TotalSize", "VolumeName"
''
''    Notes:
''
''
''    Date/Author:   01/20/03 John Skolits
''***********************************************************

On Error GoTo lbf_GetFirstHardDriveInfo_ERR

'*********BEGIN CODE HERE ********
Dim fs, a, pdrive, pMachineID
Set fs = CreateObject("Scripting.FileSystemObject")
 For Each pdrive In fs.Drives
     If pdrive.DriveType = 2 Then
         Select Case strType

             Case "FreeSpace"
                 lbf_GetFirstHardDriveInfo = _
                    Format(CDbl((pdrive.FreeSpace)), "#,###,###")
             Case "FileSystem"
                 lbf_GetFirstHardDriveInfo = _
                    CStr((pdrive.FileSystem))
             Case "SerialNumber"
                 lbf_GetFirstHardDriveInfo = _
                    CStr(Hex(pdrive.SerialNumber))
             Case "TotalSize"
                 lbf_GetFirstHardDriveInfo = _
                    CDbl((pdrive.TotalSize))
             Case "VolumeName"
                 lbf_GetFirstHardDriveInfo = _
                    CStr((pdrive.VolumeName))
          End Select
     End If
 Next
    

lbf_GetFirstHardDriveInfo_EXIT:

Exit Function

lbf_GetFirstHardDriveInfo_ERR:       'Display the error
      If lg_intDEBUG_MODE = True Then
            DoCmd.Echo lg_intDEBUG_ECHO
            DoCmd.Hourglass lg_intDEBUG_HOURGLASS
            MsgBox "ERROR CODE:" & Err & "   DESC:" & Error
            Stop
            Resume
      End If

Dim strCallingObject As String
      strCallingObject = "lbf_GetFirstHardDriveInfo" _
      & "  " & Application.CurrentObjectName
      MsgBox Err, Error, strCallingObject
      Resume lbf_GetFirstHardDriveInfo_EXIT
End Function