HELP: My popup program breaks down!?!

My turbo pascal popup program breaks down every 5 times.

Can you help me create a secure popup program. The purpose of the program is to
copy lines from a running program (in text mode). The lines are picked out with
the mouse and stored in a text file. If you need to examine the "running
program" please e-mail me!

My program looks as follows:

Program Popup;

{$M 16345,0,0}

Uses    crt,dos,graph;

Var     chars          :byte;
        outfil         :text;
        a,b,c,q,r,s,x  :integer;
        regs           :registers;
        scrn           :array[0..4000] of byte;

Const   Erder          :word = 0;

{Mouse function}

Procedure Callmouse;
  begin
  intr($33,regs);
  end;

Function Mouseinit:boolean;
  begin
  regs.ax:=0;  
  Callmouse;
  if regs.ax <> 0 then mouseinit:=true;
  else
    begin
    writeln('No mouse or driver detected.');
    halt;
    end;
  end;

Procedure MouseOn;
  begin
  regs.ax:=1;
  callmouse;
  end;

Procedure mouseOff;
  begin
  regs.ax:=2;  
  callmouse;
  end;

Procedure readmousepos(Var x,y,b:integer);
  begin
  regs.ax:=3;
  callmouse;
  x:=regs.cx;
  y:=regs.dx;
  b:=regs.bx;
  end;

Procedure set_x_values(max,min : integer);
  begin
  regs.ax:=7;
  regs.cx:=min;
  regs.dx:=max;
  callmouse;
  end;

Procedure set_y_values(max,min : integer);    
  begin
  regs.ax:=8;
  regs.cx:=min;
  regs.dx:=max;
  callmouse;
  end;

{End of mouse function}

Procedure grab:
  begin
  for c:=1 to 4000 do scrn[c]:=mem[$b800 : c];

  textcolor(15);textbackground(green);
  gotoxy(27,1);write(' Popup program active ');
  textbackground(red);
  gotoxy(7,2);write('Use mouse to copy lines into file - End with <SPACE>`);
  textbackground(black);

  assign(outfil,c:\elinst\popup3b.dat');
  append(outfil);

  mouseon;
  while not keypressed do
    begin
    for a:=1 to 145 do
      begin
      readmousepos(q,r,s);
      if s+1 then
        begin
        chars:=mem[$b800 : (8+a-2(round(r/8)*160))];
        if chars>99 then writeln(outfil,'0',chars)
        else writeln(outfil,chars);
        inc(a);
        end;
      mem[$b800 : (round(r/8)*160)]:=62;
      mem[$b800 : (round(r/8)*160)]:=15;
      delay(1000);
      end;
    end;
  mouseoff;
  close(outfil);
  for c:=0 to 4000 do mem[$b800 : c]:=scrn[c];
  end;

Procedure Intproc(flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:word);interrupt;
  begin
  if Erder = 1 then exit;
  Erder:=1;
  grab;
  Erder:=0;
  end;

Begin {Main}
  setintvec($05,addr(intproc));
  keep(0);
  end.

Please e-mail me!!!

--

Bobby Rafn : mailto:BO...@control.auc.dk