Програмное открытие дисковода

Alexxxx · #1 30.01.2007, 18:46

Как програмно открыть несколько дисководов (если есть DVD-RW и CD-ROM)?

Ferra · #2 30.01.2007, 19:53

читай дельфиворлд....

в двух словах: перебираешь дисководы от "A" до "Z" и проверяшь: если это cd-rom, то открываешь его....
я понимаю что это банально, но извини delphiworld под рукой нету(как сейчас помню - смотри в последнем разделе

)

Artem28 · #3 30.01.2007, 22:02

Код:

unit DriveTools; 

interface 

uses 

  Windows, SysUtils, MMSystem; 

function CloseCD(Drive: Char): Boolean; 
function OpenCD(Drive: Char): Boolean; 

implementation 

function OpenCD(Drive: Char): 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 CloseCD(Drive: Char): 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; 

end.

Полный код...

Alexxxx · #4 03.02.2007, 17:01

Big respect!!!!!

dron-s · #5 08.02.2007, 14:18

в общем, в чём заключалась мысль (идея) в том чтобы при старте проги, определить сколько приводов в системе и какие буквы они занимают, записать их куда нибудь (я выбрал ComboBox) а потом по очереди в цикле их открывать и закрывать...
вот полный код проекта: на форму кинуть один батон и ComboBox

Код:

uses
  MMSystem;
//...

//Инициализация приводов в системе
procedure TForm1.FormCreate(Sender: TObject);
var
  w:dword;
  Root:string;
  I, K:integer;
  Driv: array [1..25] of string;
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;

//функция на открытие привода
function 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 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.Button1Click(Sender: TObject);
var
 i:integer;
begin
  for I := 0 to Combobox1.Items.Count do
   if not openCD(ComboBox1.Items[i]) then
     CloseCD(ComboBox1.Items[i]);
end;

Alexxxx · #6 08.02.2007, 16:57

Цитата:

Сообщение от dron-s

в общем, в чём заключалась мысль (идея) в том чтобы при старте проги, определить сколько приводов в системе и какие буквы они занимают, записать их куда нибудь (я выбрал ComboBox) а потом по очереди в цикле их открывать и закрывать...
вот полный код проекта: на форму кинуть один батон и ComboBox

Код:

uses
  MMSystem;
//...

//Инициализация приводов в системе
procedure TForm1.FormCreate(Sender: TObject);
var
  w:dword;
  Root:string;
  I, K:integer;
  Driv: array [1..25] of string;
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;

//функция на открытие привода
function 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 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.Button1Click(Sender: TObject);
var
 i:integer;
begin
  for I := 0 to Combobox1.Items.Count do
   if not openCD(ComboBox1.Items[i]) then
     CloseCD(ComboBox1.Items[i]);
end;

А как сделать, чтобы в зависимости от количества дисководов автоматически добавлялись пункты в MainMenu и можно было выбрать самостоятельно открываемый дисковод?

dron-s · #7 08.02.2007, 17:29

ну дык там же написано...
только вместо ComboBox используй TMainMenu и всё...

dron-s · #8 08.02.2007, 17:39

попробуй вот так

Код:

uses
  MMSystem;
//...

//функция на открытие привода
function 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 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.addmainitem(s: string);
var
  newitem: Tmenuitem;
begin
  newitem := tmenuitem.create(Mainmenu1);
  newitem.caption := s;
  mainmenu1.items.insert(mainmenu1.items.count, newitem);
end;

//Инициализация приводов в системе
procedure TForm1.FormCreate(Sender: TObject);
var
  w:dword;
  Root:string;
  I, K:integer;
  Driv: array [1..25] of string;
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;
        addmainitem(Driv[k]);
      end;
  end;
end;

Alexxxx · #9 08.02.2007, 22:10

Dron-s, а как сделать так, чтоб у пункта меню было подменю с пунктами "Открыть дисковод" и "Закрыть дисковод"? И как правильно к этим пунктам сделать обработчики, чтоб выбрал нужное меню - и дисковод закрылся (открылся)?? Напишите, пожалуйста, исходник...

dron-s · #10 08.02.2007, 22:40

создавай для каждого дисковода по два подменю... на событие каждого подменю вешай функцию OpenCD и CloseCD соответственно...
про динамическое создание подменю почитай в справке...

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты