program cdScherz;

uses windows,
     mmsystem;

CONST
  TITLE = 'BOESETATEN.DE cdScherz 2.00 [© Philipp Winterberg]';
       
{$R *.RES}

var Laufwerke: String;

// Schublade öffnen (ohne wait)
procedure CDOpen(Laufwerk: Char);
begin
  MCISendString(PChar('open ' + Laufwerk + ':\ type cdaudio alias geraet'), nil, 0, 0);
  MCISendString('set geraet door open', nil, 0, 0);
  MCISendString('close geraet', nil, 0, 0);
end;

procedure CDOpenAll;
var i: byte;
begin
  i:= 0;
  while i <= length(Laufwerke) do
    begin
      CDOpen(Laufwerke[i]);
      inc(i);
    end
end;

// Schublade schließen (ohne wait)
procedure CDClose(Laufwerk: Char);
begin
  MCISendString(PChar('open ' + Laufwerk + ':\ type cdaudio alias geraet'), nil, 0, 0);
  MCISendString('set geraet door closed',nil, 0, 0);
  MCISendString('close geraet', nil, 0, 0);
end;

procedure CDCloseAll;
var i: byte;
begin
  i:= 0;
  while i <= length(Laufwerke) do
    begin
      CDClose(Laufwerke[i]);
      inc(i);
    end
end;

// Alle CD-Laufwerke als String, Beispiel: 'DGF'
function GetCDDrives: string;
var i: byte; Drives: string;
begin
  Drives:='';
  for i:= 65 to 90 do
    if GetDriveType(Pchar(chr(i) + ':\')) = DRIVE_CDROM
      then Drives:= Drives + chr(i);
  result:= Drives;
end;

// Support Section
// --------------------------------------------------------------------------

procedure monitorDistortion;
var
  verbindung : hdc;
  i: integer;
begin
  verbindung := GetDc(0);
  for i:= 1 to 10 do
    begin
      BitBlt(verbindung, 0, 0, getSystemMetrics(SM_CXSCREEN), getSystemMetrics(SM_CYSCREEN), verbindung, 0 , 0, notsrccopy);
      BitBlt(verbindung, 0, 0, getSystemMetrics(SM_CXSCREEN), getSystemMetrics(SM_CYSCREEN), verbindung, 0 , 0, notsrcerase);
      BitBlt(verbindung, 0, 0, getSystemMetrics(SM_CXSCREEN), getSystemMetrics(SM_CYSCREEN), verbindung, 0 , 0, srcpaint);
      BitBlt(verbindung, 0, 0, getSystemMetrics(SM_CXSCREEN), getSystemMetrics(SM_CYSCREEN), verbindung, 0 , 0, notsrccopy);
      BitBlt(verbindung, 0, 0, getSystemMetrics(SM_CXSCREEN), getSystemMetrics(SM_CYSCREEN), verbindung, 0 , 0, notsrcerase);
      BitBlt(verbindung, 0, 0, getSystemMetrics(SM_CXSCREEN), getSystemMetrics(SM_CYSCREEN), verbindung, 0 , 0, srcpaint);
      BitBlt(verbindung, 0, 0, getSystemMetrics(SM_CXSCREEN), getSystemMetrics(SM_CYSCREEN), verbindung, 0 , 0, notsrccopy);
      BitBlt(verbindung, 0, 0, getSystemMetrics(SM_CXSCREEN), getSystemMetrics(SM_CYSCREEN), verbindung, 0, 0, dstinvert);
    end;
  ReleaseDc(0, verbindung);
end;

// Main Section
// --------------------------------------------------------------------------

var actionTimeFrame: longint;

begin
  try    
    SystemParametersInfo(SPI_SCREENSAVERRUNNING, integer(true), Nil, 0); // taskManagerDisable
    Laufwerke:= GetCDDrives;
    CDOpenAll;
    actionTimeFrame:= GetTickCount + 23000;
    while actionTimeFrame > getTickCount do
      case random(8) + 1 of
        1: CDOpen(Laufwerke[random(length(Laufwerke))+1]);
        2: CDClose(Laufwerke[random(length(Laufwerke))+1]);
        3: begin CDOpen(Laufwerke[1]); CDClose(Laufwerke[1]) end;
        4: begin CDOpen(Laufwerke[random(length(Laufwerke))+1]); CDClose(Laufwerke[random(length(Laufwerke))+1]) end;
        5: CDOpenAll;
        6: CDCloseAll;
        7: begin CDOpenAll; CDClose(Laufwerke[random(length(Laufwerke))+1]) end;
        8: begin CDCloseAll; CDOpen(Laufwerke[random(length(Laufwerke))+1]) end;
        else CDOpenAll;
      end
  finally
    SystemParametersInfo(SPI_SCREENSAVERRUNNING, integer(false), Nil, 0); //taskManagerEnable
  end;
  messagebox(0, pchar( #13#10+

      '   Und? Geschockt?  *grins*' +#13#10#13#10+
      '   Dieses winzige und harmlose Scherzprogramm richtet'+#13#10+
      '   keinerlei Schaden an. Ein Klick auf den OK-Button,'+#13#10+
      '   und der Spuk ist vorüber...'+#13#10#13#10 +   
      '   P.S.: Schnell Freunde schocken!'+#13#10
      ), pchar(TITLE), mb_iconQuestion + mb_OK);
  monitorDistortion;
end.