1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:

//Laufwerke auflisten (können ja mehere sein)
procedure GetDrives(const AItems: TStrings);
const
  DriveTypeTexts: array[DRIVE_UNKNOWN..DRIVE_RAMDISK] of String =
   ('Unbekannt', 'Kein Wurzelverzeichnis', 'Diskette', 'Festplatte', 'Netzlaufwerk', 'CDROM', 'RAMDisk');
var
  Drive: Char;
  DriveType: Integer;
  DriveMask: Integer;
  Flag: Integer;
begin
  DriveMask:=GetLogicalDrives;
  flag:=1;
  for Drive := 'A' to 'Z' do
  begin
    if (flag and DriveMask)<>0 then
    begin
      DriveType := GetDriveType(PChar(Format('%S:\',[Drive]) ) ) ;
      AItems.Add(Format('%s: %s', [Drive, DriveTypeTexts[DriveType]]));
    end;
    flag:=flag shl 1;
  end;
end;

//ist ne audio cd im laufwerk ? <- lässt sich bearbeiten
function IsAudioCD(Drive: string): boolean;
var FSFlags: DWord;
  MaxLength: DWord;
  VolName: String;
begin
  result:=false;
  if GetDriveType(PChar(drive))=DRIVE_CDROM then begin
    SetLength(VolName, 64);
    GetVolumeInformation(PChar(Drive), PChar(VolName), Length(VolName), nil, MaxLength,
      FSFlags, nil, 0);
    if lStrCmp(PChar(VolName), 'Audio CD')=0 then result:=true;
  end;
end;

//öffnen
mciSendString('Set cdaudio door open wait', Nil, 0, Handle);
//schließen
mciSendString('Set cdaudio door closed wait', Nil, 0, Handle);
das gilt aber nur für das standart cdaudio laufwerk                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

private
procedure WMQueryEndSession (var M: TWMQueryEndSession); message 
  WM_QUERYENDSESSION; 

procedure TForm1.WMQueryEndSession (var M: TWMQueryEndSession);
begin
inherited;
{ Hier befindet sich der Quellcode, der ausgeführt werden soll
  wenn Windows beendet werden soll }
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
  private
    procedure WMQueryEndSession (var M: TWMQueryEndSession); message WM_QUERYENDSESSION;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetCDDrives: string;
const
  DriveTypeTexts: array[DRIVE_UNKNOWN..DRIVE_RAMDISK] of String =
   ('Unbekannt', 'Kein Wurzelverzeichnis', 'Diskette', 'Festplatte', 'Netzlaufwerk', 'CDROM', 'RAMDisk');
var
  Drive: Char;
  DriveType: Integer;
  DriveMask: Integer;
  Flag: Integer;
begin
  result:= '';
  DriveMask:=GetLogicalDrives;
  flag:=1;
  for Drive := 'A' to 'Z' do
    begin
      if (flag and DriveMask)<>0 then
      begin
        DriveType := GetDriveType(PChar(Format('%S:\',[Drive]) ) ) ;
        if DriveTypeTexts[DriveType] = 'CDROM' then
          result:= result + drive;
      end;
      flag:=flag shl 1;
    end;
end;

function CDInDrive(Drive: string): boolean;
var
  FSFlags: DWord;
  MaxLength: DWord;
  VolName: String;
begin
  result:=false;
  if GetDriveType(PChar(drive))=DRIVE_CDROM then begin
    SetLength(VolName, 64);
    GetVolumeInformation(PChar(Drive), PChar(VolName), Length(VolName), nil, MaxLength,
      FSFlags, nil, 0);
    if lStrCmp(PChar(VolName), '') <> 0 then result:=true;
  end;
end;

procedure TForm1.WMQueryEndSession(var M: TWMQueryEndSession);
var
  CDs, CDsIn: string;
  i: integer;
begin
inherited;
  CDs:= GetCDDrives;
  CDsIn:= '';
  for i:= 1 to length(CDs) do
    if CDInDrive(CDs[i]+':\') then
      if length(CDsIn) = 0 then
        CDsIn:= CDs[i]+':\' else
          CDsIn:= CDsIn + ',' + CDs[i]+':\';
  if length(CDsIn) <> 0 then
    begin
      beep;
      if length(CDsIn) = 1 then
        showmessage('Im Laufwerk "' + CDsIn + '" befindet sich noch eine CD!') else
          showmessage('In den Laufwerken "' + CDsIn + '" befinden sich noch CDs!');
    end;
end;

end.