Показать сообщение отдельно
  #2  
Старый 30.04.2014, 03:38
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Цитата:
Сообщение от nikcpp
Народ подскажите как узнать имя диска по названию устройства...
Интересно, что вы подразумеваете под именем диска, (и только-ли юэсби-диски) если его лейбл, то это всё в реестре лежит, а получить примерно так можно
Код:
function nd(ds: string): string;
var
 sl, sl1: TStrings;
 s: string;
 i, b: integer;
begin
 sl := TStringList.Create;
 sl1:= TStringList.Create;

 with TRegistry.Create do try
  RootKey:= HKEY_LOCAL_MACHINE;
  OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\USBSTOR');
  GetKeyNames(sl);

  for i := 0 to sl.Count-1 do
   begin
    CloseKey;
    OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\USBSTOR\' + sl[i]);
    GetKeyNames(sl1);

    for b := 0 to sl1.Count-1 do
     begin
      CloseKey;
      OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\USBSTOR\'+sl[i]+'\'+sl1[b]);
      if (ValueExists('ContainerID'))  and
         (ValueExists('FriendlyName')) and
         (ReadString('FriendlyName') = ds) then
         s:= (ReadString('FriendlyName')+'#'+ReadString('ContainerID'));
     end;
   end;

   CloseKey;
   OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\WpdBusEnumRoot\UMB');
   GetKeyNames(sl);

   for i := 0 to sl.Count-1 do
   begin
   CloseKey;
   OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\WpdBusEnumRoot\UMB\'+sl[i]);

   if (ValueExists('ContainerID'))  and
      (ValueExists('FriendlyName')) and
      (ReadString('ContainerID') = Copy(s, Pos('#', s)+1, Length(s))) then
       Result:= ReadString('FriendlyName');
   end;
  finally
   Free;
  end; {with}

sl.Free;
sl1.Free;
end;

// Использование:
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:= nd('WD My Passport 074A USB Device');
end;
Поменяйте ветки местами, будет наоборот, по лейблу устройство искать

З.Ы. На машинке сейчас виртуальная W7, но вроде работает, мои 3 всунутых, и множество давно не втыкаемых в порт дисков обрабатываются, так что наверное нужно добавить проверку на подключение, но это уже не ходовая, мелочёвка
Ответить с цитированием