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

[[escafandra]]

He preparado un ejemplo con GDI+ API Flat que va a funcionar en versiones antiguas de delphi como la 6 y 7. Simplemente enviamos a bajo nivel un bloque de memoria contenido en un istream por un soket:

Código Delphi [-]
uses
  Windows, ActiveX, WinSock;


type
TCLSID = TGUID;
PCLSID = ^TCLSID;

TImageCodecInfo = packed record
   Clsid:             TCLSID;
   FormatID:          TGUID;
   CodecName:         PWCHAR;
   DllName:           PWCHAR;
   FormatDescription: PWCHAR;
   FilenameExtension: PWCHAR;
   MimeType:          PWCHAR;
   Flags:             DWORD;
   Version:           DWORD;
   SigCount:          DWORD;
   SigSize:           DWORD;
   SigPattern:        PBYTE;
   SigMask:           PBYTE;
end;
PImageCodecInfo = ^TImageCodecInfo;

function  wcscmp(wstr1, wstr2: PWCHAR): Integer; cdecl external 'crtdll';

// GDI+ Flat API...
function  GdiplusStartup(var GdiToken: DWORD; Startup, Output: PBYTE): Cardinal; stdcall external 'gdiplus';
procedure GdiplusShutdown(GdiToken: DWORD); stdcall external 'gdiplus';
function  GdipCreateBitmapFromHBITMAP(hbm: HBITMAP; hpal: HPALETTE; var GBitmap: THANDLE): Cardinal; stdcall external 'gdiplus';
function  GdipGetImageEncodersSize(var numEncoders: DWORD; var size: DWORD): Cardinal; stdcall external 'gdiplus';
function  GdipGetImageEncoders(numEncoders, size: DWORD; encoders: PImageCodecInfo): Cardinal; stdcall external 'gdiplus';
function  GdipDisposeImage(image: THANDLE): Cardinal; stdcall external 'gdiplus';
function  GdipSaveImageToStream(image: THANDLE; stream: ISTREAM; var clsidEncoder: TCLSID; encoderParams: Pointer): Cardinal; stdcall external 'gdiplus';


implementation

// Obtener el CLSID para la codificación de un formato gráfico
function GetEncoderClsid(Format: PWCHAR; var Clsid: TCLSID): boolean;
var
  i, N, Size: Cardinal;
  ICInfo: array of TImageCodecInfo;
begin
  Result:= false;
  i:= 0; N:= 0; Size:= 0;
  GdipGetImageEncodersSize(N, Size);
  if Size > 0 then
  begin
    SetLength(ICInfo, Size);
    GdipGetImageEncoders(N, Size, @ICInfo[0]);
    while ( i< N ) and (wcscmp(ICInfo[i].MimeType, Format)<>0) do inc(i);
    if i < N then Clsid:= ICInfo[i].Clsid;
  end;
  Result:= boolean( i < N );
end;

procedure SendScreen(hSocket: TSOCKET);
var
  gdiplusToken: DWORD;
  GdiPlusStartupInput: array[0..2] of int64;
  CursorInf: TCURSORINFO;
  IconInf: ICONINFO;
  hScreen, hCanvas: HDC;
  Bitmap: HBITMAP;
  GBitmap: THANDLE;
  Stream: IStream;
  stat: STATSTG;
  Clsid: TCLSID;
  hMem: HGLOBAL;
  Memory: Pointer;

begin
  // Inicializamos GDI+.
  GdiPlusStartupInput[0]:= 1; GdiPlusStartupInput[1]:= 0;
  if GdiplusStartup(gdiplusToken, @GdiPlusStartupInput, nil) <> 0 then exit;

  // Capturo la pantalla
  hScreen:= GetDC(0);
  hCanvas:= CreateCompatibleDC(0);
  Bitmap:= CreateCompatibleBitmap(hScreen,GetDeviceCaps(hScreen, HORZRES), GetDeviceCaps(hScreen, VERTRES));
  SelectObject(hCanvas, Bitmap);
  BitBlt(hCanvas, 0, 0, GetDeviceCaps(hScreen, HORZRES), GetDeviceCaps(hScreen, VERTRES), hScreen, 0, 0, SRCCOPY);

  // Capturo el cursor
  ZeroMemory(@CursorInf, sizeof(TCURSORINFO));
  CursorInf.cbSize:= sizeof(TCURSORINFO);
  if GetCursorInfo(CursorInf) and (CursorInf.flags = CURSOR_SHOWING) then
  begin
    GetIconInfo(CursorInf.hCursor, IconInf);
    DrawIcon(hCanvas, CursorInf.ptScreenPos.x - IconInf.xHotspot, CursorInf.ptScreenPos.y - IconInf.yHotspot, CursorInf.hCursor);
    DeleteObject(IconInf.hbmColor);
    DeleteObject(IconInf.hbmMask);
  end;

  // Procedo a enviar un bloque de memoria con la imagen comprimida en png
  CreateStreamOnHGlobal(0, true, stream);
  GdipCreateBitmapFromHBITMAP(Bitmap, 0, GBitmap);
  GetEncoderCLSID('image/png', Clsid);
  GdipSaveImageToStream(GBitmap, stream, Clsid, nil);
  // Obtengo el tamaño del bloque de memoria
  stream.Stat(stat, STATFLAG_NONAME);
  // Obtengo el puntero del bloque de memoria (stat.cbSize)
  GetHGlobalFromStream(stream, hMem);
  Memory:= GlobalLock(hMem);

  // Envío el bloque de memoria
  send(hSocket, Memory^, stat.cbSize, 0);

  // libero los Objetos usados del GDI+ bloques y Handles
  GdipDisposeImage(GBitmap);
  GlobalUnlock(hMem);
  DeleteObject(Bitmap);
  DeleteDC(hCanvas);
  ReleaseDC(0, hScreen);

  // Shutdown GDI+
  GdiplusShutdown(gdiplusToken);
end;

Saludos.

[cesarsoftware]

Entendido escafandrada

Pero al final tienes que crear un stream para pasarle la imagen, es decir solo nos ahorramos el componente TPng pero se "complica" un poco usando las GDI (que tengo que estudiarlas a fondo, gracias por el ejemplo). La funcion "PintaPantalla" con componentes tarda entre 64 y 78 ms en realizar la operacion en casi cualquier PC.
Es las pruebas que he realizado (por cierto que he "cargado" los componentes Indy de la parte del servidor y los e reemplazado por socket, ya sabes bind, linten, accept y thread, luego los sustituyo en el cliente) la eficiencia es similar. Donde mas me preocupa la eficiencia es la copia de zonas de memoria.

Ahora tengo un "RxBuffer: array[0..65535] of ansichar;" en el servidor que lo recoje de "RxLen := recv(nSocket, RxBuffer, 65536, 0);" y veras que tengo un bucle for para copiar el contenido, ahi si creo que estoy fallando en rendimiento. No veo la funcion que permite esa copia de memoria tipo strcopy etc ¿sabes tu cual es?
Bueno en realizad tengo una zona donde recibo del socket que "RxBuffer" y lo copio con "for" al onRecibido y este "ServidorRecibido" incrementa el buffer para generar la imagen. Tambien seria genial saber cual es la funcion que copia, o mejor dicho, incrementa un buffer con el contenido de otro.

Gracias por seguir el tema (curiosa las funciones Lock/UnLock del bitmap, jejeje)

Código Delphi [-]
var
    SCRBuffer: array of ansichar;

procedure TFormPantalla.ServidorRecibido(Sender: TObject);
var
  i, rec, p: integer;
begin
  p := SCRrec; // posicion anterior
  rec := ServidorSCR.RxLen;
  Inc(SCRRec, rec);
  SetLength(SCRbuffer, SCRRec);
  for i := 0 to rec - 1 do
    SCRBuffer[p + i] := ServidorSCR.RxBuffer[i];
  if (GetTickCount() - tOutLoad) > 5000 then
  begin
    Application.MessageBox('TimeOut > 5000 ms', 'Atención', MB_ICONWARNING + MB_OK);
    Imagen.Picture := nil;
    Imagen.Refresh;
    SCRSize := 0;
    SCRRec := 0;
    SetLength(SCRBuffer, 0);
    GaugeLoad.Progress := 0;
    GaugeLoad.Refresh;
    tOutLoad := GetTickCount();
    Exit;
  end;
  GaugeLoad.Progress := Length(SCRBuffer);
  GaugeLoad.Refresh;
  tOutLoad := GetTickCount();
  if SCRrec = SCRSize then
  begin
    PintaPantalla();
    SCRSize := 0;
    SCRRec := 0;
    SetLength(SCRBuffer, 0);
    tFinLoad := GetTickCount();
    STtimeLoad.Caption := IntToStr(tFinLoad - tIniLoad) + ' ms.';
    Pidepantalla();
  end;
end;

procedure TFormPantalla.ProcesaPantalla(recibido: string);
begin
  SCRSize := StrToIntDef(Copy(recibido, 6, Length(recibido) - 6), 0);
  GaugeLoad.MaxValue := SCRSize;
  GaugeLoad.Refresh;
end;

procedure TFormPantalla.PintaPantalla();
var
  LStream: TMemoryStream;
  LPngImage: TPngImage;
begin
  LStream := TMemoryStream.Create;
  LPngImage := TPngImage.Create;
  try
    LStream.Write(SCRBuffer[0], SCRSize);
    LStream.Position := 0;
    LPngImage.Canvas.Lock;
    LPngImage.LoadFromStream(LStream);
    LPngImage.Canvas.Unlock;
    Imagen.Picture.Assign(LPngImage);
    Imagen.Refresh;
  finally
    LStream.Free;
    LPngImage.Free;
  end;
end;

procedure TFormPantalla.PidePantalla;
var
  msg: ansistring;
begin
  tIniLoad := GetTickCount();
  tOutLoad := tIniLoad;
  msg := '[OKSCR]' + #13 + #10;
  ClienteCMD.Envia(AnsiString(msg));
end;

[cesarsoftware]

Ah escafandra. Un comentario.

La opcion de usar png es que en nivel 1 de compresion (el mas rapido, tienen 9 niveles y 0 es sin comprimir) un "printscreen" solo ocupa unos 300kb para enviar por el socket y una imagen BitMap se va a los 5 Mb, dato muy a tener en cuenta a nivel de rendimiento, aunque supongo que al hacelo en png quedara mas pequeño ¿o no? ¿cuanto ocupara "send(hSocket, Memory^, stat.cbSize, 0);"?

Código Delphi [-]
  GdipCreateBitmapFromHBITMAP(Bitmap, 0, GBitmap);
  GetEncoderCLSID('image/png', Clsid);
  GdipSaveImageToStream(GBitmap, stream, Clsid, nil);

Un saludo.

[[escafandra]]

Empezado por cesarsoftware

Pero al final tienes que crear un stream para pasarle la imagen, es decir solo nos ahorramos el componente TPng pero se "complica" un poco usando las GDI

Creas un Stream pero con la API de Windows con lo que ahorras recursos de la VCL aunque su verdadera utilidad sería en un mini servidor que no use VCL y por tanto reduzca su peso consideráblemente.

Empezado por cesarsoftware

Donde mas me preocupa la eficiencia es la copia de zonas de memoria.

...tengo un bucle for para copiar el contenido, ahi si creo que estoy fallando en rendimiento. No veo la funcion que permite esa copia de memoria tipo strcopy etc ¿sabes tu cual es?

CopyMemory.

Empezado por cesarsoftware

La opcion de usar png es que en nivel 1 de compresion (el mas rapido, tienen 9 niveles y 0 es sin comprimir) un "printscreen" solo ocupa unos 300kb para enviar por el socket y una imagen BitMap se va a los 5 Mb, dato muy a tener en cuenta a nivel de rendimiento, aunque supongo que al hacelo en png quedara mas pequeño ¿o no? ¿cuanto ocupara "send(hSocket, Memory^, stat.cbSize, 0);"?

Tal como está el código cada pantalla pesa unos 92Kb, pero sabes que png es un formato de compresión sin pérdida de calidad, con lo que pantallas con fotografías o vídeo pasarán bastante mas. La relación de compresión también puede manejarse con GDI+:

Código Delphi [-]
type
TEncoderParameter = packed record
   Guid:           TGUID;
   NumberOfValues: ULONG;
   Type_:          ULONG;
   Value:          Pointer;
end;
PEncoderParameter = ^TEncoderParameter;

TEncoderParameters = packed record
   Count     : UINT;
   Parameter : array[0..0] of TEncoderParameter;
end;
PEncoderParameters = ^TEncoderParameters;


procedure GetEncoderParameters(EP: PEncoderParameters; Quality: PULONG);
const
  EncoderQuality: TGUID = '{1d5be4b5-fa4a-452d-9cdd-5db35105e7eb}';
begin
  // Calidad de imagen y factor de compresión
  // Quality = 100 es la maxima calidad.
  EP.Count:= 1;
  EP.Parameter[0].Guid:= EncoderQuality;
  EP.Parameter[0].Type_:= 4; //Gdiplus::EncoderParameterValueTypeLong;
  EP.Parameter[0].NumberOfValues:= 1;
  EP.Parameter[0].Value:= Quality;
end;
..........

var
  Quality: ULONG;
  EP: TEncoderParameters;
begin
........
GetEncoderParameters(@EP, @Quality);
GdipSaveImageToStream(GBitmap, stream, Clsid, @EP);

Saludos.

[[escafandra]]

Otra cosa, ¿Has pensado en utilizar un sistema para enviar por red sólo lo que varía de una imagen a la siguiente, en lugar de pantallas completas?

Mira este enlace: resta de imágenes.


Saludos.

[cesarsoftware]

Empezado por escafandra

Otra cosa, ¿Has pensado en utilizar un sistema para enviar por red sólo lo que varía de una imagen a la siguiente, en lugar de pantallas completas?

Mira este enlace: resta de imágenes.


Saludos.

Co..ño escafandra. Muchas gracias, se ve que te lo curras bien, voy a poner en practica ahora mismo la resta de imagenes.
Que si, que llevaba tiempo pensando en hacerlo pero mas "a pelo" no usando la fuerza bruta e intelegente como la tuya, jejeje.
Supongo que el tema es buscar en las lineas "lo negro" y enviar la parte de la linea que no sea negro indicando X,Y y Len al socket.
Veremos que tal va de rendimiento.

PD: No conocia ese foro, tendre que visitarlo con calma. Ah "CopyMemory" si es que a veces nos pesa la cabeza....

Thanks.

[[escafandra]]

Empezado por cesarsoftware

...Supongo que el tema es buscar en las lineas "lo negro" y enviar la parte de la linea que no sea negro indicando X,Y y Len al socket.

No, es mas sencillo que eso. La resta de imágenes te da una gran extensión en negro, al comprimir toda esa imagen, el "negro" no ocupa prácticamente nada, así que comprimes toda esa imagen a png. Luego debes encontrar una máscara de bits de la imagen, para saber que tienes que reconstruir en el PC destino. Simplemente envías dos imágenes de poco peso, la máscara (una imagen de un sólo plano de color) y la resta. En el PC destino basta realizar unas operaciones lógicas binarias con la imagen previa, la máscara y la resta... La API mágica que te va a permitir realizar de golpe esas operaciones, con toda la imagen va a ser BitBlt. Estudia los raster-operation codes.

En el enlace que te dí sobre el tema de resta de imágenes, encontrarás el uso de la API BitBlt con las operaciones lógicas y el uso de máscaras de bit para imágenes. En este otro tema también trabajo con máscaras: Transparencias.


Saludos.