1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:

procedure ListLogicalDrives(var LV : TListView; ReadyOnly : Boolean = True);
  function DriveIsReady(const Drive : String) : Boolean;
  var wfd        : TWin32FindData;
      hFindData  : THandle;
  begin
    SetErrorMode(SEM_FAILCRITICALERRORS);
    hFindData := FindFirstFile(Pointer(Drive+'*.*'), wfd);
    if hFindData <> INVALID_HANDLE_VALUE then
      Result := True
    else
      Result := False;
    FindClose(hFindData);
    SetErrorMode(0);
  end;

  function GetVolumeLabel(const Drive: string): string;
  var RootDrive                   : String;
      Buffer                      : Array[0..MAX_PATH+1] of Char;
      FileSysFlags, MaxCompLength : DWORD;
  begin
    Result := '';
    FillChar(Buffer, SizeOf(Buffer), #0);
    if Length(Drive) = 1 then
      RootDrive := Drive + ':\'
    else
      RootDrive := Drive;
    if GetVolumeInformation(PChar(RootDrive), Buffer, SizeOf(Buffer), nil, MaxCompLength, FileSysFlags, nil, 0) then
      Result := String(Buffer);
  end;
var FoundDrives, CurrentDrive : PChar;
    Len                       : DWord;
begin
  LV.Clear;

  GetMem(FoundDrives, 255);
  Len := GetLogicalDriveStrings(255, FoundDrives);
  if Len > 0 then
  begin
    try
      CurrentDrive := FoundDrives;
      while CurrentDrive[0] <> #0 do
      begin
        if ReadyOnly then
        begin
          //if DriveIsReady(String(CurrentDrive)) then
         // begin
            with LV.Items.Add do
            begin
              Caption := GetVolumeLabel(CurrentDrive);
              SubItems.Add('Datenträger');
              SubItems.Add(CurrentDrive);
              //SubItems.Add(Speicherplatz/kapazität);
            end;
         // end;
        end else
        begin
          with LV.Items.Add do
          begin
            Caption := GetVolumeLabel(CurrentDrive);
            SubItems.Add('Datenträger');
            SubItems.Add(CurrentDrive);
            //SubItems.Add(Speicherplatz/kapazität);
          end;
        end;
        CurrentDrive := PChar(@CurrentDrive[Succ(lstrlen(CurrentDrive))]);
      end;
    finally
      FreeMem(FoundDrives, Len);
    end;
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:

private
 procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;

function GetFirstDrive(UnitMask: DWORD): Char;
var
I: Char;
begin
Result:=#0;
for I:='A' to 'Z' do
begin
  if (UnitMask and 1) = 1 then
  begin
    Result:=I;
    break;
  end;
  UnitMask:=UnitMask Shr 1;
end;
end;

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
lpdb: PDevBroadcastHdr;
lpdbv: PDevBroadcastVolume;
begin
lpdb:=PDevBroadcastHdr(Msg.lParam);
case Msg.wParam of
  //Datenträger eingelegt
  DBT_DeviceArrival:
    //Prüfen, ob es sich um eine DVD oder CD handelt.
    if lpdb^.dbch_devicetype = DBT_DevTyp_Volume then
    begin
      lpdbv:=PDevBroadcastVolume(Msg.lParam);
      if lpdbv.dbcv_flags = DBTF_Media then
        Label1.Caption:=Format('Datenträger in Laufwerk %s eingelegt.',
                               [GetFirstDrive(lpdbv.dbcv_unitmask)]);
    end;
  //Datenträger entfernt
  DBT_DeviceRemoveComplete:
    //Prüfen, ob es sich um eine DVD oder CD handelt.
    if lpdb^.dbch_devicetype = DBT_DevTyp_Volume then
    begin
      lpdbv:=PDevBroadcastVolume(Msg.lParam);
      if lpdbv.dbcv_flags = DBTF_Media then
        Label1.Caption:=Format('Datenträger aus Laufwerk %s entfernt.',
                               [GetFirstDrive(lpdbv.dbcv_unitmask)]);
    end;

end; //case
end;

//Die Deklarationen der entsprechenden Typen finden Sie in der DBT.h. Eine Pascal-Übersetzung der Unit sind in der JEDI //JCL enthalten:

const DBT_DEVICEARRIVAL         = $8000;
const DBT_DEVICEREMOVECOMPLETE  = $8004;
const DBTF_MEDIA                = $0001;
const DBT_DEVTYP_VOLUME         = $0002;

type
PDevBroadcastHdr = ^TDevBroadcastHdr;
{$EXTERNALSYM DEV_BROADCAST_HDR}
DEV_BROADCAST_HDR = packed record
  dbch_size: DWORD;
  dbch_devicetype: DWORD;
  dbch_reserved: DWORD;
end;
TDevBroadcastHdr = DEV_BROADCAST_HDR;

PDevBroadcastVolume = ^TDevBroadcastVolume;
{$EXTERNALSYM DEV_BROADCAST_VOLUME}
DEV_BROADCAST_VOLUME = packed record
  dbcv_size: DWORD;
  dbcv_devicetype: DWORD;
  dbcv_reserved: DWORD;
  dbcv_unitmask: DWORD;
  dbcv_flags: Word;
end;


TDevBroadcastVolume = DEV_BROADCAST_VOLUME;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

procedure GetDrives(const AItems: TStrings);
const
  DriveTypeTexts: array[DRIVE_UNKNOWN..DRIVE_RAMDISK] of String =
   ('Unbekannt', 'Kein Wurzelverzeichnis', 'Diskette', 'Festplatte', 'Netzlaufwerk', 'CDROM', 'RAMDisk');
var
  Drive: Char;
  DriveType: Integer;
  DriveMask: Integer;
  Flag: Integer;
begin
  DriveMask:=GetLogicalDrives;
  flag:=1;
  for Drive := 'A' to 'Z' do
  begin
    if (flag and DriveMask)<>0 then
    begin
      DriveType := GetDriveType(PChar(Format('%S:\',[Drive]) ) ) ;
      AItems.Add(Format('%s: %s', [Drive, DriveTypeTexts[DriveType]]));
    end;
    flag:=flag shl 1;
  end;
end;					

1:
2:
3:
4:

procedure TForm1.Button2Click(Sender: TObject);
begin
 GetDrives(Listbox1.Items)
end;