Entwickler-Ecke :: Thema anzeigen - Screenshots werden nicht aus dem RAM entladen

aM0xACiLLiN - Fr 19.09.03 16:15
Titel: Screenshots werden nicht aus dem RAM entladen

Hi!
Ich habe ein Programm um über das Netzwerk 3 PCs zu überwachen geschrieben. In dem Programm wird alle 5 Sekunden ein Screenshot abgefragt (vom Server aus). Das Problem ist jetzt allerdings dass die Screenshots wohl nicht komplett(oder garnicht?) aus dem RAM entladen werden und somit nach einiger Zeit der RAM voll ist ("Für diesen Befehl ist nicht genügend Speicher vorhanden"). Ich hab' allerdings alle Objekte mit .free wieder freigegeben (denke ich).
Hier ist der Code:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:

Procedure TForm1.Bmp2Jpg (BmpFileName : String; JpgSavePath : string; Comp : Integer);
var bmp:TBitmap; Jpg:TJpegImage;
begin
  bmp:=TBitmap.Create; jpg:=TJpegImage.Create;
  try bmp.LoadFromFile (BmpFileName);
    if comp < 1 then exit;
    if comp > 100 then exit;
    Jpg.CompressionQuality:=Comp; Jpg.Assign(bmp);
    Jpg.SaveToFile (JpgSavePath + '.jpg');
  finally jpg.Free; bmp.Free;
  end;
end;

procedure ScreenShot(var OurImage:TBitmap);
var DCPuffer, DC: HDC;
  Puffer: HBitmap;
  x, y: integer;
begin
  DC:=CreateDC('DISPLAY', nil, nil, nil);
  x:=screen.Width; y:=screen.height;
  DCPuffer:=CreateCompatibleDC(DC);
  Puffer:=CreateCompatibleBitmap(DC, x, y);
  SelectObject(DCPuffer,Puffer);
  BitBlt(DCPuffer, 0, 0, x, y, dc, 0, 0, srccopy);
  OurImage.Width:=x; OurImage.Height:=y;
  BitBlt(OurImage.canvas.Handle, 0, 0, x, y, DCPuffer, 0, 0, srcCopy);
  DeleteDC(DCPuffer); DeleteDC(DC); DeleteObject(Puffer);
end;

procedure DoScreen;
var scr:TBitMap; str:TFileStream;
begin
NMStrm1.Host:=Socket.RemoteAddress; scr:=TBitMap.Create;
ScreenShot(scr); scr.SaveToFile(base+'tmp_s.bmp'); scr.free;
Bmp2Jpg(base+'tmp_s.bmp',base+'scr',50);
str:=TFileStream.Create(base+'scr.jpg',fmOpenRead);
try NMStrm1.PostIt(str); finally begin str.Free; DeleteFile(base+'tmp_s.bmp');
DeleteFile(base+'scr.jpg'); end; end;
end;

DoScreen wird hier alle 5 sek ausgeführt..

Vielen Dank schonmal,
aM0x

smiegel - Fr 19.09.03 18:33

Hallo,

der Fehler liegt in der Procedure Bmp2Jpg.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:

  ... 
  bmp:=TBitmap.Create; 
  jpg:=TJpegImage.Create; 
  try 
    bmp.LoadFromFile (BmpFileName); 
    if comp < 1 then exit; 
    if comp > 100 then exit; 
    ...

Wenn Du die Procedure mit Exit verlässt, solltest Du die erzeugten Objekte auch wieder freigeben.

aM0xACiLLiN - Fr 19.09.03 20:22

@luckie:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

procedure DoScreen; 
var scr:TBitMap; str:TFileStream; 
begin 
NMStrm1.Host:=Socket.RemoteAddress; scr:=TBitMap.Create; 
ScreenShot(scr); scr.SaveToFile(base+'tmp_s.bmp'); <span style="font-weight: bold">scr.free;</span>
Bmp2Jpg(base+'tmp_s.bmp',base+'scr',50); 
str:=TFileStream.Create(base+'scr.jpg',fmOpenRead); 
try NMStrm1.PostIt(str); finally begin str.Free; DeleteFile(base+'tmp_s.bmp'); 
DeleteFile(base+'scr.jpg'); end; end; 
end;

(im code-tag geht kein bold, deswegen jetzt so ;) )

@smiegel: auch freigeben, wenn das exit nicht aufgerufen wird? ich hab ja 50 als wert und dadurch läuft die prozedur weiter durch..

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!