O soy tonto o .... problema al liberar memoria

[cesarsoftware]

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.

[[escafandra]]

Empezado por cesarsoftware

Se te ocurre como mejorarlo.

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.

[Casimiro Notevi]

Empezado por Pela2

...

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

[[escafandra]]

Empezado por Casimiro Notevi

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

Saludos.

[Casimiro Notevi]

Empezado por escafandra

Saludos.

Es un mensaje borrado

[[escafandra]]

Empezado por Casimiro Notevi

Es un mensaje borrado

Eso pensé...


Saludos.