Uses ShellApi;    type
  TDriveShellInfo = record
     Icon : hIcon;
     Image : integer;
     DisplayName,
     TypeName : string
   end;    procedure GetDriveShellInfo (Drive : Char; var Info : TDriveShellInfo);
 var
   SHFileInfo : TSHFileInfo;
 begin
   ShGetFileInfo (PChar (Drive   ':\'), 0, SHFileInfo, SizeOf (TSHFileInfo),
      SHGFI_TYPENAME or SHGFI_DISPLAYNAME or SHGFI_SYSICONINDEX or SHGFI_ICON);
   with Info do
   begin
     Icon  := SHFileInfo.hIcon;
     Image := SHFileInfo.iIcon;
     DisplayName := SHFileInfo.szDisplayName;
     TypeName := SHFileInfo.szTypeName
   end
 end;    procedure ShowFile(InDir : String);
var
  sr: TSearchRec;
  FileAttrs: Integer;
begin
  if FindFirst(InDir '\*.*', faAnyFile, sr) = 0 then begin
     Form1.Memo1.Lines.Add( InDir   ' [DIR]');
     while FindNext(sr) = 0 do begin
           if (sr.Name = '.') or (sr.Name = '..') then continue;
           if ((sr.Attr and faDirectory) = faDirectory) then
              ShowFile(InDir   '\'   sr.Name)
           else
              Form1.Memo1.Lines.Add( '   ' sr.Name   ' [File]');
           Application.ProcessMessages;
     end;
  end;
  FindClose(sr);
end;        Function GetCDList : String;
Var
   I : Integer;
   Drives: Integer;
   Tmp : String;
begin
   Drives := GetLogicalDrives;
   Result := '';
   // units A=0 to el Z=25
   For I := 0 To 25 Do
      If (((1 Shl I) And Drives)<>0) Then
      Begin
         Tmp := Char(65 I) ':\';
         If (GetDriveType(PChar(Tmp))=DRIVE_CDROM) Then
            Result := Result Char(65 I);
      End;
End;    //**********取得光碟機及標籤**********
procedure TForm1.Button1Click(Sender: TObject);
var Str : String;
    Info : TDriveShellInfo;
begin
   Memo1.Lines.Add(GetCDList);
   Str := GetCDList;
   GetDriveShellInfo(Str[1], Info);
   ShowMessage(Info.DisplayName);
end;    //**********取得光碟裡面的檔案目錄**********
procedure TForm1.Button2Click(Sender: TObject);
begin
   ShowFile(GetCDList ':');
end;