Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Регистрация на сайте занимает 40 секунд, а пользу приносит годами.

Дополнительные функции

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Вопросы: 0
Ответы: 0
Мини-форумы: 0

Онлайн на сайте: 121 (3404)
Онлайн в IRC: 2 (17)
Последние новости:
8 июля 2023
Последний вопрос:
9 августа 2022, 09:39
Последний ответ:
29 марта 2018, 23:32

Лучшие эксперты

Подробнее »

Вопрос # 1 402

Раздел: Delphi » Работа с устройствами и "железом"

/ вопрос открыт /

Приветствую, уважаемые эксперты! Вопрс таков: есть у меня 2 DVD-привода (H: и I:), несколько виртуальных дисков - надо программно открыть (и вообще поработать) именно с I: - а при работе через MCIsendcommand открывается H: Как это сделать? Заранее спасибо.
P.S. Их зовут _NEC и Optiarc.

Приложение:

XP SP2

Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Вадим (статус: Посетитель)
Вопрос отправлен: 10 марта 2008, 12:46
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: Dron

Здравствуйте, Вадим!
Используйте функции из модуля, который приведён в приложении. Можно открывать и закрывать каретку привода, просто указывая его букву. Удачи!

Приложение:

// ____ _ ______ __
// / __ _____(_) _____/_ __/___ ____ / /____
// / / / / ___/ / | / / _ / / / __ / __ / / ___/
// / /_/ / / / /| |/ / __/ / / /_/ / /_/ / (__ )
// /_____/_/ /_/ |___/___/_/ ____/____/_/____/
//
(*******************************************************************************
* DriveTools 1.0 *
* *
* (c) 1999 Jan Peter Stotz *
* *
********************************************************************************
* *
* If you find bugs, has ideas for missing featurs, feel free to contact me *
* jpstotz@gmx.de *
* *
********************************************************************************
* Date last modified: May 22, 1999 *
*******************************************************************************)
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.

Ответ отправил: Dron (статус: Студент)
Время отправки: 10 марта 2008, 16:56

Ответ #2. Отвечает эксперт: Drozdov D.V.

Здравствуйте, Вадим!
Вот вам пример, часть моей программы. Надеюсь он вам поможет.
Поищите в разных FAQ есть много интересного. Сам долго бился над этим вопросом.
УДАЧИ!

Приложение:

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms,Dialogs, StdCtrls, ComCtrls,
XPMan,MMSystem,MPlayer,IniFiles,Registry,
Buttons, ToolWin,Printers, Menus, CheckLst,
dbcgrids, OleCtnrs, ExtCtrls;
type
TForm1 = class(TForm)
XPManifest1: TXPManifest;
ComboBox1: TComboBox;
Memo1: TMemo;
ToolBar1: TToolBar;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
ProgressBar1: TProgressBar;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
StatusBar1: TStatusBar;
Timer1: TTimer;
Windows1: TMenuItem;
N4: TMenuItem;
SpeedButton5: TSpeedButton;
function CloseCD(Drive : string) : Boolean;
function OpenCD(Drive : string) : Boolean;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure N4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
PBS_MARQUEE = $08;
PBM_SETMARQUEE = WM_USER+10;
var
Form1: TForm1;
Driv: array [1..25] of string;
implementation
{$R *.dfm}
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.FormClose(Sender: TObject; var Action: TCloseAction);
var
i, cavb : 0..255;
begin
if AlphaBlend=False then
begin
AlphaBlendValue:=255;
AlphaBlend:=True;
end;
cavb:=AlphaBlendValue;
for i := cavb downto 0 do
begin
AlphaBlendValue := i;
Application.ProcessMessages;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
ndays: double;
ticks: LongInt;
btime: TDateTime;
w:dword;
Root:string;
I,q, K:integer;
begin
//
Form1.speedButton1.Hint:='Îòêðûòü îïòè÷åñêèé äèñê'+chr(13)+chr(10)+'-------------';
Form1.speedButton1.ShowHint:=True;
Form1.speedButton2.Hint:='Çàêðûòü îïòè÷åñêèé äèñê'+chr(13)+chr(10)+'-------------';
Form1.speedButton2.ShowHint:=True;
Form1.speedButton3.Hint:='Ñåðèéêà îïòè÷åñêèé äèñê'+chr(13)+chr(10)+'-------------';
Form1.speedButton3.ShowHint:=True;
Form1.speedButton4.Hint:='Ïå÷àòü îêíà ñâåäåíèé'+chr(13)+chr(10)+'-------------';
Form1.speedButton4.ShowHint:=True;
Form1.ComboBox1.Hint:='Äèñê äëÿ îáðàáîòêè';
Form1.ComboBox1.Showhint:=True;
Form1.Memo1.Hint:='Îêíî ñâåäåíèé';
Form1.Memo1.ShowHint:=True;
//
k:=0;
w:=GetLogicalDrives;
Root := '#:';
PostMessage(ProgressBar1.Handle, $0409, 0, clblue{clGreen});
SetWindowLong(ProgressBar1.Handle, GWL_STYLE,
GetWindowLong(ProgressBar1.Handle, GWL_STYLE) Or PBS_MARQUEE);
SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 1, 1000);
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;
SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 0, 0);
end;
//PostMessage(Application.Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 1);
//Form1.AlphaBlendValue := 200; {Óðîâåíü ïðîçðà÷íîñòè}
//Form1.AlphaBlend := True;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
FSpeed: Integer;
begin
OpenCD(ComboBox1.Text);
FSpeed := 100;
PostMessage(ProgressBar1.Handle, $0409, 0, clblue{clGreen});
SetWindowLong(ProgressBar1.Handle, GWL_STYLE,
GetWindowLong(ProgressBar1.Handle, GWL_STYLE) Or PBS_MARQUEE);
{ Âêëþ÷èòü }
SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 1, FSpeed);
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
CloseCD(ComboBox1.Text);
SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 0, 0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var dc: HDC;
cc: TCanvas;
s: string;
begin
dc:=GetWindowDC(Handle);
cc:=TCanvas.Create;
cc.Handle:=dc;
s:=TimeToStr(time);
cc.Brush.Color:=8388608;
cc.Font.Size:=10;
cc.Font.Color:=clWhite;
cc.TextOut(Width div 2,5,s);
ReleaseDc(Handle,dc);
end;
procedure TForm1.N4Click(Sender: TObject);
begin
SendMessage (FindWindow ('Progman', 'Program Manager'), WM_CLOSE, 0, 0);
end;
end.

Ответ отправил: Drozdov D.V. (статус: 4-ый класс)
Время отправки: 12 марта 2008, 17:58

Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)

Текущее время: 22 февраля 2025, 12:01

Главная страница | Обратная связь

Выполнено за 0.03 сек.

Экспертная система Delphi.int.ru

Сообщество программистовОбщение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 1 402

Мини-форум вопроса

Сообщество программистов
Общение, помощь, обмен опытом