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

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

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

Delphi.int.ru Expert

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

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

#   

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


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

Подробнее »



Вопрос # 2 405

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

Здравствуйте, эксперты!
Может сможет кто помочь с решением след. проблемы.
Не получается отловить сообщение "О извлечении флэшки из USB"
Использую след. код
uses ..., DBT;
...
procedure WMDEVICECHANGE(var Msg:TMessage);message WM_DEVICECHAGE;
...
procedure WMDEVICECHANGE(var Msg:TMessage);
begin
case Msg.WParam of
DBT_DEVICEARRIVAL:; // подключение устройства
DBT_DEVICEREMOVECOMPLETE:; // отключение устройства
else // ? - а вот здесь никак, только 7 и LParam=0
end;
end;

Т.е. сообщение об извлечении устройства поступают, но как узнать, что это именно устройство извлечено, ведь такие сообщени и при подключении и отключении?

Заранее благодарен.

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

Вопрос задал: Светлов (статус: Посетитель)
Вопрос отправлен: 9 февраля 2009, 15:14
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Вадим К

Здравствуйте, Светлов!
Можно взять и проанализировать биты, где будет записано, что произошло, но там чуточку хитро. Где то дома есть код, можно поискать.
Но можно сделать гораздо проще. с помощью функции GetDriveType можно пробежаться по всем дискам. и сравнить с предыдущим запомненным состоянием (например в массиве disk:array[A..Z] of byte;).
набросок кода можно глянуть тут http://www.codenet.ru/progr/delphi/stat/System-Information.php.

Ответ отправил: Вадим К (статус: Академик)
Время отправки: 9 февраля 2009, 15:43
Оценка за ответ: 4

Комментарий к оценке: Хотелось бы узнать на счет бит и где их искать Msg=WM_DEVICECHANGE, Msg.WParam=7, Msg.LParam=0 ??? А ссылка не работает.

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

Всего сообщений: 2; последнее сообщение — 9 февраля 2009, 23:55; участников в обсуждении: 2.
Пупкин В.В.

Пупкин В.В. (статус: 1-ый класс), 9 февраля 2009, 15:55 [#1]:

все уже написано, есть готовый компанент, ищите в нете
авторство не знаю и дабы не нарушать прав постить не могу.
Вадим К

Вадим К (статус: Академик), 9 февраля 2009, 23:55 [#2]:

в ссылке надо удалить точку в конце. заработает.
а код... Написал же - приду домой - п2mоищу, нет надо ставить сразу минус единицы... аж расхотелось писать. ну вот код, прикручиваем самостоятельно
//...................
type
 
  TMainForm = class(TForm)
 
    Label1:      TLabel;
 
    Label2:      TLabel;
 
    ListBox1:    TListBox;
 //Здесь будет список флешек!
    buttonClose: TButton;
 
    procedure FormCreate(Sender: TObject);
 
  private
    { Private declarations }
    procedure WMDev(var msg: TMessage); message WM_DEVICECHANGE;
  public
    { Public declarations }
    procedure UpdateList;
  end;
//............
//как я долго всё это вытягивал с мсдн.... 
//извиняйте за мой английский.
//нормальный программист обязан учить
const
 
  // Win32 constants
  DBT_DEVTYP_DEVICEINTERFACE = 5;
  DBT_DEVTYP_HANDLE    = 6;
  BROADCAST_QUERY_DENY = $424D5144;
  WM_DEVICECHANGE      = $0219;
  DBT_DEVICEARRIVAL    = $8000; // system detected a new device
  DBT_DEVICEQUERYREMOVE = $8001;
  // Preparing to remove (any program can disable the removal)
  DBT_DEVICEREMOVECOMPLETE = $8004; // removed
  DBT_DEVTYP_VOLUME    = $00000002; // drive type is logical volume
 
type
 
  DEV_BROADCAST_VOLUME = record
    dbcv_size:     DWORD;
    dbcv_devicetype: DWORD;
    dbcv_reserved: DWORD;
    dbcv_unitmask: DWORD;
    dbcv_flags:    word;
  end;
 
  PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
 
var
  disks: array['A'..'Z'] of boolean;
 
//decode 4 byte (32 bit) to disk letter
function DriveMaskToLetter(mask: integer): char;
const
  drives = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  letter: char;
  cnt:    integer;
  pom:    integer;
begin
  cnt := 0;
  pom := mask div 2;
  while (pom <> 0) do
  begin
    // while there is any bit set in the mask
    // shift it to the righ...
    pom := pom div 2;
    Inc(cnt);
  end;
  if (cnt < Length(drives)) then
    letter := drives[cnt + 1]
  else
    letter := '?';
  Result := letter;
end;
//find all flash drive when we start
procedure TMainForm.FormCreate(Sender: TObject);
var
  c: char;
begin
  for c := 'A' to 'Z' do
    disks[c] := GetDriveType(PAnsiChar(c + ':\')) = DRIVE_REMOVABLE;
  UpdateList;
end;
 
//display disk list in Listbox
procedure TMainForm.UpdateList;
var
  c: char;
begin
  ListBox1.Clear;
  for c := 'A' to 'Z' do
    if disks[c] then
      ListBox1.Items.Add(c + ':\');
end;
 
procedure TMainForm.WMDev(var msg: TMessage);
var
  devType: integer;
  c:   char;
  vol: PDEV_BROADCAST_VOLUME;
begin
  if (msg.Msg = WM_DEVICECHANGE) then
  begin
    // WM_DEVICECHANGE can have several meanings depending on the WParam value...
    case msg.WParam of
      // New device has just arrived
      DBT_DEVICEARRIVAL:
      begin
        vol     := PDEV_BROADCAST_VOLUME(msg.LParam);
        devType := vol.dbcv_devicetype;
        if (devType = DBT_DEVTYP_VOLUME) then
        begin
          // Get the drive letter
          c := DriveMaskToLetter(vol^.dbcv_unitmask);
          disks[c] := True;
          UpdateList;
        end;
      end;
 
      // Device has been removed
      DBT_DEVICEREMOVECOMPLETE:
      begin
        vol     := PDEV_BROADCAST_VOLUME(msg.LParam);
        devType := vol.dbcv_devicetype;
        if (devType = DBT_DEVTYP_VOLUME) then
        begin
          c := DriveMaskToLetter(vol^.dbcv_unitmask);
          disks[c] := False;
          UpdateList;
        end;
      end;
    end;
  end;
end;
//..............
Галочка "подтверждения прочтения" - вселенское зло.

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

Версия движка: 2.6+ (26.01.2011)
Текущее время: 7 апреля 2020, 00:02
Выполнено за 0.02 сек.
Рейтинг@Mail.ru