Creo que tu código puede simplificarse. No puedo correrlo en mi delphi 7 pero he realizado una prueba estable.
La prueba consiste en guardar la pantalla anterior, capturar una nueva, restar ambas y visualizar los resultados en 3 TImages. Al mismo tiempo Vuelco la resta en un TSream y simulo que lo envío por un socket. El proceso es repetido hasta la saciedad por un Timer a 100 ms.

Te expongo el código usado:

Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image3: TImage;
    Image1: TImage;
    Image2: TImage;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure SendScreen(hSocket: TSOCKET);
    procedure Timer1Timer(Sender: TObject);
  private
    OldScreen, NewScreen, SubScreen: TBitmap;
    primera_vez: boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SendScreen(hSocket: TSOCKET);
var
  ScrDC: HDC;
  Stream: TMemoryStream;
begin

  // Capturo la pantalla nueva
  ScrDC:= GetDc(0);
  BitBlt(NewScreen.Canvas.handle, 0, 0, NewScreen.Width, NewScreen.Height, ScrDC, 0, 0, SRCCOPY);
  ReleaseDC(0, ScrDC);

  if primera_vez then
  begin
    OldScreen.Assign(NewScreen);
    Form1.Image1.Picture.Bitmap.Assign(OldScreen);
    primera_vez:= false;
    exit;
  end;

  // Resto las pantallas nueva y antigua
  // Los TImages son para ver lo que pasa y de paso cargar un poco la máquina
  SubScreen.Handle := CreateSubstractBitmap(NewScreen.Canvas.Handle, OldScreen.Canvas.Handle);
  Image1.Picture.Bitmap.Assign(OldScreen);  Image1.Update;
  Image2.Picture.Bitmap.Assign(NewScreen);  Image2.Update;
  Image3.Picture.Bitmap.Assign(SubScreen);  Image3.Update;
  OldScreen.Assign(NewScreen);

  // Envio
  Stream:= TMemoryStream.Create;
  // Aquí debes usar el componente TPngImage...
  SubScreen.SaveToStream(Stream);
  send(hSocket, Pointer(Stream.Memory)^, Stream.Size, 0);
  Stream.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OldScreen := TBitmap.Create;
  SubScreen := TBitmap.Create;
  NewScreen := TBitmap.Create;
  OldScreen.Width := GetSystemMetrics(SM_CXSCREEN);
  OldScreen.Height := GetSystemMetrics(SM_CYSCREEN);
  NewScreen.Width := GetSystemMetrics(SM_CXSCREEN);
  NewScreen.Height := GetSystemMetrics(SM_CYSCREEN);
  primera_vez:= true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   SendScreen(0);
end;

end.

Haz tus pruebas, seguro que no tienes fugas de memoria.


Saludos.

Hola escafandra

Justamente eso es lo que hice, un formulario con las tres imagenes, lo que no implemente fue el bucle, pero como me funciono entonces lo pase directamente al thread y con objetos creados en vez de timages. Supongo que al estar en un thread quizas habria que hacerlo dentro de la funcion sendscreen en vez de pedirselo a otra, pero tras muchas pruebas el "cuello" no lo tengo en la trasmision de la imagen porque es muy rapido comparando con la gestion de la misma.

Para que veas, estos son los tiempos que se toman en varias maquinas (muy aproximadamente y de memoria)

maquina | bitblt(SRCCOPY | pasar png | write stream | send(-recv( | total recepcion de pantalla
AMD x4 potente | 50-60 ms | 15-30 ms | 70-80 ms | 15-30 ms | 200-250 ms
PC cutre | 200-300 ms | 80-100 ms | 100-120 ms | 15-30 ms | 500-600 ms
Servidor W2003 | 400-500 ms | 130-150 ms | 150-200 ms | 15-30 ms | 800-1000 ms

Es decir al capturar casi 5 megas de pantalla a true color en bimap, luego pasar a png para que se queden entre 700 y 1000 kb, luego pasar ese peso a stream y a tbytes y por fin mandarlo.
Las funciones para obtener la resta de imagenes cursioamente no me suman mucho mas tiempo:confused: supongo que por trabajan con HDC en vez de con el Bitmap, pero eso es solo una suposicion. Lo que tengo que conseguir es un "hardcopy" de baja resolucion de tal manera que ya partamos de manejar pesos inferiores y por consiguiente el resto de procesos se aceleren notablemente. Justamente donde no hay diferencia es lo que los pc comparten, la red local, que ademas es la mas rapida. Mandar luego solo la diferecia ya sera muy bueno.

Voy a ver si aislo el codigo y lo pongo en un server y un cliente y podemos compartirlo en la comunidad.

Un saludo.

Si te fijas en mi código del anterior mensaje, no es necesario el paso a TBytes, con lo que algo de tiempo ahorras:

Código Delphi [-]
send(hSocket, Pointer(Stream.Memory)^, Stream.Size, 0);

La función CreateSubstractBitmap es muy rápida porque trabaja exclusivamente con la API de Windows. Es por eso que te propuse el uso de la API GDI plus de Windows para realizar la compresión a png y porque el código pesa mucho menos. Algunos mensajes mas arriba te expuse un ejemplo con GDI+, puedes tratar de ver si ganas velocidad.

Para bajar la resolución o número de planos de color puedes tratar de usar un HDC adecuado y realizar el bitblt sobre un bitmap de menor resolución cambiando a un StretchBlt pero el resultado puede ser menos vistoso... Bien es verdad que eso puede ajustar a la resolución del monitor donde se tenga que visualizar el resultado, que si es menor estaría desperdiciando información. Una aproximación puede ser enviar la resolución a la función SendScreen para que se ajuste a ella. De todas formas se debe ser cuidadoso con StretchBlt pues la calidad del resultado puede no la esperada.


Saludos.

Hola escafandra, vuelvo por aqui,

Digamos que ya tengo el sistema/estructura terminado (he usado parte de tu codigo optimizado, gracias por las aportaciones), solo me quedan algunos ajustes en el tema de envio de teclas y doble-click.

Me gustaria dejarte el proyecto completo para que vieras su rendimiento y lo uses a tu antojo, no es grande solo 3 modulos .pas el el ejecutable que hace de cliente y servidor a la vez, asi se puede copiar/pegar a varios equipos. Tambien "funciona" por intenet al usar un solo socket. Me he desecho de las indy pero por ahi no he ganado mucha velocidad.

El tema principal es que generar la imagen y comprimirla se lleva un moton de milisegundos, la mas rapida de todas ha excepcion del "printscreen" que es forzosamente un bitmap, es en formato jpg. El programilla maneja tanto bmp, jpg como png. En red local lo mas rapido es bmp, porque solo captura y aunque mande 5 mg por la red estos van muy rapidos.

Para el uso que esta pensado es suficiente, que un programa "gestor de lineas" pueda observar lo que hacen sus pc "esclavos" y para eso va "sobrao" es como una camara de vigilancia, puesdes hacer click y mandar teclas para operaciones sencillas. Ahora me gustaria afinarlo mas, pero como estrucutura cliente/servidor es un "ensayo razonable" que diria un erudito.

No se si es sufucientemente madura para dejarlo en el ftp de proyectos, ¿lo dejo ahi? o te lo hago llegar por otro medio.

Me alegra que tu proyecto avance y que mis aportes te sirvan de ayuda.

No es complicado el envío de teclas y pulsaciones del ratón.

Sobre el tema de un mismo ejecutable para el cliente y el servidor, piensa en ello como un arma de doble filo, el vigilado puede convertirse en vigilante... Por otro lado este tema es controvertido por las implicaciones legales que pueda tener.

Tu decides si quieres subirlo al ftp y cuando subirlo. El nivel de madurez es importante al subir un proyecto terminado y las prestaciones que va a realizar serán las que decidas publicar. En ese punto no te puedo aconsejar mucho mas.

Te agradezco el ofrecimiento de tu proyecto. :)



Saludos.

Hola escafandra.

Te he enviado todo por mail, creo aunque esta escrito en delphi 10 se puede correr sobre cualquier compilador ya que no usa componentes especiales, quiza solo el png, pero con un par de comentarios todo arreglado porque usa tambien bmp y jpg.

La idea/funcion es que el cliente sin vcl este en las maquinas cliente y el visualizador en la de control, en este caso los he juntado para simplificarlo aqui en el foro. En cuanto a las implicaciones legales, bueno, pues ninguna, en principio porque esta destinado a un proyecto industrial y es el cliente el que ha pedido el servicio, pero estoy convencido que lo incluire en proyectos futuros y puede ser un buen argumento de venta "poder ver la pantalla de los clientes en tiempo real" lo mejor seria decir "poder controlar la pantalla de los clientes en tiempo real"

Como aspecto tecnico me queda que funcione bien los click y doble click, el click funciona excepto si se clicka sobre un submenu o botones del sistema como minimizar y cerrar, y el doble-click todavia estoy trabajando en si darle foco a la ventana o no. En cuanto a teclas creo que envio todas ya que no cojo el virtualkey sino la key mismo y la trasmito. aqui muestro la funciones que uso (ya vi un codigo tuyo en delphiacces creo con sendinput pero no me funciona) quiza tenga que analizarlo mejor.

funciones controlador/visualizador

Código Delphi [-]
procedure TFormPantalla.ImagenDblClick(Sender: TObject);
var
  p: TPoint;
  nX, nY: word;
  msg: string;
begin
  GetCursorPos(p);
  // comprobar si esta redimensionada "strech"
  if RGventana.ItemIndex = 1 then
  begin
    if resX >= Imagen.ClientWidth then
    begin
      nX := (p.X * resX) div Imagen.ClientWidth;
      nY := (p.Y * resY) div Imagen.ClientHeight;
    end
    else
    begin
      nX := (p.X * Imagen.ClientWidth) div resX;
      nY := (p.Y * Imagen.ClientHeight) div resY;
    end;
  end
  else
  begin
    nX := p.X;
    nY := p.Y;
  end;
  // enviar mensaje
  msg := '[DBLCLICK-' + IntToStr(nX) + '-' + IntToStr(nY) + ']' + #13 + #10;
  ClienteCMD.Envia(AnsiString(msg));
end;
 
procedure TFormPantalla.ImagenMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  msg: string;
  nX, nY: word;
  boton, pulsado: word;
begin
  // comprobar si esta redimensionada "strech"
  if RGventana.ItemIndex = 1 then
  begin
    if resX >= Imagen.ClientWidth then
    begin
      nX := (X * resX) div Imagen.ClientWidth;
      nY := (Y * resY) div Imagen.ClientHeight;
    end
    else
    begin
      nX := (X * Imagen.ClientWidth) div resX;
      nY := (Y * Imagen.ClientHeight) div resY;
    end;
  end
  else
  begin
    nX := X;
    nY := Y;
  end;
  // comprobar que boton a pulsado
  boton := 0;
  case Button of
    mbLeft: boton := 0;
    mbRight: boton := 1;
    mbMiddle: boton := 2;
  end;
  // ver si hay pulsada alguna tecla
  pulsado := 0;
  if ssShift in Shift then
    pulsado := pulsado and 1;
  if ssAlt in Shift then
    pulsado := pulsado and 2;
  if ssCtrl in Shift then
    pulsado := pulsado and 4;
  if ssDouble in Shift then
    pulsado := pulsado and 8;
  if ssTouch in Shift then
    pulsado := pulsado and 16;
  if ssPen in Shift then
    pulsado := pulsado and 32;
  // enviar mensaje
  msg := '[CLICK-' + IntToStr(boton) + '-' + IntToStr(pulsado) + '-' +
                      IntToStr(nX) + '-' + IntToStr(nY) + ']' + #13 + #10;
  ClienteCMD.Envia(AnsiString(msg));
end;
 
procedure TFormPantalla.ImagenMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  msg: string;
begin
  // si no esta activa la opcion
  if CBcursor.Checked = False then
    Exit;
  // enviar el mensaje
  msg := '[CURSOR-' + IntToStr(X) + '-' + IntToStr(Y) + ']' + #13 + #10;
  ClienteCMD.Envia(AnsiString(msg));
end;
 
procedure TFormPantalla.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  msg: string;
  pulsado: word;
begin
  // ver si hay combinacion de teclas
  pulsado := 0;
  if ssShift in Shift then
    pulsado := pulsado and 1;
  if ssAlt in Shift then
    pulsado := pulsado and 2;
  if ssCtrl in Shift then
    pulsado := pulsado and 4;
  if ssDouble in Shift then
    pulsado := pulsado and 8;
  if ssTouch in Shift then
    pulsado := pulsado and 16;
  if ssPen in Shift then
    pulsado := pulsado and 32;
  // enviar mensaje
  msg := '[KEY-' + IntToStr(Key) + '-' + IntToStr(pulsado) + ']' + #13 + #10;
  ClienteCMD.Envia(AnsiString(msg));
  Key := 0;
  // 16 Shift
  // 17 Ctrl
  // 18 Alt
  // 19 Pausa
  // 44 Imprimir pantalla
  // 46 Supr
  // 91 Windows izquierdo
  // 92 Windows derecho
  // 93 Boton secundario (menu contextual)
  // 144 Bloq Num
  // 145 Bloq Despl
end;

funciones cliente

Código Delphi [-]
procedure TscrServer.ProcesaKey(msg: string; cliente: word);
var
  comandos: TStringList;
  s: string;
  i, key, pulsado: word;
begin
  // recibida tecla pulsada
  s := Copy(msg, 2, Length(msg) - 2);
  s := s + '-';
  comandos := TStringlist.Create;
  ExtraeComandos(comandos, s, '-');
  for i := 0 to comandos.Count - 1 do
    comandos[i] := Copy(comandos[i], 1, Length(comandos[i]) - 1);
  s := comandos[0];
  key := StrToIntDef(comandos[1], 0);
  pulsado := StrToIntDef(comandos[2], 0);
  comandos.Free;
  if (key = 0) and (pulsado = 0) then
  begin
    // Ctrl + Alt + Del (ahi que probar este codigo)
    keybd_event(17, $45, KEYEVENTF_EXTENDEDKEY, 0); // VK_CONTROL
    keybd_event(18, $45, KEYEVENTF_EXTENDEDKEY, 0); // 18 = ALT
    keybd_event(46, $45, KEYEVENTF_EXTENDEDKEY, 0); // VK_DELETE
    keybd_event(17, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0); // VK_CONTROL
    keybd_event(18, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0); // 18 = ALT
    keybd_event(46, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0); // VK_DELETE
  end
  else
  begin
    keybd_event(key, $45, KEYEVENTF_EXTENDEDKEY, 0);
    keybd_event(key, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
  end;
  // 16 Shift
  // 17 Ctrl
  // 18 Alt
  // 19 Pausa
  // 44 Imprimir pantalla
  // 46 Supr
  // 91 Windows izquierdo
  // 92 Windows derecho
  // 93 Boton secundario (menu contextual)
  // 144 Bloq Num
  // 145 Bloq Despl
end;
 
procedure TscrServer.Clickraton(x, y: word; Foco, PosCursor: boolean; boton, pulsado: word);
var
  ClientX, ClientY, ClientBoton, BotonUp, BotonDown: integer;
  Window, Parent: HWnd;
  WindowRect: TRECT;
begin
  // click con cualquier boton del mouse
  // ¿Que objeto se encuentra en las coordenadas facilitadas?
  // (No funciona para ventanas ocultas o deshabilitadas)
  Window := WindowFromPoint(Point(x, y));
  // Si el identificador devuelto es distinto de 0 es que
  // hay un objeto en las coordenadas facilitadas
  if Window = 0 then
    Exit;
  // Coordenadas del objeto
  GetWindowRect(Window, WindowRect);
  // Traslado de las coordenadas facilitadas a las coordenadas del objeto
  ClientX := x - WindowRect.Left;
  ClientY := y - WindowRect.Top;
  // Averiguamos si el objeto tiene ancestro
  Parent := GetAncestor(Window, GA_ROOT);
  // Si el objeto no tiene ancestro, es que es una ventana.
  // Si el objeto tiene ancestro (una ventana), lo utilizamos, ya que el
  // mensaje debe pasarse a una ventana.
  if (Parent = 0) then
    Parent := Window;
  // Si deseas pasar la ventana a primer plano:
  if Foco = True then
    if (Parent <> GetForegroundWindow()) then
      SetForegroundWindow(Parent);
  // Posicionar el cursor si asi se desea
  if PosCursor = True then
    SetCursorPos(X, Y);
  // compronar el boton a pulsar
  ClientBoton := MK_LBUTTON;
  BotonDown := WM_LBUTTONDOWN;
  BotonUp := WM_LBUTTONUP;
  case boton of
    0: begin
      ClientBoton := MK_LBUTTON;
      BotonDown := WM_LBUTTONDOWN;
      BotonUp := WM_LBUTTONUP;
    end;
    1: begin
      ClientBoton := MK_RBUTTON;
      BotonDown := WM_RBUTTONDOWN;
      BotonUp := WM_RBUTTONUP;
    end;
    2: begin
      ClientBoton := MK_MBUTTON;
      BotonDown := WM_MBUTTONDOWN;
      BotonUp := WM_MBUTTONUP;
    end;
  end;
  // Enviamos a la ventana los mensajes correspondientes
  PostMessage(Window, BotonDown, ClientBoton, ClientX or (ClientY shl 16));
  PostMessage(Window, BotonUp, 0, ClientX or (ClientY shl 16));
end;
 
procedure TscrServer.DblClickraton(x, y: word);
var
  ClientX, ClientY: word;
  Window, Parent: HWnd;
  WindowRect: TRECT;
begin
  // doble-click
  // ¿Que objeto se encuentra en las coordenadas facilitadas?
  // (No funciona para ventanas ocultas o deshabilitadas)
  Window := WindowFromPoint(Point(x, y));
  // Si el identificador devuelto es distinto de 0 es que
  // hay un objeto en las coordenadas facilitadas
  if Window = 0 then
    Exit;
  // Coordenadas del objeto
  GetWindowRect(Window, WindowRect);
  // Traslado de las coordenadas facilitadas a las coordenadas del objeto
  ClientX := x - WindowRect.Left;
  ClientY := y - WindowRect.Top;
  // Averiguamos si el objeto tiene ancestro
  Parent := GetAncestor(Window, GA_ROOT);
  // Si el objeto no tiene ancestro, es que es una ventana.
  // Si el objeto tiene ancestro (una ventana), lo utilizamos, ya que el
  // mensaje debe pasarse a una ventana.
  if (Parent = 0) then
    Parent := Window;
  // pasar la ventana a primer plano:
  if (Parent <> GetForegroundWindow()) then
    SetForegroundWindow(Parent);
  SetCursorPos(X, Y);
  // este codigo hai que revisarlo
  // Enviamos a la ventana los mensajes correspondientes
  PostMessage(Window, WM_LBUTTONDOWN, MK_LBUTTON, ClientX or (ClientY shl 16));
  PostMessage(Window, WM_LBUTTONUP, 0, ClientX or (ClientY shl 16));
  Sleep(25);
  PostMessage(Window, WM_LBUTTONDOWN, MK_LBUTTON, ClientX or (ClientY shl 16));
  PostMessage(Window, WM_LBUTTONUP, 0, ClientX or (ClientY shl 16));
end;

Se te ocurre como mejorarlo.

un saludo.

Si. Una vez mas con la API, a bajo nivel.

Has comentado que viste un ejemplo con SendInput. ¿No te funcionó?. Te aseguro que funciona y es el método mejor y mas aconsejable para simular eventos de ratón y teclado. Esa API te permite simular el teclado y el ratón con sólo cambiar el valor de la estructura INPUT. ¿Que te impide enviar un buffer con la estructura?. Simple, con una función en el cliente controlas teclado y ratón.

Saludos.

Bienvenido a clubdelphi, ¿ya leiste nuestra guía de estilo?, gracias por tu colaboración :)

:eek:

Saludos.

Es un mensaje borrado :rolleyes:

Eso pensé... :D


Saludos.

Buenos días, perdona que te moleste, pero he retomado el proyecto y tengo una duda que no consigo resolver.
Deje el tema de resta de imágenes porque tenia que entregarlo y mandaba la imagen completa, ahora estoy enviando la resta y eso es lo que veo, la resta.
Como creo inicialmente una imagen vacía, la primera vez la resta es la imagen completa, pero luego solo pinto la diferencia al asignar el Stream al bitmap.

Esta es la función

Código Delphi [-]
function TFormPantalla.PintaPantalla(): boolean;
var
  LStream: TMemoryStream;
  LPngImage: TPngImage;
begin
  TimerTimeOut.Enabled := False;
  Result := True;
  if Self.WindowState = wsMinimized then
    Exit;
  LPngImage := TPngImage.Create;
  LStream := TMemoryStream.Create;
  try
    LStream.Write(SCRBuffer[0], SCRSize);
    LStream.Position := 0;
    LPngImage.Canvas.Lock;
    LPngImage.LoadFromStream(LStream);
    LPngImage.Canvas.Unlock;
    Imagen.Picture.Assign(LPngImage);
  except
    LStream.Free;
    LPngImage.Free;
    Result := False;
  end;
  LStream.Free;
  LPngImage.Free;
end;

¿Como puedo hacer para, en vez de usar Imagen.Picture.Assign(LPngImagen), que es solo la diferencia, para "sumar" la diferencia recibida a la imagen actual?

Gracias y ya sabes que las ||-|| las pongo yo:)