[[seoane]]

Namaris, espero que esto no se vuelva una costumbre. Tanto lo de pedir programas a la carta, como lo de engañar a tu familia, que esta muy feo

Aquí te dejo una aplicación que al ejecutarse muestra un pantallazo azul. La única forma de salir es con Ctr+Alt+Supr.

El código (el ejecutable esta en el zip):

Código Delphi [-]
program BlueScreen;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils;


const
  Mensaje =
  '*** STOP: 0x0000007B (0xF201B84C,0xC0000034,0x00000000,0x00000000)' +#13#10+
  'INACCESIBLE_BOOT_DEVICE'                                      +#13#10#13#10+
  'If this is the first time you have seen this Stop error screen,'    +#13#10+
  'restart your computer. If this screen appears again, follow'        +#13#10+
  'these steps:'                                                 +#13#10#13#10+
  'Check for viruses on your computer. Remove any newly installed'     +#13#10+
  'hard drives or hard drive controllers. Check your hard drive'       +#13#10+
  'to make sure it is properly configured and teminated.'              +#13#10+
  'Run CHKDSK /F to check for hard drive corruption, and then'         +#13#10+
  'restart your computer.'                                       +#13#10#13#10+
  'Refer to tour Getting Started manual for more information on'       +#13#10+
  'troubleshooting Stop errors.';

const
  WH_KEYBOARD_LL = 13;

function SetConsoleDisplayMode(hConsoleOutput: THandle; dwFlags: DWORD;
  var pNewScreenBufferDimensions: TCoord): BOOL; stdcall;
  external 'Kernel32.dll' name 'SetConsoleDisplayMode';

function HandlerRoutine(dwCtrlType: DWORD): BOOL; stdcall;
begin
  Result:= TRUE;
end;

function KbdHook(Code: Integer; WParam, LParam: DWORD): HHook; stdcall;
begin
  Result:= 1;
end;

procedure Loop;
var
  Msg: TMsg;
begin
  while GetMessage(Msg,0,0,0) do
    DispatchMessage(Msg); 
end;

procedure WriteMsg;
var
  F: TextFile;
  Str: String;
begin
  if FileExists(ChangeFileExt(ParamStr(0),'.txt')) then
  begin
    AssignFile(F,ChangeFileExt(ParamStr(0),'.txt'));
    {$I-}
      Reset(F);
    {$I+}
    if IOResult=0 then
    begin
      while not EOF(F) do
      begin
        Readln(F,Str);
        Writeln(Str);
      end;
      CloseFile(F);
    end else
      Writeln(Mensaje);
  end else
    Writeln(Mensaje);
end;

var
  BufferSize: DWORD;
  Hook: HHook;
  ScreenBuffer: THandle;
  Coord: TCoord;

begin
  ScreenBuffer:= GetStdHandle(STD_OUTPUT_HANDLE);
  if ScreenBuffer <> INVALID_HANDLE_VALUE then
    if SetConsoleDisplayMode(ScreenBuffer,1,Coord) then
    begin
      FillChar(Coord,Sizeof(Coord),0);
      FillConsoleOutputAttribute(ScreenBuffer,FOREGROUND_RED or FOREGROUND_BLUE or
        FOREGROUND_GREEN or FOREGROUND_INTENSITY or BACKGROUND_BLUE,
        MAXINT, Coord, BufferSize);
      SetConsoleTextAttribute(ScreenBuffer,FOREGROUND_RED or FOREGROUND_BLUE or
        FOREGROUND_GREEN or FOREGROUND_INTENSITY or BACKGROUND_BLUE);
      SetConsoleCursorPosition(ScreenBuffer,Coord);
      if SetConsoleCtrlHandler(@HandlerRoutine,TRUE) then
      begin
        Hook:= SetWindowsHookEx(WH_KEYBOARD_LL, @KbdHook, HInstance, 0);
        if Hook <> 0 then
        begin
          WriteMsg;
          Loop;
          UnhookWindowsHookEx(Hook);
        end;
      end;
    end;
end.

PD: Hace tanto tiempo que no veía ninguna que tuve que copiar el mensaje de la wikipedia.