Сходи на http://pascal.sources.ru, я где там видел, только не на VB кажется.

Ответить

Ответить

Пиши сейчас нету времени отвечать!"

asvelin@yandex.ru

Ответить

Добавь кнопку и скопируй в код формы:

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

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long

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 = &H2D4808

Private Const IOCTL_STORAGE_LOAD_MEDIA = &H2D480C

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

Private Sub CD_Eject(ByVal Drive As String)

Dim hDrive As Long, DummyReturnedBytes As Long

Dim EjectDrive As String

Dim RawStuff As DIOC_REGISTERS

Drive = UCase(Left$(Drive & ":", 2))

If GetVersion >= 0 Then ' Запущена Windows NT/2000

hDrive = CreateFile("\\.\" & Drive, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)

If hDrive <> INVALID_HANDLE_VALUE Then

DeviceIoControl hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0, 0, DummyReturnedBytes, ByVal 0

CloseHandle hDrive

End If

Else 'Запущена Windows 9x/Me

hDrive = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)

If hDrive <> INVALID_HANDLE_VALUE Then

'Используем прерывание 21h функция 440Dh код 49h (звучит!)

RawStuff.reg_EAX = &H440D

RawStuff.reg_EBX = Asc(Drive) - Asc("A") + 1 ' Номер диска

RawStuff.reg_ECX = &H49 Or &H800

DeviceIoControl hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff, LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0

CloseHandle hDrive

End If

End If

End Sub

Private Sub Command1_Click()

CD_Eject "e" ' откроется диск E:

CD_Eject "f" ' откроется диск F:

End Sub

Ответить