Envio errores (Delphi4) a través del correo electrónico

[Jose Manuel]

Hola,

He utilizado para copiar la pantalla el siguiente procedimiento, pero esto tiene el problema que cuando realiza la copia, si hay una ventana superpuesta, lo normal en mi caso, ya que llamo a este procedimiento cuando hay un error, se guarda solo la pantalla principal no apareciendo la del mensaje de error y en su lugar queda un recuadro en blanco.

La solución puede ser hacer la copia de la pantalla antes de que aparezca en pantalla el mensaje del error, y pasar al correo electronico el texto del mensaje del error, pero como pasar el texto de la exception a una variable de texto.


Un saludo
Jose Manuel
.................................................

procedure TfVerDiarios.AppException(Sender: TObject; E: Exception);
var
strPath : string;
Errorchar;
begin
Application.ShowException(E);
strPath:=ExtractFileDir(Application.ExeName)+'\';
CrearImg(strPath,'imgtmp.jpg', fverDiarios, error); //Creamos la imagen
end;



procedure CrearImg(_path: string; _file:string; _form:TCustomForm; _except:Pchar);
var
imag: TImage;
jpg: TJpegImage;
desktop: TCanvas;
begin

texto:= 'Si Ud. lo desea puede enviar a través del correo electrónico esta incidencia'+#13+
'explicando brevemente el error producido; al correo que Ud. envie se adjuntará'+#13+
'automáticamente una copia de la pantalla del error.'+#13+#13+
'¿ Quiere enviar la incidencia (S/N) ?';

if Application.MessageBox( pchar(texto),'Envío incidencia por correo electrónico',
MB_OKCANCEL + MB_DEFBUTTON1) <> IDOK then exit;

imag:=TImage.Create(_form);
imag.Width:=screen.Width;
imag.Height:=screen.Height;
desktop:=TCanvas.Create;
with DeskTop do
Handle := GetWindowDC (GetDesktopWindow) ;

with Imag.Canvas do
CopyRect (Rect (0, 0, screen.Width, screen.Height),DeskTop,Rect (0, 0, screen.Width, screen.Height));

jpg:=TJPegImage.Create;
jpg.Assign(imag.Picture.Bitmap);
imag.Free;
jpg.CompressionQuality:=25; //Calidad del JPEG
jpg.Compress; //Comprimimos la imagen
jpg.SaveToFile(_path+_file);
jpg.Free;
desktop.Free;
EnvioMailError(_path+_file, _except);
end;