Ouverture et fermeture d'un lecteur CD [Résolu]

Signaler
Messages postés
470
Date d'inscription
vendredi 14 novembre 2003
Statut
Membre
Dernière intervention
23 octobre 2007
-
Messages postés
470
Date d'inscription
vendredi 14 novembre 2003
Statut
Membre
Dernière intervention
23 octobre 2007
-
bonjour à tous,

ma question est la suivante,

y a t-il à moyen de gérer l'open et le close d'un (ou de plusieurs)
lecteur(s) CD. Plus précisément:

Détection des lecteurs CD
Open ou Close les lecteurs CD (on choisi celui kon veut)

Le tout sans utiliser de composant ou sans Tmediaplayer, simplement avec
du code.

Merci d'avance pour vos réponse

Filipe

14 réponses

Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
2
En effet on ne peut pas instancier une classe contenant des methodes abstraites.
Donc on est obligé d'utiliser un des descendants.

c'est a en perdre la tete ces classes abstraites ...

L'embetant c'est que la fonction s'execute une seconde fois lorsqu'on apelle Free. Si la fonction est longue (20 sec), ca fait du temps perdu pour rien.

Mais je suis d'accord avec ton raisonnement, cela me parait aussi logique de liberer ce que l'on a cree.

DONC pour ne pas avoir a re-executer la fonction pour liberer la memoire il faut donc la transformer en procedure.

Finalement , si j'ai bien compris, une fonction qui resulte une instance de classe est à éviter.

En gros, transformer cette procedure (Celle qui liste les lecteurs) en fonction n'est pas une bonne idee.

Donc la voila cette procedure (la même qu'en haut) :
procedure ListerLecteursCD (var Dans : TStrings);
var
i : integer;
LecteurATester : string;
begin
for i:=65 to 65+26 do
begin
LecteurATester:=Chr(i) + ':\';
case GetDriveType(PChar(LecteurATester)) of
DRIVE_CDROM : Dans.Add(LecteurATester);
end;
end;
end;

que l'on apelle comme suit :
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Clear;
Listbox1.Items := ListerLecteursCD;
ListerLecteursCD.Free;
end;

Eh bien j'y serais arrivé !! :big)

Merci a toi japee et a bientôt,
Florent

Si tu ne te plantes pas ......
tu ne poussera jamais
Messages postés
1725
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
11 avril 2021
8
N'oublie pas de libérer la TStringList, Florent...

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Clear;
  Listbox1.Items := ListerLecteursCD;
  ListerLecteursCD.Free; //  <=  ici  ;-)
end;


Bonne prog' :-p

japee
Messages postés
1725
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
11 avril 2021
8
J'avais un bon code qui fait bien ça, mais je n'arrive pas à mettre la main dessus.
Tu peux toujours aller voir ici :
Ouvrir et fermer le tiroir du CD ROM
ça a l'air bien.

Sinon, il y a pas mal de codes qui trainent sur internet à ce sujet => Google :big)

Bonne prog' :-p
Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
2
Salut,

Pour détecter les lecteurs CD de l'ordi tu peux essayer un truc dans le genre
procedure ListerLecteursCD (var Dans : TStrings);
var
  i : integer;
  LecteurATester : string;
begin
for i:=65 to 65+26 do
  begin
    LecteurATester:=Chr(i) + ':\';
  case GetDriveType(PChar(LecteurATester)) of
    DRIVE_CDROM : Dans.Add(LecteurATester);
  end;
  end;
end;


que tu appelle comme ceci :
procedure TForm1.Button1Click(Sender : TObject);
begin
ListBox1.Clear;
ListerLecteursCD(ListBox1.Items);
end;


Pour ouvrir/fermer le tiroir CD tu utilise ceci : (n'est pas de moi)
uses
  [...], MMSystem;

function OpenCD(Drive: String): Boolean;
var
  OpenParm: TMCI_Open_Parms;
  Flags: DWord;
  DeviceID : Word;
  Error: MciError;
  ErrorText: PChar;
  LenghtBuffer: Cardinal;
begin
  Result := False;
  Flags := mci_Open_Type or mci_Open_Element;
  with OpenParm do begin
    dwCallback := 0;
    lpstrDeviceType := 'CDAudio';
    lpstrElementName := PChar(Copy(Drive, 0, 2));
  end;
  Error := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  mciGetErrorString(Error, ErrorText, LenghtBuffer);
  if Error = 0 then
    DeviceID := OpenParm.wDeviceID
  else
    raise EAccessViolation.Create(ErrorText);
  try
    Error := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
    mciGetErrorString(Error, ErrorText, LenghtBuffer);
  finally
    mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  end;
    if Error = 0 then
      Result := True
    else
      raise EAccessViolation.Create(ErrorText);
end;

et tu remplaces MCI_SET_DOOR_OPEN par MCI_SET_DOOR_CLOSED pour refermer le tiroir.

en esperant avoir éclairé ta lanterne
Florent

PS: Au fait est-ce que qqn sait pouquoi dans la premiere procedure on ne peut pas utiliser If GetDriveType(PChar(LecteurATester)) = DRIVE_CDROM ??

Si tu ne te plantes pas ......
tu ne poussera jamais
Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
2
Désolé nos messages se sont croises.

Pour info le code dont tu donnes le lien vient de la FAQ developpez.com et donc puisque j'ai trouve celui la sur la FAQ bin c'est le meme lol.

@ ++
Florent

Si tu ne te plantes pas ......
tu ne poussera jamais
Messages postés
1725
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
11 avril 2021
8
Salut, Florent

Pour répondre à ta question

if GetDriveType(PChar(LecteurATester)) = DRIVE_CDROM  then Dans.Add(LecteurATester);


fonctionne sans problème...

Là où ça cloche, c'est ta manière d'appeler la procedure ListerLecteursCD. Sauf erreur, il faut d'abord créer une TStringList, et la libérer ensuite, comme ceci :

procedure TForm1.Button1Click(Sender: TObject);
var StringList: TStrings;
begin
  StringList := TStringList.Create;
  ListBox1.Clear;
  ListerLecteursCD(StringList);
  ListBox1.Items.Assign(StringList);
  StringList.Free;
end;


A + ;)
eh oui eh oui ...

Mais c'est que cela marche
if GetDriveType(PChar(LecteurATester)) = DRIVE_CDROM then Dans.Add(LecteurATester);

Bizarre puisqu'avant Delphi me disait erreur D'operateur ...
Mais cela marche. 8-)

Pour résumer et ne pas se casser la tête on peut y transformer en fonction :
function ListerLecteursCD : TStrings;
var
i : integer;
LecteurATester : string;
begin
result:=TStringList.Create; // merci japee pour ce truc ...
for i:=65 to 65+26 do
begin
LecteurATester:=Chr(i) + ':\';
if GetDriveType(PChar(LecteurATester)) = DRIVE_CDROM then
result.Add(LecteurATester);
end;
end;


Qure l'on apelle comme suit
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Clear;
Listbox1.Items:=ListerLecteursCD;
end;


Et voila !!!! :-p

Je vais finir par y arriver .......
@ ++
Florent

Si tu ne te plantes pas ......
tu ne poussera jamais
Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
2
Merci je ne savais pas ...
Cela veut dire que la fonction est executée deux fois... ??

@ ++
Florent
Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
2
J'ai vérifié, la fonction est bien executée deux fois : la 2eme pour rien ...

Je crois donc que la StringList se libere d'ele même vu que la variable "result" (locale) n'est plus allouée à la fin de la fonction .

Le FREE serait de trop.

Par contre un truc me chagrine : on dit que "result" est de type TStrings et on l'instance avec le constructeur du TStringList .
C'est étrange.
Donc result est de type TStrings mais on alloue la memoire avec le Create du TStringList : a-t-on au final un TStrings ou un TStringList ??
(sujet délicat ...)

Bref , une fois Delphiprog m'a corrigé lorsque j'avais mis un free a la fin de la fonction (c'est sûr que cela est nul vu que cela libere tout) et ne m'as pas dit qu'il fallait appeler une autre fois la fonction.

Voila

Amitiés,
Florent

Si tu ne te plantes pas ......
tu ne poussera jamais
Messages postés
1725
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
11 avril 2021
8
TStringList est une classe dérivée de TStrings.

TStrings est la classe de base abstraite de tous les objets représentant une liste de chaînes.
Il semble qu'il faille utiliser une classe descendant de TStrings (comme TStringList) pour manipuler les listes de chaînes.

Si tu fais "result := TStrings.Create;", le compilateur ne refuse pas la compilation, mais t'avertit :
'Construction d'instance de 'TStrings' contenant des méthodes abstraites',
et à l'exécution tu auras une erreur 'EAbstractError'. Essaye !

Ensuite, dans la mesure où est créée l'instance "Result := TStringList.Create;" il me paraît normal de libérer la StringList après usage.
Comme tu ne peux le faire avant d'avoir retourné le résultat, tu le fais après utilisation du résultat (qui est bien, je n'ai pas l'ombre d'un doute, sous la forme TStringList).

Je ne peux t'en dire plus, progressant souvent moi-même par tâtonnements. On appelle ça apprendre sur le tas.

Mais je te renvoie à l'aide en ligne de Delphi, rubriques "TStrings" et "TStringList". Ce n'est pas inintéressant...

Bonne prog' à toi :-p
Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
2
Mince que l'on apelle comme suit :
procedure TForm1.Button1Click(Sender: TObject);
var Liste: TStrings;
begin
Liste := TStringList.Create;
ListBox1.Clear;
ListerLecteursCD(Liste);
ListBox1.Items.Assign(Liste);
Liste.Free;
end;


Je vais me reposer ....... %-6
@ + Florent

Si tu ne te plantes pas ......
tu ne poussera jamais
Messages postés
470
Date d'inscription
vendredi 14 novembre 2003
Statut
Membre
Dernière intervention
23 octobre 2007
1
merci bocou à tous c nikel

encore merci

bonne prog à tous

filipe
Messages postés
1725
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
11 avril 2021
8
Si c'est nickel, Filipe35, peux-tu valider les réponses acceptées ?
Florenth et moi, on s'est donné du mal, lol.
Alors, si c'est résolu, ça pourra en dépanner d'autres, qui se posent la même question, et qui viendront voir la réponse ici.
D'où l'intérêt de valider les réponses satisfaisantes...
CQFD (quod errat demonstrandum, en patois latin)

japee ;)
Messages postés
470
Date d'inscription
vendredi 14 novembre 2003
Statut
Membre
Dernière intervention
23 octobre 2007
1
oui pa de probleme, je croyai lavoir fait mais en fait non

encore merci à vous deux

bonne prog à tous

filipe