Determine if x partition is same physical drive as y partition

[cafeenman]

I have been putting backup routines in my projects to save whatever file is important to the application.

If the user selects to backup to the same drive as the original file then I warn him that it's a bad idea.

But that doesn't work if he chooses to backup to a different partition on the same physical hard drive.

So I want to warn if backing up to the same physical drive.

Answer I need:

How do I determine what physical drive a partition is part of?

Public Function BackupProjectFile() As Long
Dim sMsg As String
Dim sBackupFilename As String
Dim nReturn As Long
Dim FSO As New FileSystemObject
Dim sCurrentDrive As String
Dim sBackupDrive As String

On Error GoTo errHandler
' Returns Error Code.

sMsg = "In the event of Drive failure, both the original file and the backup file may be lost." & vbCrLf & "Continue with backup operation?" & DBL_RETURN
sMsg = sMsg & "Click Yes to continue or No to select a different path to backup your Project."

Top:

If sBackupFilename = vbNullString Then sBackupFilename = ProjectFilename

sBackupFilename = GetFileName(FILE_SAVE, sBackupFilename, 0, WEBMASTER_Project_v2_FILE_FILTERS, BackupPath(sBackupFilename), vbNullString, "wpj2")

If sBackupFilename = vbNullString Then Exit Function

sCurrentDrive = FSO.GetDriveName(ProjectFilename)
sBackupDrive = FSO.GetDriveName(sBackupFilename)

If sCurrentDrive = sBackupDrive Then
  nReturn = MsgBox(sMsg, vbYesNoCancel + vbQuestion, APP_TITLE)
  Select Case nReturn
    Case Is = vbYes
      ' Do nothing
    Case Is = vbNo
      GoTo Top
    Case Is = vbCancel
      Exit Function
  End Select
End If

nReturn = BackupFile(ProjectFilename, sBackupFilename)
If nReturn <> 0 Then Err.Raise nReturn

MsgBox ProjectFilename & DBL_RETURN & "successfully backed up to" & DBL_RETURN & sBackupFilename & ".", vbInformation, APP_TITLE

Registry.SaveSetting "StartUp", "Backup Path", GetFolder(sBackupFilename)

Set FSO = Nothing

' Return 0

Exit Function

errHandler:
Dim nErrReturn As Long
Dim nErr As Long

nErr = Err
nErrReturn = ErrorHandler(Error, nErr, vbNullString, "bWebmasterUtilties2.BackupProjectFile()")

If nErrReturn = vbRetry Then Resume

BackupProjectFile = nErr

Set FSO = Nothing

End Function

[vb5prgrmr]

check out the GetVolumeInformation API

Good Luck

[Siddharth Rout]

One more way to do this...

Remember no matter how many partitions are there... there will only be one Hard Disk Serial number. Hope this helps...

'~~> Set reference to Microsoft Scripting Runtime
Public Function GetDriveSerialNumber(Optional ByVal DriveLetter As String) As Long
    Dim fso As Object, Drv As Object
    '~~> Create a FileSystemObject object
    Set fso = CreateObject("Scripting.FileSystemObject")
         
    '~~> Assign the current drive letter if not specified
    If DriveLetter <> "" Then
        Set Drv = fso.GetDrive(DriveLetter)
    Else
        Set Drv = fso.GetDrive(fso.GetDriveName(App.Path))
    End If
      
    With Drv
        If .IsReady Then
            DriveSerial = Abs(.SerialNumber)
        Else    '~~> "Drive Not Ready!"
            DriveSerial = -1
        End If
    End With
          
    '~~> Clean up
    Set Drv = Nothing
    Set fso = Nothing
    GetDriveSerialNumber = DriveSerial
End Function

Usage

Sub HardDiskSerial()
    MsgBox GetDriveSerialNumber("C:")
End Sub

[Edgemeal]

One more way to do this...

Remember no matter how many partitions are there... there will only be one Hard Disk Serial number. Hope this helps...

Hmmm, I have 3 SATA hard drives, each drive has four partitions, and each drive letter returned a different number using that code, I also tried an API way using GetVolumeInformation and that too returns a different number for each drive letter.

Maybe these solutions only work on PATA drives?

[Edgemeal]

Found this, seems to work OK for me.

Private Sub Command2_Click()
    Dim wmiDiskDrive As Object
    Dim wmiDiskDrives As Object
    Dim wmiDiskPartition As Object
    Dim wmiDiskPartitions As Object
    Dim wmiLogicalDisk As Object
    Dim wmiLogicalDisks As Object
    Dim wmiServices As Object
    Dim wmiQuery As String
    
    ' Get physical disk drive Letter
    Set wmiServices = GetObject( _
        "winmgmts:{impersonationLevel=Impersonate}!//" & ".")
    
    Set wmiDiskDrives = wmiServices.ExecQuery("SELECT Caption, DeviceID FROM Win32_DiskDrive")
    
    For Each wmiDiskDrive In wmiDiskDrives
        Debug.Print "Disk drive Caption: " _
            & wmiDiskDrive.Caption _
            & vbNewLine & "DeviceID: " _
            & " (" & wmiDiskDrive.DeviceID & ")"
        wmiQuery = "ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" _
            & wmiDiskDrive.DeviceID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition"
        Set wmiDiskPartitions = wmiServices.ExecQuery(wmiQuery)
    
        For Each wmiDiskPartition In wmiDiskPartitions
            'Use partition device id to find logical disk
            Set wmiLogicalDisks = wmiServices.ExecQuery _
                ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" _
                 & wmiDiskPartition.DeviceID & "'} WHERE AssocClass = Win32_LogicalDiskToPartition")
    
            For Each wmiLogicalDisk In wmiLogicalDisks
                Debug.Print "Drive letter associated" _
                    & " with disk drive = " _
                    & wmiDiskDrive.Caption _
                    & wmiDiskDrive.DeviceID _
                    & vbNewLine & " Partition = " _
                    & wmiDiskPartition.DeviceID _
                    & vbNewLine & " is " _
                    & wmiLogicalDisk.DeviceID
            Next
        Next
    Next
End Sub

[Siddharth Rout]

@Edge: Yeah, you are right. The code for drive serial number which I gave above will change after every format... Thats a neat code but will not give you the unique Serial number....

Here is one link which is useful...

http://www.planet-source-code.com/vb...57366&lngWId=1

[cafeenman]

Thanks for the replies. I have e-mail notification enabled but I wasn't notified so I thought there were no responses.

I thought of using the Serial number approach but while searching the googles for clues, I found several sources that said it's not reliable because some drives don't have serial numbers although I've never come across one.

Also, it doesn't matter if the serial number changes during a format because this is a "now" thing.

In other words it's going to compare the drive the current file is on to the drive the User selects to back up the file to. He's not going to have time to format the drive between the time he selects the file on the drive about to be formatted and saving the backup.

I'll try the serial number approach. It's not a huge big deal that I even accomplish this. I just want to do my part to annoy users with lots of warning pop-ups.

I want to be my own Vista.

[si_the_geek]

Thanks for the replies. I have e-mail notification enabled but I wasn't notified so I thought there were no responses.

That would be due to your email provider I'm afraid - for some reason notification emails get stopped by some providers (yet not every time ), and despite the obvious opt-in we can't persuade them to unblock us.

Apparently the best way to deal with it is to create a GMail account to get the notifications, and set it up to auto-forward to your real address.

[vb5prgrmr]

Or some sites will allow you to recieve the email if you add the senders address to your contact list

[si_the_geek]

Unfortunately based on what many people have said, that doesn't work - the emails get deleted before they reach that stage.

[cafeenman]

Serial number doesn't work. Gave me two different serials for two partitions on the same drive.

[steve6375]

See the post (resolved) to get a physicial drive number given a drive letter. This will solve your problem. I would avoid using wmi for this as in my experience it can occasionally hang using the Associate on disk volumes!

[cafeenman]

See the post (resolved) to get a physicial drive number given a drive letter. This will solve your problem. I would avoid using wmi for this as in my experience it can occasionally hang using the Associate on disk volumes!

Can you please link to the thread or provide the title? I couldn't find the thread you're talking about.

Thanks.

[steve6375]

http://www.vbforums.com/showthread.php?t=466828

here you go!

[cafeenman]

That mostly does it. It doesn't work for my RAID drives though. My D: drive is a pair of mirrored 500 GB drives and the function returns 0,0,0 for drive type, drive number and partition number. For all other drives including optical drives it works.

I have to see how it works on a network drive which I don't have available at the moment.

Thanks!

[anhn]

I found this code at http://www.vbgold.com/vb-projects/di...l-number.shtml
that looks similar to the code in one of the post above.

      Private Sub Form_Load()
      
          'Show drive serial number for the current drive
          MsgBox " Drive serial number for " & Left(App.Path, 1) & ": " & GetDriveSerialNumber
          End
      
      End Sub
      --------------------------------------------------------------------------------
      Public Function GetDriveSerialNumber(Optional ByVal DriveLetter As String) As Long
      
          Dim fso As Object, Drv As Object
          
          'Create a FileSystemObject object
          Set fso = CreateObject("Scripting.FileSystemObject")
          
          'Assign the current drive letter if not specified
          If DriveLetter <> "" Then
              Set Drv = fso.GetDrive(DriveLetter)
          Else
              Set Drv = fso.GetDrive(fso.GetDriveName(App.Path))
          End If
      
          With Drv
              If .IsReady Then
                  DriveSerial = Abs(.SerialNumber)
              Else    '"Drive Not Ready!"
                  DriveSerial = -1
              End If
          End With
          
          'Clean up
          Set Drv = Nothing
          Set fso = Nothing
          
          GetDriveSerialNumber = DriveSerial
          
      End Function

fso.drv.SerialNumber return the Serial Number of the Volume (partition) not of the physical hard disk.
As mentioned above, Volume Serial Number can be changed on format, 2 partitions of the same disk usually will have 2 different Serial Numbers.

This code won't help but simpler than above:

Sub MyHardDiskVolumeSerialNumbers()
   Dim fso As Object '-- Scripting.FileSystemObject
   Dim dr As Object '-- Scripting.Drive
   
   '-- Set fso = New Scripting.FileSystemObject
   Set fso = CreateObject("Scripting.FileSystemObject")
   For Each dr In fso.Drives
      If dr.DriveType = Fixed Then
         Debug.Print dr.DriveLetter & ": " & dr.SerialNumber
      End If
   Next
   Set dr = Nothing
   Set fso = Nothing
End Sub

I didn't play with this project http://www.a1vbcode.com/app-4080.asp
but perhaps it works for IDE drives only.