Эта процедура выводит в ComboBox1 буквы CD приводов:
QUOTE
procedure List_Drives;
const
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;
var
r: LongWord;
Drives: array[0..128] of char;
pDrive: PChar;
begin
r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
if r = 0 then Exit;
if r > SizeOf(Drives) then
raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
pDrive := Drives;
while pDrive^ <> #0 do
begin
if GetDriveType(pDrive) = DRIVE_CDROM then
Form1.ComboBox1.Items.Add(pDrive);
Inc(pDrive, 4);
end;
end;
Эта позволяет получить метку диска:
QUOTE
function GetVolumeInfoFVS(const Dir:string;
var FileSystemName,VolumeName:string;var Serial:longint):boolean;
{Получение информации о диске
Dir - каталог или буква требуемого диска
FileSystemName - название файловой системы
VolumeName - метка диска
Serial - серийный номер диска
В случае ошибки функция возвращает false}
var
root:pchar;
res:longbool;
VolumeNameBuffer,FileSystemNameBuffer:pchar;
VolumeNameSize,FileSystemNameSize:DWord;
VolumeSerialNumber,MaximumComponentLength,FileSystemFlags:DWORD;
s:string;
n:integer;
begin
n:=pos(':',Dir);
if n> 0 then s:=copy(Dir,1,n+1) else s:=s+':';
if s[length(s)]=':' then s:=s+'\';
root:=pchar(s);
getMem(VolumeNameBuffer,256);
getMem(FileSystemNameBuffer,256);
VolumeNameSize:=255;
FileSystemNameSize:=255;
res:=GetVolumeInformation(Root,VolumeNameBuffer,VolumeNameSize
,@VolumeSerialNumber,
MaximumComponentLength, FileSystemFlags
,FileSystemNameBuffer,FileSystemNameSize);
Result:=res;
VolumeName:=VolumeNameBuffer;
FileSystemName:=FileSystemNameBuffer;
Serial:=VolumeSerialNumber;
freeMem(VolumeNameBuffer,256);
freeMem(FileSystemNameBuffer,256);
end;
procedure TForm1.Button1Click(Sender: TObject);
var s,s2,s3:string;
ser:integer;
begin
List_Drives;
GetVolumeInfoFVS(combobox1.Items[1],s,s2,ser);
label1.Caption:=ser;
end;
Осталось получить название дисководов...