Thursday, June 15, 2017

How to Retrieve the Hard Disk's Serial Number

I found myself looking for a way to retrieve the serial number of the computer's hard drive as a way of preventing unauthorized copies of an Access app. I have done it before but couldn't remember how. To my surprise, I found several ways to accomplish this task. I decided to post a couple of those techniques here to help anyone else who may find himself or herself looking to do the same thing in the future.

Before we start, the first thing we need to realize is hard disk drives have more than one serial numbers. One of the serial numbers we can retrieve is the one assigned by the hard disk manufacturer. This serial number should stay consistent throughout the life of the equipment. The other serial number available to us is the logical serial number assigned by the operating system when a disk is formatted. The value for the logical serial number may change if the disk is reformatted. Each technique presented below depends on which serial number you are interested in retrieving.

Physical Disk Drive Serial Numbers


The following function uses Windows Management Instrumentation (WMI) to create a connection to the local computer. The "WinMgmts" moniker is used to create a WMI object. Once a WMI object is instantiated, we can use the InstancesOf method to query the machine for system information.

Public Function HDSerial() As String
'6/14/2017
'thedbguy@gmail.com
'Returns the hard disk drive serial number
'You are free to use this code in your applications
'provided this copyright notice is left unchanged

On Error GoTo errHandler

Dim objWMI As Object
Dim objWin32 As Object
Dim objPM As Object
Dim strSN As String

Set objWMI = GetObject("WinMgmts:")
Set objWin32 = objWMI.InstancesOf("Win32_PhysicalMedia")

For Each objPM In objWin32
    strSN = strSN & (";" + objPM.SerialNumber)

Next

HDSerial = Trim(Mid(strSN, 2))

errExit:
    Set objPM = Nothing
    Set objWin32 = Nothing
    Set objWMI = Nothing
    Exit Function
    
errHandler:
    MsgBox Err.Number & ". " & Err.Description
    Resume errExit
    
End Function

Logicl Disk Drive Serial Numbers


The above function used the "Win32_PhysicalMedia" collection to reference all the physical drives connected to the computer. We can now modify the above function using "Win32_LogicalDisk" to get a collection of all logical or mapped drives connected to the computer for the current user.

Public Function LDSerialWMI(Optional DriveLetter As Variant) As Variant
'6/14/2017
'thedbguy@gmail.com
'Returns the logical disk drive serial number
'You are free to use this code in your applications
'provided this copyright notice is left unchanged

On Error GoTo errHandler

Dim objWMI As Object
Dim objWin32 As Object
Dim objLD As Object
Dim strSN As Variant

Set objWMI = GetObject("WinMgmts:")
Set objWin32 = objWMI.InstancesOf("Win32_LogicalDisk")

If IsMissing(DriveLetter) Then
    For Each objLD In objWin32
        DriveLetter = objLD.DeviceID
        strSN = strSN & (";" + DriveLetter + objLD.VolumeSerialNumber)

    Next

Else
    For Each objLD In objWin32
        DriveLetter = Left(DriveLetter,1) & ":"
        If DriveLetter = objLD.DeviceID Then
            strSN = ";" & objLD.VolumeSerialNumber

        End If    
    Next

End If

LDSerialWMI = Trim(Mid(strSN, 2))

errExit:
    Set objLD = Nothing
    Set objWin32 = Nothing
    Set objWMI = Nothing
    Exit Function
    
errHandler:
    MsgBox Err.Number & ". " & Err.Description
    Resume errExit
    
End Function

However, there is a more straightforward way to get the serial number of a specific logical disk drive. The following function uses the File System Object.

Public Function LDSerialFSO(DriveLetter As String) As Variant
'6/14/2017
'thedbguy@gmail.com
'Returns the logical disk drive serial number
'You are free to use this code in your applications
'provided this copyright notice is left unchanged

On Error GoTo errHandler

Dim objFSO As Object
Dim objDrv As Object
Dim strSN As Variant

DriveLetter = Left(DriveLetter,1) & ":"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDrv = objFSO.GetDrive(DriveLetter)

If objDrv.IsReady Then
    strSN = objDrv.SerialNumber
Else
    strSN = Null
End If
    
LDSerialFSO = strSN

errExit:
    Set objFSO = Nothing
    Exit Function
    
errHandler:
    MsgBox Err.Number & ". " & Err.Description
    Resume errExit
    
End Function
There is an important difference between the two functions for logical disk drive presented above. Using WMI returns the serial number as HEX; whereas, using FSO returns the serial number as a Long Integer. However, you can use the Hex() function to either convert the return value from the LDSerialFSO() function to HEX or modify the LDSerialFSO() function to return the serial number as HEX.

I hope you find this post helpful. As usual, please feel free to submit your comments to let me know how I can improve these functions. Thank you!

Sunday, March 19, 2017

A function to return the next work day

I know there are plenty of routines already available to calculate work days, but this topic is not really about adding work days to a date or counting work days between two dates. Rather, it is an extension of the topic for making sure the result from a date calculation falls on a work day.

You are probably aware we can simply use the Weekday() function to make sure a date does not fall on a weekend. For example, the following routine will check if a given date falls on a weekend (Saturday or Sunday); and if so, we simply return the date for the following Monday.

Select Case WeekDay(InputDate)
     Case 1 'Input Date falls on a Sunday
          InputDate = DateAdd("d", 1, InputDate)

     Case 7 'Input Date falls on a Saturday
          InputDate = DateAdd("d", 2, InputDate)

End Select

I say this article is an extension of the above because I was recently asked to incorporate a check for Holidays as a non-work day. Much like the routines available for calculating work days, we need to use a table listing all the Holidays. Once we have this table, we can use the following routine to check if a date falls on a Holiday and simply return the following day.

If DCount("*", "tblHolidays", "HolidayDate=#" & Format(InputDate, "yyyy-mm-dd") & "#") > 0 Then
     InputDate = DateAdd("d", 1, InputDate)
End If

The problem with simply combining the above two subroutines is which one should we perform first? Let us say we decided to check for a Holiday first and then check for a weekend. If the new date falls on a weekend, the final result will return the date for the following Monday, and we're done. But what if the following Monday happens to be a Holiday?

Conversely, if we check for a weekend first and then followed by a check for a Holiday, we would solve the above problem. But what happens if the input date was on a Friday and it was also Holiday? Checking for a weekend first will fail and then checking for a Holiday will result on a weekend date.

So, as you can see, it is somewhat of a Catch-22 situation.

If you have followed my posts on UtterAccess, you might be familiar with how I like to use recursive functions to solve problems like this one. So, the below function is what I ended up using to continually check if a date falls on a Holiday or a weekend and return the next work day.

Public Function GetNextWorkDay(InputDate As Date) As Date
'3/16/2017
'http://thedbguy.blogspot.com
'if input date is on a weekend or a holiday, returns the next work day

On Error GoTo errHandler

'check for holiday
If DCount("*", "tblHolidays", "HolidayDate=#" & Format(InputDate, "yyyy-mm-dd") & "#") > 0 Then
    InputDate = GetNextWorkDay(DateAdd("d", 1, InputDate))
    
End If

'check for weekend
Select Case Weekday(InputDate)
    Case 1 'Input date falls on a Sunday
        InputDate = GetNextWorkDay(DateAdd("d", 1, InputDate))
        
    Case 7 'Input date falls on a Saturday
        InputDate = GetNextWorkDay(DateAdd("d", 2, InputDate))
    
End Select

GetNextWorkDay = InputDate

errExit:
    Exit Function
    
errHandler:
    MsgBox Err.Number & ". " & Err.Description
    Resume errExit
    
End Function
Hope you find it useful. Please let me know if you have any recommendations for improvement. Thank you for reading.