Necesito una pantalla azul de error Windows

[Ñuño Martínez]

Pues mira, puedes utilizar Allegro.pas (si utilizas Delphi deberás trucarlo un poco, pero seoane dijo que no era complicado) para abrir un programa en pantalla completa, dibujar el pantallazo azul y capturar el teclado. Como es una librería para juegos, podrás capturar combinaciones como la que dices sin muchos problemas.

Perdón por el spam, pero creo que merece la pena para una broma así.

[Namaris]

Empezado por Ñuño Martínez

Pues mira, puedes utilizar Allegro.pas (si utilizas Delphi deberás trucarlo un poco, pero seoane dijo que no era complicado) para abrir un programa en pantalla completa, dibujar el pantallazo azul y capturar el teclado. Como es una librería para juegos, podrás capturar combinaciones como la que dices sin muchos problemas.

Perdón por el spam, pero creo que merece la pena para una broma así.

Me he bajado eso pero nose de que va xD
Esque yo no se programar en realidad, postee aqui porque pense que como aqui si sabes me podrian ayudar

Simplemente necesito que salga una ventana azul al inciar y que solo se pueda quitar cn una combinacion de teclas

[[Caral]]

Hola
Bueno que tal esto:
Creas una nueva aplicacion, colocas un boton, un timer, cuatro labels.
Eliminas todo del unit y colocas el codigo completo que esta abajo.
Tienes que colocar los eventos, osea darle un click al boton, un click al label1 un click al onformshow y destroy, fijate bien, la unica manera de salir del programa sera dando click sobre el label1.
Puedes darle el color y formato que quieras a los label.
Bueno como dice Roman, que me perdone tu papa.
Va:

Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
   // La posicion del label que estamos dibujando (de 1..9)
    _labelActual:Integer;
    { Private declarations }
    procedure CreateParams(var Params: TCreateParams); override;


  public
    { Public declarations }
  end;

  // Define una lista de posiciones
  labelPosition = array[1..20] of integer;

const
  // Amarillo
  POSITION_lab1X:labelPosition = (1152,1144,1040,992,904,856,768,728,640,592,512,472,392,352,280,240,160,120,48,16);
  POSITION_lab1Y:labelPosition = (216,216,216,216,216,216,216,216,216,216,216,216,216,216,216,216,216,216,216,216);
  // Violeta
  POSITION_lab2X:labelPosition = (1152,1144,1040,992,904,856,768,728,640,592,512,472,392,352,280,240,160,120,48,16);
  POSITION_lab2Y:labelPosition = (304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,304,304);
  // Rojo
  POSITION_lab3X:labelPosition = (1152,1144,1040,992,904,856,768,728,640,592,512,472,392,352,280,240,160,120,48,16);
  POSITION_lab3Y:labelPosition = (248,248,248,248,248,248,248,248,248,248,248,248,248,248,248,248,248,248,248,248);

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.CreateParams(var Params: TCreateParams);
 begin
 inherited CreateParams(Params);
 with Params do
 Style := (Style or WS_POPUP) and not WS_DLGFRAME;

 end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Close;

end;

procedure TForm1.Label1Click(Sender: TObject);
begin
   Button1.Perform(WM_LButtonDown,0,0);
   Sleep(250);
   Button1.Perform(WM_LButtonUp,0,0);


end;

procedure TForm1.FormShow(Sender: TObject);
begin
 Form1.Align:= alClient;
 Form1.Color:= clActiveCaption;
 Button1.Visible:= False;
 Label1.Caption:= 'Falla grave  Microsoft ....................................';
 Label2.Caption:= 'Este ordenador esta por fallar';
 Label4.Caption:= 'Necesita memoria urgente';
 Label3.Caption:= 'Que papa, me la compra?';
 //Esconde Barra de inicio
     ShowWindow(FindWindow
    ('Shell_TrayWnd',nil), SW_HIDE) ;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  total:Integer;
begin

  // Que pez estamos dibujando
  _labelActual := _labelActual + 1;
  total := Length(POSITION_lab1X);

  // Se ha acabado?
  if (_labelActual > total) then begin
     _labelActual:= 0;
  {  TimerAnim.Enabled := False;
    I1.Visible := False;
    IV1.Visible := False;
    IR1.Visible := False;
    // Sacar el Main
    //...

   Exit;}
  end
  else begin
    // Amarillo
    label2.Visible := True;
    label2.Transparent := True;
    label2.Left := POSITION_lab1X[_labelActual];
    label2.Top := POSITION_lab1Y[_labelActual];
    // Violeta
    label3.Visible := True;
    label3.Transparent := True;
    label3.Left := POSITION_lab2X[_labelActual];
    label3.Top := POSITION_lab2Y[_labelActual];
    // Rojo
    label4.Visible := True;
    label4.Transparent := True;
    label4.Left := POSITION_lab3X[_labelActual];
    label4.Top := POSITION_lab3Y[_labelActual];


end;
  end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
   //Muestra Barra de inicio
     ShowWindow(FindWindow
    ('Shell_TrayWnd',nil), SW_SHOWNA) ;
end;

end.

Este codigo es en parte aporte de mis Maestros del foro.
Saludos

[Namaris]

Gracias Caral por tu ayuda pero esto.........que hago con este codigo? me bajo alcun complilador de Delphi y lo copio y pego ahi?


Una vez que lo tng pues que hago? lo coloco en inicio de windows?


Un saludo

[Ñuño Martínez]

Empezado por Namaris

Me he bajado eso pero nose de que va xD
Esque yo no se programar en realidad, postee aqui porque pense que como aqui si sabes me podrian ayudar

Gracias Caral por tu ayuda pero esto.........que hago con este codigo? me bajo alcun complilador de Delphi y lo copio y pego ahi?


Una vez que lo tng pues que hago? lo coloco en inicio de windows?

Sólo puedo decir una palabra: ¡LOLAZO!

No te lo tomes como insulto, lo que pasa es que no me lo esperaba (bueno, ni yo ni nadie de este foro ).

A ver, alguien que compile el programa que ha publicado nuestro amigo y eterno padawan Caral y le pase el ejecutable a Namaris, a ser posible bien envuelto para su fácil instalación. Yo es que no tengo el compilador listo y estoy haciendo limpieza. Gracias.

[[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.

[dec]

Hola,

Está muy bien Seoane. Ayer inicié yo un intento... y terminé mal porque comenzé peor, a lo que veo.

[[seoane]]

Bueno, lo modifique un poco. Ahora si encuentra en el mismo directorio un archivo con su mismo nombre pero con la extensión .txt (ej: BlueScreen.txt) muestra el contenido de ese archivo, en vez del mensaje que yo puse.

Ahora solo falta que a alguien se le ocurra un buen mensaje de error.

Algo así (BlueScreen.txt):

*** STOP: 0x0000007B (0xF201B84C,0xC0000034,0x00000000,0x00000000)
INACCESIBLE_BOOT_DEVICE

Si es la primera vez que lees este mensaje te sentiras confuso
y asustado, pero sera mejor que te relajes porque no sera la
ultima vez. 

Ahora probaremos un par de cosas sin sentido para que te sientas
mejor, no solucionaran el problema, pero aliviaran tu sensacion
de impotencia. Pero cuando todo falle lo mejor sera reiniciar y
rezar para que todo funcione ... esto me recuerda el chiste que
dice que van un informatico, un mecanico y un electricista en
un coche y el coche se para ....


Sabias lo que hacias cuando instalaste Windows. Ahora no te quejes.

PD: El mensaje se lo dedico a Casimiro , y alguno mas ...

[[Caral]]

Hola
Seoane Y=?:

un coche y el coche se para ....

Bueno, nos dejas colgados , vamos terminalo que no lo conozco
Saludos

[Casimiro Noteví]

Empezado por seoane

Sabias lo que hacias cuando instalaste Windows. Ahora no te quejes.
[/code]
PD: El mensaje se lo dedico a Casimiro , y alguno mas ...

Muchas gracias, se me han saltado unas lagrimitas, de la emoción, qué bonito, lo voy a imprimir y ponerlo en la pizarra de anuncios, en el trabajo, para que todos lo vean