Ejecting Drives

[DarkSpork]

I downloaded this code from a website and modified it into a function. This code is SUPPOSED TO eject whatever drive you put in...
It's worked perfectly on every computer I've tried it on until this week... it works in and out.

Call EjectDrive("D") > Usually ejects my CD drive and also the other test computer's DVD drive.
Call EjectDrive("E") > This is the code I'm after. The program that I have written constantly scans the computer's drives to pick up flash drives. Unauthorized flash drives are to be ejected immediately without mercy. Any detected tampering shuts down the computer. As most of the code in this program could have malicious intent, it will not be posted.

Anyway, getting back to the task at hand, using the letter of a flash drive in this function causes the flash drive's name to change to "Removable Disk." The drive is still powered, so people can charge iPods.

So anyway, here's the code which without editing suddenly doesn't work well anymore. If you can figure out what's wrong here then please tell me. I'm only concerned with the portion that works on XP. Also, if anyone knows any way to FORCE the drive ejected, regardless of wheither or not Windows thinks it's a good idea then that would be great.

 Option Explicit
Private Declare Function GetVersion Lib "kernel32" () As Long
Private 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
Private 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
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_DELETE_ON_CLOSE = 67108864
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const IOCTL_STORAGE_EJECT_MEDIA = 2967560
Private Const VWIN32_DIOC_DOS_IOCTL = 1
 
Private Type DIOC_REGISTERS
  reg_EBX As Long
  reg_EDX As Long
  reg_ECX As Long
  reg_EAX As Long
  reg_EDI As Long
  reg_ESI As Long
  reg_Flags As Long
End Type
 
Public Function EjectDrive(DriveLetter As String) As Integer
'Returns 0 if success, else gives error number

On Error GoTo Err

Dim hDrive As Long, DummyReturnedBytes As Long
Dim DriveLetterAndColon As String
Dim RawStuff As DIOC_REGISTERS

  If Len(DriveLetter) = 1 Then 'Confirm proper input
    DriveLetterAndColon = UCase(Left$(DriveLetter & ":", 2)) 'Make it all caps for easy interpretation
    If GetVersion >= 0 Then 'We are running Windows NT/2000
      hDrive = CreateFile("\\.\" & DriveLetterAndColon, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
      If hDrive <> INVALID_HANDLE_VALUE Then
        'Eject media!
        Call DeviceIoControl(hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0, 0, DummyReturnedBytes, ByVal 0)
        Call CloseHandle(hDrive)  'Clean up after ourselves
        EjectDrive = 0
      Else
        EjectDrive = 1
      End If
    Else  'We are running Win9x/Me
      hDrive = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)
      If hDrive <> INVALID_HANDLE_VALUE Then
        'Setup our raw registers to use Interrupt 21h Function 440Dh Minor Code 49h
        RawStuff.reg_EAX = &H440D   'The function to use
        RawStuff.reg_EBX = Asc(DriveLetterAndColon) - Asc("A") + 1 'The drive to do it on
        RawStuff.reg_ECX = &H49 Or &H800     'The minor code of the function in the low byte of the low word and the device category of 8 in the high byte of the low word
        'Eject media!
        Call DeviceIoControl(hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff, LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0)
        Call CloseHandle(hDrive)  'Clean up after ourselves
      End If
    End If
  Else
    EjectDrive = 1
  End If
Exit Function

Err:
EjectDrive = Err()
End Function

[Ellis Dee]

Here's the code I use:

Private Type MCI_OPEN_PARMS
    dwCallback As Long
    wDeviceID As Long
    lpstrDeviceType As String
    lpstrElementName As String
    lpstrAlias As String
End Type

Private Declare Function GetDriveType Lib "Kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" (ByVal wDeviceID As Long, ByVal uMessage As Long, ByVal dwParam1 As Long, ByRef dwParam2 As Any) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

' Eject CD/DVD
Public Sub Eject(Optional ByVal Drive As String = "(default)")
    If Drive = "(default)" Then
        mciSendString "Set CDAudio Door Open", 0&, 0&, 0&
    Else
        OpenDriveDoor Drive
    End If
End Sub

Private Sub OpenDriveDoor(ByVal pstrDrive As String, Optional pblnOpen As Boolean = True)
    Const DRIVE_CDROM = 5
    Const MCI_OPEN = &H803
    Const MCI_OPEN_TYPE = &H2000&
    Const MCI_OPEN_SHAREABLE = &H100&
    Const MCI_OPEN_ELEMENT As Long = &H200&
    Const MCI_SET = &H80D
    Const MCI_SET_DOOR_OPEN = &H100&
    Const MCI_SET_DOOR_CLOSED = &H200&
    Const MCI_CLOSE = &H804
    Dim typMCI As MCI_OPEN_PARMS
    Dim lngError As Long
    Dim strBuffer As String
    
    pstrDrive = Left$(pstrDrive, 1) & ":"
    If GetDriveType(pstrDrive) = DRIVE_CDROM Then
        typMCI.wDeviceID = 0
        typMCI.lpstrDeviceType = "cdaudio"
        typMCI.lpstrElementName = pstrDrive
        lngError = mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE Or MCI_OPEN_SHAREABLE Or MCI_OPEN_ELEMENT, typMCI)
        If lngError = 0 Then
            If pblnOpen Then
                lngError = mciSendCommand(typMCI.wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, ByVal 0&)
            Else
                lngError = mciSendCommand(typMCI.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, ByVal 0&)
            End If
            mciSendCommand typMCI.wDeviceID, MCI_CLOSE, 0&, 0&
        End If
        If lngError <> 0 Then
            strBuffer = Space$(255)
            mciGetErrorString lngError, strBuffer, Len(strBuffer)
            strBuffer = Trim$(strBuffer)
            MsgBox strBuffer, vbInformation, "Notice"
        End If
    End If
End Sub

[Hack]

This has always worked for me

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub cmdOpenCD_Click()
Dim OpenCDDrive As Long
OpenCDDrive = mciSendString("set CDAudio door open", "", 127, 0)
End Sub

[carspoo200]

This has always worked for me

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub cmdOpenCD_Click()
Dim OpenCDDrive As Long
OpenCDDrive = mciSendString("set CDAudio door open", "", 127, 0)
End Sub

how could you change this code to close the drive???

[Ellis Dee]

' Close drive door
Public Sub CloseDoor(Optional ByVal Drive As String = "(default)")
'    If Drive = "(default)" Then
        mciSendString "Set CDAudio Door Closed", 0&, 0&, 0&
'    Else
'        OpenDriveDoor Drive, False
'    End If
End Sub

The commented code calls the OpenDriveDoor function from the code I posted upthread. This function allows ejecting and closing drives other than the default drive.