MSFN Forum: [Delphi] Source - MSFN Forum

Jump to content


Page 1 of 1
  • You cannot start a new topic
  • You cannot reply to this topic

[Delphi] Source Rate Topic: -----

#1 User is offline   Oli 

  • Newbie
  • Group: Members
  • Posts: 15
  • Joined: 08-November 03

Posted 10 November 2003 - 06:01 PM

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.



Share this topic:


Page 1 of 1
  • You cannot start a new topic
  • You cannot reply to this topic

1 User(s) are reading this topic
0 members, 1 guests, 0 anonymous users



All trademarks mentioned on this page are the property of their respective owners
Copyright © 2001 - 2013 msfn.org
Privacy Policy