keep cdrom close

[student_devry01]

don't want my friends to install AOL and crap on my computer

using a timer_tick event how can i do this

a timer checks every second if the cdrom drive is open if so it closes it

please help
i have to go to class in like a hour

[moinkhan]

don't want my friends to install AOL and crap on my computer

using a timer_tick event how can i do this

a timer checks every second if the cdrom drive is open if so it closes it

please help
i have to go to class in like a hour

make your life easy... change the computer's password

[student_devry01]

i really need this code

how do i check to see if the cdrom door is open and if so close it

please help???????

[gjon]

You could get a proggy called deep freeze that will allow other people to use your computer and keep them from changing many controls/programs and whathaveyous within it.

[uniquegodwin]

Hi student_devry...
I came close to finding it..
but,Im getting an error...
heres what i tried for you..

Declare Function mciSendString Lib "winmm.dll" (ByVal command As String, _
    ByVal buffer As StringBuilder, ByVal bufferSize As Int32, _
    ByVal hwndCallback As IntPtr) As Int32
 
 
    Dim returnstring As New StringBuilder
 
 
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        mciSendString("set CDAudio door open", returnstring, 127, IntPtr.Zero)
    End Sub

The error it gives me while running is this..

An unhandled exception of type 'System.EntryPointNotFoundException' occurred in WindowsApplication14.exe

Additional information: Unable to find an entry point named mciSendString in DLL winmm.dll.

I really wish someone helps after this point...why am I getting this error??

[uniquegodwin]

Closing the cdrom door is also just set cdaudio door closed.
But,I really dont know why what ive tried doesnt work.Ill be glad if someone gives me a hand.Im also interested in knowing how to do this.

[uniquegodwin]

heyyyyy,I got ittttttttttttt

Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
  (ByVal lpszCommand As String, ByVal lpszReturnString As String, _
  ByVal cchReturnLength As Long, ByVal hwndCallback As Long) As Long
    Dim returnstring As New StringBuilder
 
 
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        mciSendString("set CDAudio door open", 0, 0, 0)
    End Sub

Dont forget the imports system.text
Hope this helps u student buddy ...Thanks,I also learnt bcos of u

[gjon]

Nice work, KUDOS!

Could you put some commenting in that code. I'd like to understand whats going on with it. =) Good job figuring it out.

[uniquegodwin]

irrrr,forgive me,That code only opens...closing doesnt work...ill find it out with my friends too

[jmcilhinney]

Can I say that using a Timer to check every second and close it if it's open is very inefficient and really dodgy code. Audio and burning software lock CD drives to prevent access so that would be the way to do it. What's to stop your friends closing your app to get access though? If you can't just tell your friends not to install things on your machine them I'd say you need new friends.

[jo0ls]

in win xp
similar in 2000 no doubt...

computer management -> Storage
right click Removable storage, click properties, click security tab
disallow Users from using the drive.

Or download a freeware drive locker...

If you insist then this will catch the message as the disk is ejected and determine if it is a cd, and get the letter (info written with debug.writeline). The meesage is passed after the eject has started, so you can't override it, but you could suck the tray back in. The messages only occur if there is a finalized CD in the tray.

Private Const GWL_WNDPROC As Long = (-4)
    Private Const WM_DEVICECHANGE As Long = &H219
    Private Const DBT_DEVNODES_CHANGED As Long = &H7
    Private Const DBT_DEVICEARRIVAL As Long = &H8000&
    Private Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004&
    Private Const DBT_DEVTYP_VOLUME As Long = &H2 ' Logical volume
    Private Const DBT_DEVTYP_DEVICEINTERFACE As Long = &H5 ' Device interface class
    Private Const DBTF_MEDIA As Long = &H1 ' Media comings and goings
    Private Const DBTF_NET As Long = &H2 ' Network volume
    Private Enum DriveType As Integer
        DRIVE_UNKNOWN = 0
        DRIVE_NO_ROOT_DIR = 1
        DRIVE_REMOVABLE = 2
        DRIVE_FIXED = 3
        DRIVE_REMOTE = 4
        DRIVE_CDROM = 5
        DRIVE_RAMDISK = 6
 
    End Enum
 
    Private Structure DEV_BROADCAST_HDR
        Public dbch_size As Integer
        Public dbch_devicetype As Integer
        Public dbch_reserved As Integer
    End Structure
 
    Private Structure DEV_BROADCAST_VOLUME
        Public dbcv_size As Integer
        Public dbcv_devicetype As Integer
        Public dbcv_reserved As Integer
        Public dbcv_unitmask As Integer
        Public dbcv_Flags As Short
    End Structure
 
    Private Declare Auto Function GetDriveType Lib "kernel32.dll" ( _
                ByVal nDrive As String) As DriveType
 
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
 
      
        If m.Msg = WM_DEVICECHANGE Then
            'store the wparam
            Dim WParam As Int32 = m.WParam.ToInt32()
            'Handle the CD messages
            Select Case WParam
                Case DBT_DEVICEARRIVAL
                    Debug.WriteLine(showInfo(m, WParam) & " arrived")
                Case DBT_DEVICEREMOVECOMPLETE
                    Debug.WriteLine(showInfo(m, WParam) & " removed")
                    m.Msg = &H0
            End Select
            Me.Refresh()
        End If
        'Call base WndProc for default handling
        MyBase.WndProc(m)
    End Sub
 
    Private Function showInfo(ByVal m As System.Windows.Forms.Message, ByVal WParam As Int32) As String
        Dim infoString As String
        Dim Header As DEV_BROADCAST_HDR
        Dim HeaderVolume As DEV_BROADCAST_VOLUME
        Dim HdrType As Type = GetType(DEV_BROADCAST_HDR)
        Header = CType(Marshal.PtrToStructure(m.LParam, HdrType), DEV_BROADCAST_HDR)
        If Header.dbch_devicetype = DBT_DEVTYP_VOLUME Then
            Dim Bits As BitArray
            Dim VolumeLetters As New ArrayList
            Dim Bit As Boolean
            Dim Charcode As Integer = Asc("A"c)
            HeaderVolume = CType(Marshal.PtrToStructure(m.LParam, GetType(DEV_BROADCAST_VOLUME)), DEV_BROADCAST_VOLUME)
            Bits = New BitArray(BitConverter.GetBytes(HeaderVolume.dbcv_unitmask))
            For Each Bit In Bits
                If Bit Then
                    Dim driveLetter As String = Chr(Charcode)
                    VolumeLetters.Add(Charcode)
                    Dim thisDrivetype As DriveType
                    thisDrivetype = GetDriveType(driveLetter & ":\")
                    infoString = "drive " & driveLetter & " " & thisDrivetype.ToString & vbCrLf
                End If
                Charcode += 1
            Next
        End If
        Return infoString
    End Function

requires imports system.runtime.interopservices

[jo0ls]

Heres how to do it...
You need to send IOCTL_STORAGE_MEDIA_REMOVAL using the DeviceIOControl Function, use true to lock, false to unlock.
See the msdn library for details.

Requires Windows XP, Windows 2000 Professional, or Windows NT Workstation 4.0.

Private _locked As Boolean
    Private Const INVALID_HANDLE_VALUE As Short = -1
    Private Const OPEN_EXISTING As Short = 3
    Private Const FILE_ATTRIBUTE_NORMAL As Short = &H80S
    Private Const FILE_SHARE_READ As Short = &H1S
    Private Const FILE_SHARE_WRITE As Short = &H2S
    Private Const GENERIC_READ As Integer = &H80000000
    Private Const IOCTL_STORAGE_MEDIA_REMOVAL As Integer = 2967556
 
    'We use CreateFile to get a handle to the drive
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
            (ByVal lpFileName As String, _
            ByVal dwDesiredAccess As Integer, _
            ByVal dwShareMode As Integer, _
            ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, _
            ByVal dwCreationDisposition As Integer, _
            ByVal dwFlagsAndAttributes As Integer, _
            ByVal hTemplateFile As Integer) As Integer
 
    'We use this to send PREVENT_MEDIA_REMOVAL to the drive using the handle
    Private Declare Function DeviceIoControl Lib "kernel32" ( _
            ByVal hDevice As Integer, _
            ByVal dwIoControlCode As Integer, _
            ByRef lpInBuffer As Boolean, _
            ByVal nInBufferSize As Integer, _
            ByRef lpOutBuffer As Integer, _
            ByVal nOutBufferSize As Integer, _
            ByRef lpBytesReturned As Integer, _
            ByRef lpOverlapped As OVERLAPPED) As Integer
 
 
    'Required structure, wil be passed blank
    Private Structure OVERLAPPED
        Public Internal As Integer
        Public InternalHigh As Integer
        Public offset As Integer
        Public OffsetHigh As Integer
        Public hEvent As Integer
    End Structure
 
    'Required structure, wil be passed blank
    Private Structure SECURITY_ATTRIBUTES
        Dim nLength As Integer
        Dim lpSecurityDescriptor As Integer
        Dim bInheritHandle As Integer
    End Structure
 
    'Close the handle we got by using CreateFile to open the drive
    Private Declare Function CloseHandle Lib "kernel32" ( _
            ByVal hObject As Integer) As Integer
 
    Private Function LockMedia(ByRef DriveLetter As String, ByRef Lock As Boolean) As Boolean
        'convert drive letter to a device path
        Dim FullDrivePath As String = "//./" & DriveLetter
        Dim hDrive As Integer
 
        hDrive = CreateFile(FullDrivePath, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, _
        New SECURITY_ATTRIBUTES, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
 
        If hDrive <> INVALID_HANDLE_VALUE Then
            LockMedia = CBool(DeviceIoControl(hDrive, IOCTL_STORAGE_MEDIA_REMOVAL, _
            Lock, 1, 0, 0, New Integer, New OVERLAPPED))
 
            Call CloseHandle(hDrive)
        End If
    End Function
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
 
        If _locked Then
            'pass the drive letter and a colon, then true to lock, false to unlock.
            'if you lock n times then you have to unlock n times to get control back. 
 
            LockMedia("E:", False)
            Button1.Text = "Lock"
            Me.Text = "Drive E is unlocked"
        Else
            LockMedia("E:", True)
            Button1.Text = "Unlock"
            Me.Text = "Drive E is locked"
        End If
        _locked = Not _locked
 
    End Sub

[uniquegodwin]

Thanks JoOLs This works superb to lock the drive.

[uniquegodwin]

Anyways,for whoever wants how to close the door also..here it is...
The reason it didnt work for me 1st was that I was so stupid to give the mci command wrong...sorry..lol

Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpszCommand As String, ByVal lpszReturnString As String, _
ByVal cchReturnLength As Long, ByVal hwndCallback As Long) As Long
 
    Private Sub opencd()
        mciSendString("set CDAudio door open", 0, 0, 0)
    End Sub
    Private Sub closecd()
        mciSendString("set CDAudio door closed", 0, 0, 0)
    End Sub

Well,this is just for information.As Jm said and as code given by joOls,follow it to lock the drive instead of using a timer to close it.The code given by joOls above works very fine

[uniquegodwin]

Nice work, KUDOS!

Could you put some commenting in that code. I'd like to understand whats going on with it. =) Good job figuring it out.

Hey,I have a commented version for u here..I put it in the codebank too so that it might be of help to someone else too...
here it is...
http://www.vbforums.com/showthread.php?t=357496

[Hiroshi]

hey how do you specify whether it opens which drive?

[uniquegodwin]

Good question Hiroshi I myself have to figure that out..Thanks for asking..Ill get back soon

[jo0ls]

I started stripping down some IMAPI code to make something to enumerate the cdroms and eject, but it is still enormous, and anyway it will only do burner drives.
So here is another way instead, using windows media players api:

'look in oject browser: com component windows media player (wmp.dll)
    Dim WithEvents lv As New ListView
    Dim wmp As Object
    Dim cdroms As Object
    Dim cdrom As Object
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        lv.View = View.Details
        lv.Dock = DockStyle.Fill
        lv.Columns.Add("Cdrom identifier", 100, HorizontalAlignment.Left)
        lv.MultiSelect = False
        Me.Controls.Add(lv)
        wmp = CreateObject("WMPlayer.OCX.7")
        cdroms = wmp.cdromCollection
        For i As Long = 0 To wmp.cdromCollection.count - 1
            cdrom = cdroms.item(i)
            Dim lvi As New ListViewItem
            lvi.Text = cdrom.drivespecifier
            lvi.Tag = i
            lv.Items.Add(lvi)
        Next
    End Sub
 
    'double click an item to eject
    Private Sub lv_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles lv.DoubleClick
        If lv.SelectedItems(0) Is Nothing Then Exit Sub
        Dim index As Integer = lv.SelectedItems(0).Tag ' we stored the cdrom index in the tag
        cdrom = cdroms.item(index)
        cdrom.eject()
    End Sub

I think there might be another way too, I'll pursue it...

[jo0ls]

staring me in the face, very much like the code to lock the drive above:

Private Const INVALID_HANDLE_VALUE As Short = -1
    Private Const OPEN_EXISTING As Short = 3
    Private Const FILE_ATTRIBUTE_NORMAL As Short = &H80S
    Private Const FILE_SHARE_READ As Short = &H1S
    Private Const FILE_SHARE_WRITE As Short = &H2S
    Private Const GENERIC_READ As Integer = &H80000000
 
    'Similar to the one to lock the drive above, but we send this message:
    Private Const IOCTL_STORAGE_EJECT_MEDIA = &H2D4808
    'oh, load aswell whilst I'm here...
    Private Const IOCTL_STORAGE_LOAD_MEDIA = &H2D480C
 
    Private Declare Function DeviceIoControl Lib "kernel32" _
    (ByVal hDevice As Integer, _
     ByVal dwIoControlCode As Integer, _
     ByRef lpInBuffer As Object, _
     ByVal nInBufferSize As Integer, _
     ByRef lpOutBuffer As Object, _
     ByVal nOutBufferSize As Integer, _
     ByRef lpBytesReturned As Integer, _
     ByRef lpOverlapped As OVERLAPPED) As Integer
 
    'We use CreateFile to get a handle to the drive
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
            (ByVal lpFileName As String, _
            ByVal dwDesiredAccess As Integer, _
            ByVal dwShareMode As Integer, _
            ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, _
            ByVal dwCreationDisposition As Integer, _
            ByVal dwFlagsAndAttributes As Integer, _
            ByVal hTemplateFile As Integer) As Integer
 
    'Required structure, wil be passed blank
    Private Structure SECURITY_ATTRIBUTES
        Dim nLength As Integer
        Dim lpSecurityDescriptor As Integer
        Dim bInheritHandle As Integer
    End Structure
 
    'Close the handle we got by using CreateFile to open the drive
    Private Declare Function CloseHandle Lib "kernel32" ( _
            ByVal hObject As Integer) As Integer
 
    'Required structure, wil be passed blank
    Private Structure OVERLAPPED
        Public Internal As Integer
        Public InternalHigh As Integer
        Public offset As Integer
        Public OffsetHigh As Integer
        Public hEvent As Integer
    End Structure
 
    Private Function EjectMedia(ByRef DriveLetter As String) As Boolean
        'convert drive letter to a device path
        Dim FullDrivePath As String = "//./" & DriveLetter
        Dim hDrive As Integer
 
        hDrive = CreateFile(FullDrivePath, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, _
        New SECURITY_ATTRIBUTES, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
 
        Dim lpBytesReturned As Integer
        If hDrive <> INVALID_HANDLE_VALUE Then
            EjectMedia = CBool(DeviceIoControl(hDrive, IOCTL_STORAGE_EJECT_MEDIA, _
            0, 0, 0, 0, lpBytesReturned, New OVERLAPPED))
            Call CloseHandle(hDrive)
        End If
    End Function
 
    Private Function LoadMedia(ByRef DriveLetter As String) As Boolean
        'convert drive letter to a device path
        Dim FullDrivePath As String = "//./" & DriveLetter
        Dim hDrive As Integer
 
        hDrive = CreateFile(FullDrivePath, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, _
        New SECURITY_ATTRIBUTES, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
 
        Dim lpBytesReturned As Integer
        If hDrive <> INVALID_HANDLE_VALUE Then
            LoadMedia = CBool(DeviceIoControl(hDrive, IOCTL_STORAGE_LOAD_MEDIA, _
            0, 0, 0, 0, lpBytesReturned, New OVERLAPPED))
            Call CloseHandle(hDrive)
        End If
    End Function
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        EjectMedia("D:")
    End Sub
 
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        LoadMedia("D:")
    End Sub

edit: added load_media as well, but I can't test it as I'm on a laptop that can't load cds itself. Now I just need to combine the lot, to programatically eject and load, and fire events when the user ejects or loads or adds a usb drive. It would be a useful class.

[uniquegodwin]

cool ...Thanks for this one..
but,I wonder if it can be done using shorter code too