Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 1 марта!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Список CD-дисководов, открытие, закрытие

Сидит Билл Гейтс за компьютером. Подходит сынишка:
- Пап, а правда, что твой 95-ый многозадачный?
- Правда, сынок.
- А покажи, как эта многозадачность работает?!
- Сейчас, погоди, дискету доформатирую...


 // Данная прога извлекает и закравет CD-ROM выбранные в Combobox1
 // На форме разместите Button1, Button2 и Combobox1
 
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, ComCtrls, MMSystem;
 
 type
   TForm1 = class(TForm)
     Button1: TButton;
     Button2: TButton;
     ComboBox1: TComboBox;
     procedure Button1Click(Sender: TObject);
     function CloseCD(Drive : string) : Boolean;
     function OpenCD(Drive : string) : Boolean;
     procedure FormCreate(Sender: TObject);
     procedure Button2Click(Sender: TObject);
   private
   public
 end;
 
 var
   Form1: TForm1;
   Driv: array [1..25] of string;
 
 implementation
 
 {$R *.dfm}
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   OpenCD(ComboBox1.Text);
 end;
 
 function TForm1.OpenCD(Drive: string): Boolean;
 var
   Res : MciError;
   OpenParm: TMCI_Open_Parms;
   Flags : DWord;
   S : string;
   DeviceID : Word;
 begin
   Result:=false;
   S:=Drive;
   Flags:=mci_Open_Type or mci_Open_Element;
   with OpenParm do
   begin
     dwCallback := 0;
     lpstrDeviceType := 'CDAudio';
     lpstrElementName := PChar(S);
   end;
   Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
   if Res<>0 then
     exit;
   DeviceID:=OpenParm.wDeviceID;
   try
     Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
     if Res=0 then
       exit;
     Result:=True;
   finally
     mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
   end;
 end;
 
 function TForm1.CloseCD(Drive: string): Boolean;
 var
   Res : MciError;
   OpenParm: TMCI_Open_Parms;
   Flags : DWord;
   S : string;
   DeviceID : Word;
 begin
   Result:=false;
   S:=Drive;
   Flags:=mci_Open_Type or mci_Open_Element;
   with OpenParm do
   begin
     dwCallback := 0;
     lpstrDeviceType := 'CDAudio';
     lpstrElementName := PChar(S);
   end;
   Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
   if Res<>0 then
     exit;
   DeviceID:=OpenParm.wDeviceID;
   try
     Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
     if Res=0 then
       exit;
     Result:=True;
   finally
     mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
   end;
 end;
 
 procedure TForm1.FormCreate(Sender: TObject);
 var
   w:dword;
   Root:string;
   I, K:integer;
 begin
   k:=0;
   w:=GetLogicalDrives;
   Root := '#:';
   for i := 0 to 25 do
   begin
     Root[1] := Char(Ord('A')+i);
     if (W and (1 shl i))>0 then
       if GetDriveType(Pchar(Root)) = DRIVE_CDROM then
       begin
         k:=k+1;
         Driv[k] := Root;
         ComboBox1.Items.Add(Driv[k]);
         ComboBox1.Text := Driv[1];
       end;
   end;
 end;
 
 procedure TForm1.Button2Click(Sender: TObject);
 begin
   CloseCD(ComboBox1.Text);
 end;
 
 end.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS