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

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

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

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

#   

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


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

Подробнее »

Вопрос # 1 212

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

Здравствуйте, уважаемые эксперты!
Хотелось бы узнать каким образом можно узнать имя производителя, модель и вообще как можно больше информации о CD-приводах системы.
Заранее спасибо

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

Вопрос задал: Илья (Hott Dogg) (статус: Посетитель)
Вопрос отправлен: 19 декабря 2007, 01:17
Состояние вопроса: открыт, ответов: 1.

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

Здравствуйте, Илья (Hott Dogg)!
Данная тема уже подымалась. Вы можете поискать вопросы/ответы на портале. А информацию можно разную вытягивать: от типа диска, до производителя привода. Т.е. можно и по самим дискам, и по приводам. Вот несколько примеров в Приложении:
1. Блокировка/Разблокировка CD-ROM.
2. Как узнать букву CD-ROM.
3. Как открыть CD-ROM, если их несколько в системе.
4. Как узнать производителя CD/DVD.
5. Изменение скорости привода CD-ROM.
6. Обработать момент вставки и вытаскивания CD.
Ну и хватит... :-)

Приложение:
  1.  
  2. const
  3.  
  4.  
  5. IOCTL_STORAGE_MEDIA_REMOVAL = $02D4804;
  6.  
  7. type
  8. PREVENT_MEDIA_REMOVAL=record
  9. PreventMediaRemoval:BOOL;
  10. end;
  11.  
  12.  
  13.  
  14. function LockCD(cdLetter:char; fLock:boolean):boolean;
  15. var
  16. hDevice : THandle;
  17. dwBytesReturned : DWORD;
  18. pmr : PREVENT_MEDIA_REMOVAL;
  19. begin
  20. result:=false;
  21. hDevice := CreateFile(pchar('\.'+cdLetter+':'),GENERIC_READ,
  22. FILE_SHARE_READ or FILE_SHARE_WRITE,
  23. nil,OPEN_EXISTING, 0,0);
  24. if (hDevice=DWORD(-1)) then exit;
  25.  
  26. try
  27. pmr.PreventMediaRemoval:=fLock;
  28. if (not DeviceIoControl(hDevice, IOCTL_STORAGE_MEDIA_REMOVAL, @pmr,
  29. sizeof(pmr),nil, 0,
  30. dwBytesReturned, nil)) then exit else result:=true;
  31. finally
  32. CloseHandle (hDevice);
  33. end;
  34. end;
  35.  
  36.  
  37. procedure TForm1.Button1Click(Sender: TObject);
  38. begin
  39. if not LockCD('E',true) then
  40. MessageBox(Handle,'Can not lock CD','Error',MB_ICONERROR)
  41. else
  42. MessageBox(Handle,'CD is locked','Info',MB_ICONINFORMATION);
  43. end;
  44.  
  45.  
  46. procedure TForm1.Button2Click(Sender: TObject);
  47. begin
  48. if not LockCD('E',false) then
  49. MessageBox(Handle,'Can not unlock CD','Error',MB_ICONERROR)
  50. else
  51. MessageBox(Handle,'CD is unlocked','Info',MB_ICONINFORMATION)
  52. end;
  53.  
  54.  
  55.  
  56. ===============================================================
  57.  
  58. function GetFirstCDROMDrive: char;
  59. var
  60. drivemap, mask: DWORD;
  61. i: integer;
  62. root: string;
  63. begin
  64. Result := #0;
  65. root := 'A:';
  66. drivemap := GetLogicalDrives;
  67. mask := 1;
  68. for i := 1 to 32 do
  69. begin
  70. if (mask and drivemap) <> 0 then
  71. if GetDriveType(PChar(root)) = DRIVE_CDROM then
  72. begin
  73. Result := root[1];
  74. Break;
  75. end;
  76. mask := mask shl 1;
  77. Inc(root[1]);
  78. end;
  79. end;
  80.  
  81. procedure TForm1.Button2Click(Sender: TObject);
  82. begin
  83. ShowMessage(GetFirstCDROMDrive);
  84. end;
  85.  
  86.  
  87. ===============================================================
  88.  
  89. // DriveTools 1.0 *
  90. // (c) 1999 Jan Peter Stotz *
  91. // If you find bugs, has ideas for missing featurs, feel free to contact me *
  92. // jpstotz@gmx.de *
  93. // Date last modified: May 22, 1999 *
  94.  
  95. unit DriveTools;
  96.  
  97. interface
  98.  
  99. uses
  100.  
  101. Windows, SysUtils, MMSystem;
  102.  
  103. function CloseCD(Drive: Char): Boolean;
  104. function OpenCD(Drive: Char): Boolean;
  105.  
  106. implementation
  107.  
  108. function OpenCD(Drive: Char): Boolean;
  109. var
  110.  
  111. Res: MciError;
  112. OpenParm: TMCI_Open_Parms;
  113. Flags: DWord;
  114. S: string;
  115. DeviceID: Word;
  116. begin
  117.  
  118. Result := false;
  119. S := Drive + ':';
  120. Flags := mci_Open_Type or mci_Open_Element;
  121. with OpenParm do
  122. begin
  123. dwCallback := 0;
  124. lpstrDeviceType := 'CDAudio';
  125. lpstrElementName := PChar(S);
  126. end;
  127. Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  128. if Res <> 0 then
  129. exit;
  130. DeviceID := OpenParm.wDeviceID;
  131. try
  132. Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
  133. if Res = 0 then
  134. exit;
  135. Result := True;
  136. finally
  137. mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  138. end;
  139. end;
  140.  
  141. function CloseCD(Drive: Char): Boolean;
  142. var
  143.  
  144. Res: MciError;
  145. OpenParm: TMCI_Open_Parms;
  146. Flags: DWord;
  147. S: string;
  148. DeviceID: Word;
  149. begin
  150.  
  151. Result := false;
  152. S := Drive + ':';
  153. Flags := mci_Open_Type or mci_Open_Element;
  154. with OpenParm do
  155. begin
  156. dwCallback := 0;
  157. lpstrDeviceType := 'CDAudio';
  158. lpstrElementName := PChar(S);
  159. end;
  160. Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  161. if Res <> 0 then
  162. exit;
  163. DeviceID := OpenParm.wDeviceID;
  164. try
  165. Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
  166. if Res = 0 then
  167. exit;
  168. Result := True;
  169. finally
  170. mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  171. end;
  172. end;
  173.  
  174. end.
  175.  
  176.  
  177. ===============================================================
  178.  
  179. unit Unit1;
  180. interface
  181. uses
  182. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  183. Dialogs, WbemScripting_TLB, OleServer, ActiveX, StdCtrls, ExtCtrls,
  184. ComCtrls;
  185. type
  186. TForm1 = class(TForm)
  187. ListBox1: TListBox;
  188. SWbemLocator1: TSWbemLocator;
  189. Button1: TButton;
  190. procedure Button1Click(Sender: TObject);
  191. private
  192. { Private declarations }
  193. public
  194. { Public declarations }
  195. end;
  196. var
  197. Form1: TForm1;
  198. implementation
  199.  
  200. {$R *.dfm}
  201. procedure TForm1.Button1Click(Sender: TObject);
  202. var
  203. Service: ISWbemServices;
  204. ObjectSet: ISWbemObjectSet;
  205. SObject: ISWbemObject;
  206. PropSet: ISWbemPropertySet;
  207. SProp: ISWbemProperty;
  208. PropEnum, Enum: IEnumVariant;
  209. TempObj: OleVariant;
  210. Value: Cardinal;
  211. dr:string;
  212. begin
  213. ListBox1.Clear;
  214. Service:= SWbemLocator1.ConnectServer('.', 'rootCIMV2', '', '', '','', 0, nil);
  215. SObject:= Service.Get('Win32_CDROMDrive', wbemFlagUseAmendedQualifiers, nil);
  216. ObjectSet:= SObject.Instances_(0, nil);
  217. Enum:= (ObjectSet._NewEnum) as IEnumVariant;
  218. dr:='';
  219. while (Enum.Next(1, TempObj, Value) = S_OK) do
  220. begin
  221. SObject:= IUnknown(TempObj) as SWBemObject;
  222. PropSet:= SObject.Properties_;
  223. PropEnum:= (PropSet._NewEnum) as IEnumVariant;
  224. while PropEnum.Next(1, TempObj, Value) = S_OK do
  225. begin
  226. SProp:= IUnknown(TempObj) as SWBemProperty;
  227. if SProp.Name='Drive' then dr:=SProp.Get_Value;
  228. if SProp.Name='Name' then ListBox1.AddItem(dr+' '+SProp.Get_Value, nil);
  229. end;
  230. end;
  231. end;
  232. end.
  233.  
  234.  
  235.  
  236. ===============================================================
  237.  
  238.  
  239. function SetCDSpeed(Host,Target:byte;Speed:integer):BOOL;
  240.  
  241.  
  242. var
  243. dwASPIStatus: DWORD;
  244. hEvent: THandle;
  245. srbExec: SRB_ExecSCSICmd;
  246. begin
  247. if Speed<176 then result:=false
  248. else
  249. begin
  250. hEvent:=CreateEvent(nil, true, false, nil);
  251. Fillchar(srbExec,sizeof(SRB_ExecSCSICmd),0);
  252. srbExec.SRB_Cmd:= SC_EXEC_SCSI_CMD;
  253. srbExec.SRB_Flags:= SRB_DIR_OUT or SRB_EVENT_NOTIFY;
  254. srbExec.SRB_Target:= Target;
  255. srbExec.SRB_HaId:= Host;
  256. srbExec.SRB_Lun:= 0;
  257. srbExec.SRB_SenseLen:= SENSE_LEN;
  258. srbExec.SRB_CDBLen:= 12;
  259. srbExec.SRB_PostProc:=Pointer(hEvent);
  260.  
  261. srbExec.CDBByte[2]:= Speed shr 8;
  262. srbExec.CDBByte[3]:= Speed;
  263. srbExec.CDBByte[4]:= $FF;
  264. srbExec.CDBByte[5]:= $FF;
  265. ResetEvent(hEvent);
  266. dwASPIStatus:= SendASPI32Command(@srbExec);
  267. if dwASPIStatus=SS_PENDING
  268. then
  269. begin
  270. WaitForSingleObject(hEvent,INFINITE);
  271. end;
  272. if srbExec.SRB_Status<>SS_COMP
  273. then
  274. begin
  275. MessageBox(0,'Error processing the SRB.','Error',MB_OK);
  276. result:=false;
  277. end
  278. else
  279. result:=true;
  280. end;
  281. end;
  282.  
  283.  
  284.  
  285.  
  286.  
  287. ===============================================================
  288.  
  289. {
  290. Some applications need to know when the user inserts or
  291. removes a compact disc or DVD from a CD-ROM drive without
  292. polling for media changes. Windows provide a way to notify these
  293. applications through the WM_DEVICECHANGE message.
  294. }
  295.  
  296. type
  297. TForm1 = class(TForm)
  298. private
  299. procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  300. public
  301.  
  302. end;
  303.  
  304. {...}
  305.  
  306. implementation
  307.  
  308. {$R *.DFM}
  309.  
  310. procedure TForm1.WMDeviceChange(var Msg: TMessage);
  311. const
  312. DBT_DEVICEARRIVAL = $8000; // system detected a new device
  313. DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
  314. var
  315. myMsg: string;
  316. begin
  317. inherited;
  318. case Msg.wParam of
  319. DBT_DEVICEARRIVAL: myMsg := 'CD inserted!';
  320. DBT_DEVICEREMOVECOMPLETE: myMsg := 'CD removed!';
  321. end;
  322. ShowMessage(myMsg);
  323. end;
  324.  
  325. {*********************************************}
  326.  
  327. // Advanced Code:
  328. // When the device is of type volume, then we can get some device specific
  329. // information, namely specific information about a logical volume.
  330. // by Juergen Kantz
  331.  
  332. unit Unit1;
  333.  
  334. interface
  335.  
  336. uses
  337. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  338. Dialogs, StdCtrls;
  339.  
  340. type
  341. TForm1 = class(TForm)
  342. Button1: TButton;
  343. label1: TLabel;
  344. private
  345. procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange;
  346. { Private declarations }
  347. public
  348. { Public declarations }
  349. end;
  350.  
  351. const
  352. DBT_DeviceArrival = $8000;
  353. DBT_DeviceRemoveComplete = $8004;
  354. DBTF_Media = $0001;
  355. DBT_DevTyp_Volume = $0002;
  356.  
  357. type
  358. PDevBroadcastHdr = ^TDevBroadcastHdr;
  359. TDevBroadcastHdr = packed record
  360. dbcd_size: DWORD;
  361. dbcd_devicetype: DWORD;
  362. dbcd_reserved: DWORD;
  363. end;
  364.  
  365. type
  366. PDevBroadcastVolume = ^TDevBroadcastVolume;
  367. TDevBroadcastVolume = packed record
  368. dbcv_size: DWORD;
  369. dbcv_devicetype: DWORD;
  370. dbcv_reserved: DWORD;
  371. dbcv_unitmask: DWORD;
  372. dbcv_flags: Word;
  373. end;
  374.  
  375. var
  376. Form1: TForm1;
  377.  
  378. implementation
  379.  
  380. {$R *.dfm}
  381.  
  382. function GetDrive(pDBVol: PDevBroadcastVolume): string;
  383. var
  384. i: Byte;
  385. Maske: DWORD;
  386. begin
  387. if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
  388. begin
  389. Maske := pDBVol^.dbcv_unitmask;
  390. for i := 0 to 25 do
  391. begin
  392. if (Maske and 1) = 1 then
  393. Result := Char(i + Ord('A')) + ':';
  394. Maske := Maske shr 1;
  395. end;
  396. end;
  397. end;
  398.  
  399. procedure TForm1.WMDeviceChange(var Msg: TMessage);
  400. var
  401. Drive: string;
  402. begin
  403. case Msg.wParam of
  404. DBT_DeviceArrival:
  405. if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
  406. begin
  407. Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
  408. label1.Caption := 'CD inserted in Drive ' + Drive;
  409. end;
  410. DBT_DeviceRemoveComplete:
  411. if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
  412. begin
  413. Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
  414. label1.Caption := 'CD removed from Drive ' + Drive;
  415. end;
  416. end;
  417. end;
  418.  
  419. end.


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 19 декабря 2007, 14:33


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

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

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 11:27
Выполнено за 0.02 сек.