Page: code / disk / deviolock.

htm

Visual Basic Disk/Drive API Routines

DeviceIoControl: Lock/Unlock Removable Media
Devices
Posted: Friday September 17, 1999
Updated: Monday December 26, 2011

Applies to: VB4-32, VB5, VB6

Developed with: VB6, Windows NT4
OS restrictions: Windows NT4, Windows 2000, Windows XP
Author: VBnet - Randy Birch

Related: DeviceIoControl: Check Media Availability

DeviceIoControl: Load/Eject Removable Media
DeviceIoControl: Obtain Physical Drive Information

Prerequisites
Windows NT, Windows 2000, Windows XP

Using DeviceIoControl, together with the

PREVENT_MEDIA_REMOVAL data user-defined type
and the IOCTL_STORAGE_MEDIA_REMOVAL control
code, it is possible for WinNT/Win2000 users to lock
and unlock any removable device. A removable
device might include, as it does on my system, CD-
ROMs and LS-120 drives, as well as SCSI and parallel
port removable devices.

This example works only on Windows NT, 2000 and

XP because:

 the standard device input/output control codes are available only on Windows NT/2000/XP.
 on Windows 95/98, an application must specify a virtual device driver in the CreateFile
function—not a specific device.
This demo is based on code provided by Mattias Sjögren in the Microsoft newsgroups.
BAS Module Code

Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const DRIVE_REMOVABLE As Long = 2
Public Const DRIVE_CDROM As Long = 5
Public Const INVALID_HANDLE_VALUE As Long = -1&
Public Const GENERIC_READ As Long = &H80000000
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const FILE_ANY_ACCESS As Long = &H0
Public Const FILE_READ_ACCESS As Long = &H1
Public Const FILE_WRITE_ACCESS As Long = &H2
Public Const OPEN_EXISTING As Long = 3
Public Const IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804

Public Type PREVENT_MEDIA_REMOVAL

PreventMediaRemoval As Byte
End Type

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 lpRootPathName As String) As Long

Public Declare Function DeviceIoControl Lib "kernel32" _

(ByVal hDevice As Long, _
ByVal dwIoControlCode As Long, _
lpInBuffer As Any, _
ByVal nInBufferSize As Long, _
lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
lpBytesReturned As Long, _
lpOverlapped As Any) As Long

Public Declare Function CreateFile Lib "kernel32" _

Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
 ByVal hTemplateFile As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" _

(ByVal hObject As Long) As Long

Public Function DeviceLock(sDrive As String, fLock As Boolean) As Boolean

Dim hDevice As Long

Dim PMR As PREVENT_MEDIA_REMOVAL
Dim bytesReturned As Long
Dim success As Long

'the drive letter has to be passed

'to CreateFile without a trailing slash (ie 'G:')
sDrive = UnQualifyPath(sDrive)

'obtain a handle to the device

'using the correct device syntax
hDevice = CreateFile("\\.\" & sDrive, _
GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
ByVal 0&, _
OPEN_EXISTING, _
0&, 0&)

If hDevice <> INVALID_HANDLE_VALUE Then

'assign the fLock value to the

'PREVENT_MEDIA_REMOVAL type
PMR.PreventMediaRemoval = CByte(Abs(fLock))

'If the operation succeeds,

'DeviceIoControl returns a nonzero value
success = DeviceIoControl(hDevice, _
IOCTL_STORAGE_MEDIA_REMOVAL, _
PMR, _
Len(PMR), _
ByVal 0&, _
0&, _
bytesReturned, _
ByVal 0&)

End If

Call CloseHandle(hDevice)
DeviceLock = success <> 0

End Function

Private Function UnQualifyPath(ByVal sPath As String) As String

'removes any trailing slash from the path

sPath = Trim$(sPath)

If Right$(sPath, 1) = "\" Then

UnQualifyPath = Left$(sPath, Len(sPath) - 1)
Else
UnQualifyPath = sPath
End If
End Function
Form Code

Add a listbox (List1), a command button array (Command1(0), Command1(1)), and a label (Label1)
to a form. The third button shown (End) is optional. Add the following code to the form:

Option Explicit

Private Sub Form_Load()

'load the removable drives and

'disable the command buttons until
'a drive is selected
LoadAvailableDrives List1
Command1(0).Enabled = False
Command1(1).Enabled = False

End Sub

Private Sub List1_Click()

Command1(0).Enabled = List1.ListIndex > -1

Command1(1).Enabled = List1.ListIndex > -1

End Sub

Private Sub Command1_Click(Index As Integer)

Dim fLock As Boolean

Dim result As Boolean
Dim sDrive As String

'nothing to do if a drive's not selected

If List1.ListIndex > -1 Then

'get the selected drive

sDrive = List1.List(List1.ListIndex)

'DeviceIoControl requires the

'IOCTL_STORAGE_MEDIA_REMOVAL
'control code and a Boolean
'indicating the lock state.
'Passing False unlocks the device;
'passing True locks it. This handily
'corresponds to the 0/1 indices of
'the Command button array.
fLock = CBool(Index)
result = DeviceLock(sDrive, fLock)

'display result
If result Then

Select Case Index

Case 0
Label1.Caption = "Device " & sDrive & " is unlocked."
Case 1
Label1.Caption = "Device " & sDrive & " is locked."
 End Select

Else
Label1.Caption = "Call failed - perhaps no media in device."
End If

End If

End Sub

Private Sub LoadAvailableDrives(lst As ListBox)

Dim lpBuffer As String

Dim drvType As Long
Dim currDrive As String

'get list of available drives

lpBuffer = GetDriveString()

'Separate the drive strings

'and add to the combo. StripNulls
'will continually shorten the
'string. Loop until a single
'remaining terminating null is
'encountered.
Do Until lpBuffer = Chr(0)

'strip off one drive item

'and check for removable (or CD) status,
'and add to the combo
currDrive = StripNulls(lpBuffer)
drvType = GetDriveType(currDrive)

If (drvType = DRIVE_CDROM) Or _
(drvType = DRIVE_REMOVABLE) Then

lst.AddItem currDrive

End If

Loop

End Sub

Private Function StripNulls(startstr As String) As String

'Take a string separated by chr$(0)

'and split off 1 item, shortening the
'string so next item is ready for removal.
Dim pos As Long

pos = InStr(startstr, Chr$(0))

If pos Then

StripNulls = Mid$(startstr, 1, pos - 1)

startstr = Mid$(startstr, pos + 1, Len(startstr))

End If
End Function

Private Function GetDriveString() As String

'returns of available drives each

'separated by a null
Dim sBuffer As String

'possible 26 drives, three characters each

'plus null, plus trailing null
sBuffer = Space$((26 * 4)+ 1)

If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then

'trim string but do not

'remove trailing null
GetDriveString = Trim$(sBuffer)

End If

End Function
Comments
Save the program and run. Once you've locked the media, activating the drive panel eject button or
Windows context menu command will not eject the media from the device.

PayPal Link
Like what you see here? Help ensure continued VB
Classic
development by making a small PayPal donation
today. Thank you.

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.

Terms of Use | Your Privacy