AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Herausfinden ob das CDRom Laufwerk geöffnet ist.
Thema durchsuchen
Ansicht
Themen-Optionen

Herausfinden ob das CDRom Laufwerk geöffnet ist.

Ein Thema von StefanG · begonnen am 15. Sep 2006 · letzter Beitrag vom 3. Nov 2006
Antwort Antwort
StefanG

Registriert seit: 23. Feb 2006
74 Beiträge
 
#1

Herausfinden ob das CDRom Laufwerk geöffnet ist.

  Alt 15. Sep 2006, 15:32
Hallo,

wie der Titel schon sagt, versuche ich herauszufinden, ob mein CDRom Laufwerk gerade geöffnet oder geschlossen ist.

Ich habe da die Funktion mciSendCommand gefunden und Folgendes probiert :

Code:
uses mmsystem;

function IsOpen(drive : string) : Boolean;
var
  Flags : Dword;
  OpenParam : TMCI_OPEN_PARMS;
  Status   : TMCI_STATUS_PARMS;
  res      : MCIError;
  DeviceID : Word;
begin
  Result := False;
  Flags := MCI_OPEN_TYPE or MCI_OPEN_ELEMENT;
 
  with OpenParam do
  begin
    dwCallback := 0;
    lpstrDeviceType := 'CDAudio';
    lpstrElementName := Pchar(drive);
  end;
 
  res := mciSendCommand(0, MCI_OPEN, Flags, LongInt(@OpenParam));
  if Res <> 0 then Exit;

  DeviceID := OpenParm.wDeviceID;
  try
    status.dwItem := MCI_STATUS_MODE;
    Res := mciSendCommand(DeviceID, MCI_STATUS, MCI_STATUS_ITEM, LongInt(@status));
    result := status.dwReturn = MCI_MODE_OPEN;
  finally
    mciSendCommand(DeviceID, MCI_CLOSE, Flags, Longint(@OpenParm));
  end;
end;
das Gerät scheint er vernünftig zu öffnen, es gibt auch weder Fehler beim kompilieren noch beim Ausführen, soll heißen "res" ist immer 0.

Jedoch ist status.dwReturn auch immer = MCI_MODE_OPEN...auch wenn das CD Laufwerk geschlossen ist.
Was mache ich falsch?
  Mit Zitat antworten Zitat
Wishmaster

Registriert seit: 14. Sep 2002
Ort: Steinbach, MB, Canada
301 Beiträge
 
Delphi XE2 Architect
 
#2

Re: Herausfinden ob das CDRom Laufwerk geöffnet ist.

  Alt 18. Sep 2006, 00:54
Hi

Ich hatte keine zeit deinen code zu testen aber feileicht hilft dir das weiter.

Fiel Spaß beim testen


Delphi-Quellcode:
unit CDControl;

interface

uses
  Windows, Dialogs, SysUtils, Classes;



 Const
    VWIN32_DIOC_DOS_IOCTL : longint = 1;
    IOCTL_STORAGE_MEDIA_REMOVAL = $2D4804;
    IOCTL_STORAGE_EJECT_MEDIA = $2D4808;
    IOCTL_STORAGE_LOAD_MEDIA = $2D480C;
    IOCTL_STORAGE_CHECK_VERIFY = $2D4800;

{Eject Media}
  type
   TIoCtlRegs = record
    EBX : DWORD;
    EDX : DWORD;
    ECX : DWORD;
    EAX : DWORD;
    EDI : DWORD;
    ESI : DWORD;
    Flags : DWORD;
   end;

{Lock Media}

   PREVENT_MEDIA_REMOVAL = record
     p1: byte;
   end;

   PREVENT_MEDIA_REMOVAL1 = record
    p1: byte;
    p2: byte;
   end;

{}


type
  TCDControl = Class(TObject)
   private


   public
    function CDDriveCount : Integer;
    function Check_Media(Drive : Char) : Boolean;
    function Eject_Media(Drive : Char) : Boolean;
    function Load_Media(Drive: Char): Boolean;
    function Lock_UnLock(drive: char; lock: boolean) : boolean;
  end;

var cdc : TCDControl;

implementation


function TCDControl.CDDriveCount : Integer;
var i, fType : integer;
    s : String;
begin
   result:= 0;
  for I := 0 to 25 do
   begin
      s:= Chr(i+65)+':\';
      fType:= GetDriveType(Pchar(s));
  if (ftype = DRIVE_CDROM) then
   begin
   inc(result);
  end;
 end;
end;


{-------------------------- Check Media Availability --------------------------}

function TCDControl.Check_Media(Drive : Char) : boolean;
var
  hDevice: THandle;
  bytesReturned: DWORD;
begin
    result:= false;
   try
     hDevice:= CreateFile(PChar('\\.\' + Drive + ':'),
                          GENERIC_READ,
                          FILE_SHARE_READ Or
                          FILE_SHARE_WRITE, nil,
                          OPEN_EXISTING, 0, 0);

   If hDevice <> INVALID_HANDLE_VALUE Then
    begin
      result:= DeviceIoControl(hDevice,
                               IOCTL_STORAGE_CHECK_VERIFY,
                               nil, 0, nil, 0,
                               bytesReturned, nil);
      CloseHandle(hDevice);
     end;
 except
  on E : Exception do
   ShowMessage(E.Message);
 end;
end;

{---------------------------- Eject Removable Media ---------------------------}

function TCDControl.Eject_Media(Drive : Char) : Boolean;
var
  hDevice: THandle;
  bytesReturned: DWORD;
  DriveStr: String;
  ctrlcode: Cardinal;
  Regs: TIoCtlRegs;
begin
  Result:=FALSE;

  try
    DriveStr:='\\.\' + Drive + ':';
    hDevice := CreateFile(PAnsiChar(DriveStr),
                          GENERIC_READ,
                          FILE_SHARE_READ or
                          FILE_SHARE_WRITE, nil,
                          OPEN_EXISTING, 0, 0);

    if hDevice <> INVALID_HANDLE_VALUE then
     begin
      Result := DeviceIoControl(hDevice,
                                IOCTL_STORAGE_EJECT_MEDIA,
                                nil, 0, nil, 0,
                                bytesReturned, nil);
      CloseHandle(hDevice);
    if Result then
      Exit;
     end;
  except
    on E : Exception do
       ShowMessage(E.Message);
     end;
   try
       hDevice := CreateFile('\\.\VWIN32', 0, 0, nil, 0, FILE_FLAG_DELETE_ON_CLOSE, 0);
    if hDevice = INVALID_HANDLE_VALUE then Exit;
     with Regs do begin
      EAX := $440D;
      EBX := Ord(UpCase(Drive)) - Ord('A') + 1;
      ECX := $0849;
      Flags := $0001;
    end;
     Result := DeviceIOControl(hDevice, 1,
                               @Regs, SizeOf(Regs),
                               @Regs, SizeOf(Regs),
                               bytesReturned, nil);
     CloseHandle(hDevice);
  except
   on E : Exception do
    ShowMessage(E.Message);
  end;
end;

{---------------------------- Load Removable Media ----------------------------}

function TCDControl.Load_Media(Drive: Char): Boolean;
var
  hDevice: THandle;
  bytesReturned: DWORD;
  ctrlcode: Cardinal;
  Regs: TIoCtlRegs;
begin
   Result:= FALSE;
  try
    hDevice := CreateFile(PChar('\\.\' + Drive + ':'),
                          GENERIC_READ,
                          FILE_SHARE_READ or
                          FILE_SHARE_WRITE, nil,
                          OPEN_EXISTING, 0, 0);

    if hDevice <> INVALID_HANDLE_VALUE then
     begin
       Result := DeviceIoControl(hDevice,
                                 IOCTL_STORAGE_LOAD_MEDIA,
                                  nil, 0, nil, 0,
                                  bytesReturned, nil);
       CloseHandle(hDevice);
     if Result then
      Exit;
    end;
  except
   on E : Exception do
    ShowMessage(E.Message);
  end;
  try
     hDevice := CreateFile('\\.\VWIN32', 0, 0, nil, 0, FILE_FLAG_DELETE_ON_CLOSE, 0);
  if hDevice = INVALID_HANDLE_VALUE then
     Exit;
    with Regs do
      begin
        EAX := $440D;
        EBX := Ord(UpCase(Drive)) - Ord('A') + 1;
        ECX := $0849;
        Flags := $0001;
     end;
    Result := DeviceIOControl(hDevice,
                              VWIN32_DIOC_DOS_IOCTL,
                              @Regs, SizeOf(Regs),
                              @Regs, SizeOf(Regs),
                              bytesReturned, nil);
   if Regs.Flags and 1 = 1 then
    case Regs.EAX of
     $01 : ShowMessage('The function is not supported.');
     $B1 : ShowMessage('The volume is locked in the drive.');
     $B2 : ShowMessage('The volume is not removable.');
     $B5 : ShowMessage('The valid eject request has failed.');
    end;
    CloseHandle(hDevice);
  except
   on E : Exception do
    ShowMessage(E.Message);
  end;
end;

{------------------------- Lock+UnLock Removable Media ------------------------}

function TCDControl.Lock_UnLock(drive: char; lock: boolean) : boolean;
 var osv: _osversioninfoA;
     retdummy: cardinal;
     retdummy1: boolean;
     hLwStatus: cardinal;
     xlockdrive,hdrivex: string;
     rawstuff: TIoCtlRegs;
     pmr32: prevent_media_removal;
     pmr9x: prevent_media_removal1;
begin
    result:= false;

   if lock = True then
    begin
      PMR32.P1 := 1;
      PMR9x.P1 := 0;
     end
   else
    begin
      PMR32.P1 := 0;
      PMR9x.P1 := 1;
    end;

     PMR9x.P2 := 0;
     OSV.dwOSVersionInfoSize := 148;
     retDummy1 := GetVersionExA(OSV);
     xLockDrive := copy(upcase(drive), 1,1);
     hDriveX := xLockDrive + ':';

   if OSV.dwPlatformId >= 2 then
    begin
       hLwStatus := CreateFile(pchar('\\.\' + hDriveX),
                               GENERIC_WRITE or
                               GENERIC_READ, 0, 0,
                               OPEN_EXISTING,
                               FILE_ATTRIBUTE_NORMAL,0);

    if hLwStatus <> INVALID_HANDLE_VALUE then
     begin
       result:= DeviceIoControl(hLwStatus,
                                IOCTL_STORAGE_MEDIA_REMOVAL,
                                @PMR32.p1,
                                sizeof(pmr32), 0, 0,
                                retDummy, 0);
       CloseHandle(hlwstatus);
      end;
     end
   else
    begin
      hLwStatus := CreateFile('\\.\VWIN32', 0, 0, 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0);
   if hLwStatus <> INVALID_HANDLE_VALUE then
    begin
      RawStuff.EBX := ord(hDriveX[1]) - ord('A') + 1;
      RawStuff.EAX := $440D;
      RawStuff.ECX := $48 or $800;
      RawStuff.EDX := PMR9x.p1;
      result:= DeviceIoControl(hLwStatus,
                               VWIN32_DIOC_DOS_IOCTL,
                               @RawStuff, sizeof(RawStuff),
                               @RawStuff, sizeof(RawStuff),
                               retDummy, 0);
      CloseHandle(hLwStatus);
    end;
  end;
end;



end.
//test

Delphi-Quellcode:


uses CDControl;


 if cdc.Eject_Media('k') then
  Caption:= ';-)'
 else
  Caption:= ':-('
  Mit Zitat antworten Zitat
Benutzerbild von Sunlight7
Sunlight7

Registriert seit: 17. Sep 2006
Ort: Sonnensystem, Zentral
1.522 Beiträge
 
Delphi 5 Standard
 
#3

Re: Herausfinden ob das CDRom Laufwerk geöffnet ist.

  Alt 18. Sep 2006, 06:30
Zitat von StefanG:
Jedoch ist status.dwReturn auch immer = MCI_MODE_OPEN...auch wenn das CD Laufwerk geschlossen ist.
Was mache ich falsch?
Soweit ich mich noch erinnern kann ist MCI_MODE_OPEN das Flag dafür, das das MCI Gerät (Wave, AVI, Midi...) geöffnet ist, nicht das CD-Laufwerk.
Ist schon lange her, das ich mich mit MCI gespielt habe ...
Windows: Ja - Microsoft: Nein -> www.ReactOS.org
  Mit Zitat antworten Zitat
Benutzerbild von Mackhack
Mackhack

Registriert seit: 29. Nov 2003
Ort: San Diego, CA/USA
1.446 Beiträge
 
Delphi 2006 Architect
 
#4

Re: Herausfinden ob das CDRom Laufwerk geöffnet ist.

  Alt 18. Sep 2006, 07:14
Hier hab ich auch noch was gefunden:

Google-Borland-NG
Um etwas Neues zu schaffen muss man seine Ohren vor den Nein-sagern verschliessen um seinen Geist öffnen zu können.
(George Lukas)
  Mit Zitat antworten Zitat
Benutzerbild von Garfield
Garfield

Registriert seit: 9. Jul 2004
Ort: Aken (Anhalt-Bitterfeld)
1.335 Beiträge
 
Delphi XE5 Professional
 
#5

Re: Herausfinden ob das CDRom Laufwerk geöffnet ist.

  Alt 3. Nov 2006, 13:58
Zitat von Wishmaster:
Delphi-Quellcode:
result:= DeviceIoControl(hDevice,
                               IOCTL_STORAGE_CHECK_VERIFY,
                               nil, 0, nil, 0,
                               bytesReturned, nil);
Damit wird geprüft, ob auf einen Datenträger zugegriffen werden kann. Heißt, Result ist

False - wenn die Schublade geöffnet oder bei geschlossener Schublade kein Datenträger eingelegt ist.
True - wenn die Schublade geschlossen und ein Datenträger eingelegt ist.
Gruss Garfield
Ubuntu 22.04: Laz2.2.2/FPC3.2.2 - VirtBox6.1+W10: D7PE, DXE5Prof
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:33 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz