Вопрос # 2 405

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

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

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

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

//...................
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;
//..............