[Delphi] Source

[Oli]

Thought this might be useful to somebody. It will return the drive letter of the first available CD-ROM drive to the console.

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  classes, 
  Unit1 in 'Unit1.pas';

var
  envlist: TStringList;
  i: integer;

begin
  writeln(getcd(getdisks)+':');
end.

unit Unit1;

interface

uses classes, sysutils, windows;


function GetCD(availdisks: string): string;
function GetDisks:string;

implementation

function GetCD(availdisks: string): string;
var
  i :integer;
  root :pchar;
begin
  result:=chr(0);
  root:=stralloc(255);
  for i:=1 to length(availdisks) do
  begin
    strpcopy(root,copy(availdisks,i,1)+':\');
    if getdrivetype(root)=drive_cdrom then
    begin
      result:=availdisks[i];
      break;
    end;
  end;
  strdispose(root);
end;

function GetDisks:string;
var
  availdisks: string;
  i,n :integer;
  buf :pchar;
begin
  buf:=stralloc(255);
  n:=GetLogicalDriveStrings(255,buf);
  availdisks:='';
  for i:=0 to n do
    if buf[i]<>#0 then begin
      if (ord(buf[i]) in [$41..$5a]) or (ord(buf[i]) in [$61..$7a]) then
        availdisks:=availdisks+upcase(buf[i])
    end else
      if buf[i+1]=#0 then
        break;
  strdispose(buf);
  result:=availdisks;
end;


end.