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

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

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

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

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

#   

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


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

Подробнее »



Вопрос # 1 402

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

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

Приложение:
  1. XP SP2


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

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

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

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

Приложение:
  1. // ____ _ ______ __
  2. // / __ _____(_) _____/_ __/___ ____ / /____
  3. // / / / / ___/ / | / / _ / / / __ / __ / / ___/
  4. // / /_/ / / / /| |/ / __/ / / /_/ / /_/ / (__ )
  5. // /_____/_/ /_/ |___/___/_/ ____/____/_/____/
  6. //
  7. (*******************************************************************************
  8. * DriveTools 1.0 *
  9. * *
  10. * (c) 1999 Jan Peter Stotz *
  11. * *
  12. ********************************************************************************
  13. * *
  14. * If you find bugs, has ideas for missing featurs, feel free to contact me *
  15. * jpstotz@gmx.de *
  16. * *
  17. ********************************************************************************
  18. * Date last modified: May 22, 1999 *
  19. *******************************************************************************)
  20.  
  21. unit DriveTools;
  22.  
  23. interface
  24.  
  25. uses
  26.  
  27. Windows, SysUtils, MMSystem;
  28.  
  29. function CloseCD(Drive : Char) : Boolean;
  30. function OpenCD(Drive : Char) : Boolean;
  31.  
  32. implementation
  33.  
  34. function OpenCD(Drive : Char) : Boolean;
  35. Var
  36.  
  37. Res : MciError;
  38. OpenParm: TMCI_Open_Parms;
  39. Flags : DWord;
  40. S : String;
  41. DeviceID : Word;
  42. begin
  43.  
  44. Result:=false;
  45. S:=Drive+':';
  46. Flags:=mci_Open_Type or mci_Open_Element;
  47. With OpenParm do begin
  48. dwCallback := 0;
  49. lpstrDeviceType := 'CDAudio';
  50. lpstrElementName := PChar(S);
  51. end;
  52. Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  53. IF Res<>0 Then exit;
  54. DeviceID:=OpenParm.wDeviceID;
  55. try
  56. Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
  57. IF Res=0 Then exit;Result:=True;
  58. finally
  59. mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  60. end;
  61. end;
  62.  
  63. function CloseCD(Drive : Char) : Boolean;
  64. Var
  65.  
  66. Res : MciError;
  67. OpenParm: TMCI_Open_Parms;
  68. Flags : DWord;
  69. S : String;
  70. DeviceID : Word;
  71. begin
  72.  
  73. Result:=false;
  74. S:=Drive+':';
  75. Flags:=mci_Open_Type or mci_Open_Element;
  76. With OpenParm do begin
  77. dwCallback := 0;
  78. lpstrDeviceType := 'CDAudio';
  79. lpstrElementName := PChar(S);
  80. end;
  81. Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  82. IF Res<>0 Then exit;
  83. DeviceID:=OpenParm.wDeviceID;
  84. try
  85. Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
  86. IF Res=0 Then exit;
  87. Result:=True;
  88. finally
  89. mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  90. end;
  91. end;
  92.  
  93.  
  94. end.


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

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

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

Приложение:
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics,
  7. Controls, Forms,Dialogs, StdCtrls, ComCtrls,
  8. XPMan,MMSystem,MPlayer,IniFiles,Registry,
  9. Buttons, ToolWin,Printers, Menus, CheckLst,
  10. dbcgrids, OleCtnrs, ExtCtrls;
  11.  
  12. type
  13. TForm1 = class(TForm)
  14. XPManifest1: TXPManifest;
  15. ComboBox1: TComboBox;
  16. Memo1: TMemo;
  17. ToolBar1: TToolBar;
  18. SpeedButton1: TSpeedButton;
  19. SpeedButton2: TSpeedButton;
  20. SpeedButton3: TSpeedButton;
  21. SpeedButton4: TSpeedButton;
  22. ProgressBar1: TProgressBar;
  23. MainMenu1: TMainMenu;
  24. N1: TMenuItem;
  25. N2: TMenuItem;
  26. N3: TMenuItem;
  27. StatusBar1: TStatusBar;
  28. Timer1: TTimer;
  29. Windows1: TMenuItem;
  30. N4: TMenuItem;
  31. SpeedButton5: TSpeedButton;
  32. function CloseCD(Drive : string) : Boolean;
  33. function OpenCD(Drive : string) : Boolean;
  34.  
  35.  
  36. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  37. procedure FormCreate(Sender: TObject);
  38. procedure SpeedButton1Click(Sender: TObject);
  39. procedure SpeedButton2Click(Sender: TObject);
  40. procedure Timer1Timer(Sender: TObject);
  41. procedure N4Click(Sender: TObject);
  42.  
  43.  
  44.  
  45.  
  46.  
  47. private
  48. { Private declarations }
  49.  
  50. public
  51. { Public declarations }
  52.  
  53.  
  54. end;
  55.  
  56. const
  57. PBS_MARQUEE = $08;
  58. PBM_SETMARQUEE = WM_USER+10;
  59.  
  60.  
  61.  
  62. var
  63. Form1: TForm1;
  64. Driv: array [1..25] of string;
  65.  
  66. implementation
  67.  
  68. {$R *.dfm}
  69.  
  70. function TForm1.OpenCD(Drive: string): Boolean;
  71. var
  72. Res : MciError;
  73. OpenParm: TMCI_Open_Parms;
  74. Flags : DWord;
  75. S : string;
  76. DeviceID : Word;
  77. begin
  78. Result:=false;
  79. S:=Drive;
  80. Flags:=mci_Open_Type or mci_Open_Element;
  81. with OpenParm do
  82. begin
  83. dwCallback := 0;
  84. lpstrDeviceType := 'CDAudio';
  85. lpstrElementName := PChar(S);
  86. end;
  87. Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  88. if Res<>0 then
  89. exit;
  90. DeviceID:=OpenParm.wDeviceID;
  91. try
  92. Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
  93. if Res=0 then
  94. exit;
  95. Result:=True;
  96. finally
  97. mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  98. end;
  99. end;
  100.  
  101.  
  102. function TForm1.CloseCD(Drive: string): Boolean;
  103. var
  104. Res : MciError;
  105. OpenParm: TMCI_Open_Parms;
  106. Flags : DWord;
  107. S : string;
  108. DeviceID : Word;
  109. begin
  110. Result:=false;
  111. S:=Drive;
  112. Flags:=mci_Open_Type or mci_Open_Element;
  113. with OpenParm do
  114. begin
  115. dwCallback := 0;
  116. lpstrDeviceType := 'CDAudio';
  117. lpstrElementName := PChar(S);
  118. end;
  119. Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  120. if Res<>0 then
  121. exit;
  122. DeviceID:=OpenParm.wDeviceID;
  123. try
  124. Res:=mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
  125. if Res=0 then
  126. exit;
  127. Result:=True;
  128. finally
  129. mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  130. end;
  131. end;
  132.  
  133.  
  134. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  135. var
  136. i, cavb : 0..255;
  137. begin
  138. if AlphaBlend=False then
  139. begin
  140. AlphaBlendValue:=255;
  141. AlphaBlend:=True;
  142. end;
  143. cavb:=AlphaBlendValue;
  144. for i := cavb downto 0 do
  145. begin
  146. AlphaBlendValue := i;
  147. Application.ProcessMessages;
  148. end;
  149. end;
  150.  
  151.  
  152. procedure TForm1.FormCreate(Sender: TObject);
  153. var
  154. ndays: double;
  155. ticks: LongInt;
  156. btime: TDateTime;
  157. w:dword;
  158. Root:string;
  159. I,q, K:integer;
  160. begin
  161. //
  162. Form1.speedButton1.Hint:='&#206;&#242;&#234;&#240;&#251;&#242;&#252; &#238;&#239;&#242;&#232;&#247;&#229;&#241;&#234;&#232;&#233; &#228;&#232;&#241;&#234;'+chr(13)+chr(10)+'-------------';
  163. Form1.speedButton1.ShowHint:=True;
  164. Form1.speedButton2.Hint:='&#199;&#224;&#234;&#240;&#251;&#242;&#252; &#238;&#239;&#242;&#232;&#247;&#229;&#241;&#234;&#232;&#233; &#228;&#232;&#241;&#234;'+chr(13)+chr(10)+'-------------';
  165. Form1.speedButton2.ShowHint:=True;
  166. Form1.speedButton3.Hint:='&#209;&#229;&#240;&#232;&#233;&#234;&#224; &#238;&#239;&#242;&#232;&#247;&#229;&#241;&#234;&#232;&#233; &#228;&#232;&#241;&#234;'+chr(13)+chr(10)+'-------------';
  167. Form1.speedButton3.ShowHint:=True;
  168. Form1.speedButton4.Hint:='&#207;&#229;&#247;&#224;&#242;&#252; &#238;&#234;&#237;&#224; &#241;&#226;&#229;&#228;&#229;&#237;&#232;&#233;'+chr(13)+chr(10)+'-------------';
  169. Form1.speedButton4.ShowHint:=True;
  170. Form1.ComboBox1.Hint:='&#196;&#232;&#241;&#234; &#228;&#235;&#255; &#238;&#225;&#240;&#224;&#225;&#238;&#242;&#234;&#232;';
  171. Form1.ComboBox1.Showhint:=True;
  172. Form1.Memo1.Hint:='&#206;&#234;&#237;&#238; &#241;&#226;&#229;&#228;&#229;&#237;&#232;&#233;';
  173. Form1.Memo1.ShowHint:=True;
  174. //
  175. k:=0;
  176. w:=GetLogicalDrives;
  177. Root := '#:';
  178. PostMessage(ProgressBar1.Handle, $0409, 0, clblue{clGreen});
  179. SetWindowLong(ProgressBar1.Handle, GWL_STYLE,
  180. GetWindowLong(ProgressBar1.Handle, GWL_STYLE) Or PBS_MARQUEE);
  181. SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 1, 1000);
  182. for i := 0 to 25 do
  183. begin
  184. Root[1] := Char(Ord('A')+i);
  185. if (W and (1 shl i))>0 then
  186. if GetDriveType(Pchar(Root)) = DRIVE_CDROM then
  187. begin
  188. k:=k+1;
  189. Driv[k] := Root;
  190. ComboBox1.Items.Add(Driv[k]);
  191. ComboBox1.Text := Driv[1];
  192. end;
  193.  
  194. SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 0, 0);
  195.  
  196. end;
  197.  
  198.  
  199. //PostMessage(Application.Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 1);
  200. //Form1.AlphaBlendValue := 200; {&#211;&#240;&#238;&#226;&#229;&#237;&#252; &#239;&#240;&#238;&#231;&#240;&#224;&#247;&#237;&#238;&#241;&#242;&#232;}
  201. //Form1.AlphaBlend := True;
  202. end;
  203.  
  204.  
  205.  
  206.  
  207. procedure TForm1.SpeedButton1Click(Sender: TObject);
  208. var
  209. FSpeed: Integer;
  210. begin
  211. OpenCD(ComboBox1.Text);
  212. FSpeed := 100;
  213. PostMessage(ProgressBar1.Handle, $0409, 0, clblue{clGreen});
  214. SetWindowLong(ProgressBar1.Handle, GWL_STYLE,
  215. GetWindowLong(ProgressBar1.Handle, GWL_STYLE) Or PBS_MARQUEE);
  216. { &#194;&#234;&#235;&#254;&#247;&#232;&#242;&#252; }
  217. SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 1, FSpeed);
  218. end;
  219.  
  220. procedure TForm1.SpeedButton2Click(Sender: TObject);
  221. begin
  222. CloseCD(ComboBox1.Text);
  223. SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 0, 0);
  224. end;
  225.  
  226. procedure TForm1.Timer1Timer(Sender: TObject);
  227. var dc: HDC;
  228. cc: TCanvas;
  229. s: string;
  230. begin
  231. dc:=GetWindowDC(Handle);
  232. cc:=TCanvas.Create;
  233. cc.Handle:=dc;
  234. s:=TimeToStr(time);
  235. cc.Brush.Color:=8388608;
  236. cc.Font.Size:=10;
  237. cc.Font.Color:=clWhite;
  238. cc.TextOut(Width div 2,5,s);
  239. ReleaseDc(Handle,dc);
  240. end;
  241. procedure TForm1.N4Click(Sender: TObject);
  242. begin
  243. SendMessage (FindWindow ('Progman', 'Program Manager'), WM_CLOSE, 0, 0);
  244.  
  245. end;
  246.  
  247.  
  248.  
  249. end.


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


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

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

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

Версия движка: 2.6+ (26.01.2011)
Текущее время: 21 ноября 2017, 11:15
Выполнено за 0.06 сек.
Рейтинг@Mail.ru