CD-ROM/CD-R/CD-RW

Code:

{....}

uses Registry;

{....}

function HasCDRecorder: Boolean;

var

reg: TRegistry;

begin

reg := TRegistry.Create;

try

   // set the the Mainkey,

   reg.RootKey := HKEY_CURRENT_USER;

   // Open a key

   reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\CD Burning', False);

   // Check if the Key exists

   Result := reg.ValueExists('CD Recorder Drive');

   // Close the key

   reg.CloseKey;

finally

   // and free the TRegistry Object

   reg.Free;

end;

end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

if HasCDRecorder then

   ShowMessage('CD-Recorder available.')

else

   ShowMessage('CD-Recorder NOT available.');

end;

Code:

mciSendString('Set cdaudio Door Open Wait', nil, 0, handle);

mciSendCommand(mp.DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);

Code:

uses

  Registry;

procedure CDSetAutoPlay(SioNo: Boolean);

var

  Reg: TRegistry;

begin

  try

    Reg := TRegistry.Create;

    Reg.RootKey := HKEY_LOCAL_MACHINE;

    if Reg.KeyExists('Software\Classes\AudioCD\') then

      if Reg.OpenKey('Software\Classes\AudioCD\Shell\', False) then

        if SioNo then Reg.WriteString('', 'play')

        else

           Reg.WriteString('', '');

  finally

    Reg.Free;

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  {Activate  AutoPlay}

  CDSetAutoPlay(True);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  {Deactivate Autoplay}

  CDSetAutoPlay(False);

end;

Code:

function GetCDIcon(Drive: Char): TIcon;

var

ico: TIcon;

ini: TIniFile;

s, p: string;

i, j: Integer;

begin

//Abbrechen wenn "AutoRun.Inf" nicht existiert.

//Abort if "AutoRun.inf" doesn't exists.

if FileExists(Drive + ':\autorun.inf') = False then Exit;

//"AutoRun.inf" offnen

//Opens the "AutoRun.inf"

ini := TIniFile.Create(Drive + ':\autorun.inf');

ico := TIcon.Create;

try

   //Dateinamen lesen

   //Read the filename

   s := ini.ReadString('Autorun', 'ICON', '');

   //Abbrechen, wenn kein Icon festgelegt wurde

   //Abort if there is no icon specified

   if s = '' then Exit;

   //Icon von Datei laden

   //load the icon from a file

   if FileExists(s) then ico.LoadFromFile(s);

   if FileExists(Drive + ':\' + s) then ico.LoadFromFile(Drive + ':\' + s);

   //Icon aus einer Resource laden

   //Load the icon from a Win32 resource

   if (FileExists(s) = False) and (FileExists(Drive + ':\' + s) = False) then

   begin

     for j := (Pos(',', s) + 1) to Length(s) do

     begin

       p := p + s[j];

     end;

     i := StrToInt(p);

     for j := Length(s) downto (Pos(',', s)) do

       Delete(s, j, Length(s));

     if FileExists(s) = False then s := Drive + ':\' + s;

     ico.Handle := ExtractIcon(hinstance, PChar(s), i);

   end;

   Result := ico;

finally

   ini.Free;

end;

end;

Code:

GetLogicalDrives()

GetDriveType()

Code:

unit frmMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, MMSystem;

type

TForm1 = class(TForm)

   Memo1: TMemo;

   Button2: TButton;

   Button3: TButton;

   procedure Button2Click(Sender: TObject);

   procedure Button3Click(Sender: TObject);

private

   function IsAudioCD(Drive: char): bool;

public

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

function TForm1.IsAudioCD(Drive: char): bool;

var

DrivePath: string;

MaximumComponentLength: DWORD;

FileSystemFlags: DWORD;

VolumeName: string;

begin

Result := false;

DrivePath := Drive + ':\';

if GetDriveType(PChar(DrivePath)) = DRIVE_CDROM then

begin

   SetLength(VolumeName, 64);

   GetVolumeInformation(PChar(DrivePath), PChar(VolumeName), Length(VolumeName), nil,

     MaximumComponentLength, FileSystemFlags, nil, 0);

   if lStrCmp(PChar(VolumeName), 'Audio CD') = 0 then

     Result := True;

end;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if IsAudioCD(' D ') then

   showmessage('Cd is an audio cd')

else

   showmessage('Cd is not an audio cd');

end;

procedure TForm1.Button3Click(Sender: TObject);

type

TDWord = record

   High: Word;

   Low: Word;

end;

var

msp: TMCI_INFO_PARMS;

MediaString: array[0..255] of char;

ret: longint;

I: integer;

StatusParms: TMCI_STATUS_PARMS;

MciSetParms: TMCI_SET_PARMS;

MciOpenParms: TMCI_OPEN_PARMS;

aDeviceID: MCIDEVICEID;

function GetTheDeviceID: MCIDEVICEID;

begin

   FillChar(MciOpenParms, SizeOf(MciOpenParms), #0);

   try

     MciOpenParms.lpstrDeviceType := 'cdaudio';

     ret := mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE + MCI_OPEN_SHAREABLE,

       LongInt(@MciOpenParms));

     Result := MciOpenParms.wDeviceID;

   except

     on E: Exception do

     begin

       Result := 0;

       showmessage('error receiving deviceIDt' + #13 + SysErrorMessage(GetLastError)

         + #13 + E.Message);

     end;

   end;

end;

function GetTrackInfo(const uMsg: UInt; const fdwCommand: DWord;

   const dwItem: DWord; const dwTrack: DWord): string;

begin

   Result := 'Did not work...';

   FillChar(MediaString, SizeOf(MediaString), #0);

   FillChar(StatusParms, SizeOf(StatusParms), #0);

   StatusParms.dwItem := dwItem;

   StatusParms.dwTrack := dwTrack;

   ret := mciSendCommand(aDeviceID, uMsg, fdwCommand, longint(@StatusParms));

   if Ret = 0 then

     Result := IntToStr(StatusParms.dwReturn);

end;

procedure SetTimeInfo;

begin

   FillChar(MciSetParms, SizeOf(MciSetParms), #0);

   MciSetParms.dwTimeFormat := MCI_FORMAT_MSF;

   ret := mciSendCommand(aDeviceID {Mp.DeviceId}, MCI_SET, MCI_SET_TIME_FORMAT,

     longint(@MciSetParms));

   if Ret <> 0 then

     Showmessage('Error convering timeformat...');

end;

begin

Memo1.Clear;

aDeviceID := GetTheDeviceID;

Application.ProcessMessages;

Memo1.Lines.Add('Track info  :');

SetTimeInfo;

Memo1.Lines.Add('Tracks: ' + GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM,

   MCI_STATUS_NUMBER_OF_TRACKS, 0));

Memo1.Lines.Add(' ');

for I := 1 to StrToInt(GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM,

   MCI_STATUS_NUMBER_OF_TRACKS, 0)) do

begin

   Memo1.Lines.Add('Track ' + IntToStr(I) + '  :  ' + IntToStr(MCI_MSF_MINUTE

     (StrToInt(GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM +

     MCI_TRACK, MCI_STATUS_LENGTH, I)))) + ':' +

     IntToStr(MCI_MSF_SECOND(StrToInt(GetTrackInfo(MCI_STATUS,

     MCI_STATUS_ITEM + MCI_TRACK, MCI_STATUS_LENGTH, I)))));

end;

Application.ProcessMessages;

end;

end.