Übertragung von Bildern zu langsam

[Yakumo500]

Hi,

Ich versuche ein Programm zu schreiben mit dem ich den Pc von meinem Bruder über das Netzwerk steurn kann, da er oft Probleme mit Windows hat.

Ich habe auch schon was geschrieben, wie ich seinen Desktop über TCP angezeigt bekomme.

Hier mein Server:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, JPEG, StdCtrls;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    ConsoleMemo: TMemo;
    Button1: TButton;
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
    procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ScreenShot(FileName: string): Boolean;
var
  fBitmap: TBitmap;
  DC: HDC;
  Rect: TRect;
  AImage: TJPEGImage;
  AHandle: THandle;
  CompressPercent: Byte;
begin
  AImage := TJPEGImage.Create;
  AHandle := GetDesktopWindow;
  CompressPercent := 100;
  Result := False;
  if AImage = nil then Exit;
  DC := GetDC(AHandle);
  if DC <> 0 then
  try
    fBitmap := TBitmap.Create;
    try
      if not GetClientRect(AHandle, Rect) then Exit;
      fBitmap.Width := Rect.Right - Rect.Left;
      fBitmap.Height := Rect.Bottom - Rect.Top;
      fBitmap.PixelFormat := pf32bit;
      Result := BitBlt(fBitmap.Canvas.Handle, 0, 0, fBitmap.Width,
        fBitmap.Height, DC, 0, 0, SRCCOPY);
      if not Result then Exit;
      AImage.Assign(fBitmap);
      AImage.CompressionQuality := CompressPercent;
    finally
      fBitmap.Free;
    end;
  finally
    ReleaseDC(AHandle, DC);
  end;
  If FileExists(FileName) Then DeleteFile(FileName);
  AImage.SaveToFile(FileName);
  AImage.Destroy;
end;

function GetFileSize(const FileName: string): Int64; 
var 
  FileStream: TFileStream; 
begin 
  FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); 
  try 
    try 
      Result := FileStream.Size; 
    except 
      Result := 0; 
    end; 
  finally 
    FileStream.Free; 
  end; 
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  Path: String; 
  fStream: TFileStream; 
  tBM: tBitmap; 
begin 
  Try
    If Copy(UpperCase(AThread.Connection.ReadLn), 1, 3) = 'SRN' then 
      begin
        ConsoleMemo.Lines.Add('~> Sending picture ...');
        ScreenShot('C:\test.jpg');
        Path := 'C:\test.jpg';
        AThread.Connection.WriteLn('SIZE:' + inttostr(GetFileSize('C:\test.jpg')));
        fStream := TFileStream.Create(Path, fmOpenRead + fmShareDenyNone);
        AThread.Connection.OpenWriteBuffer;
        AThread.Connection.WriteStream(fStream);
        AThread.Connection.CloseWriteBuffer;
        FreeAndNil(fStream);
        ConsoleMemo.Lines.Add('~> Picture sended.');
        //AThread.Connection.Disconnect;
      end; 
  Except 
    on E : Exception do 
      ShowMessage(E.Message); 
  end;
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
  ConsoleMemo.Lines.Add('+> New connection ...');
end;

procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin
  ConsoleMemo.Lines.Add('-> Connection lost!');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  IdTCPServer1.Active := TRue;  
end;

end.

Und der Client

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, ExtCtrls, JPEG, StrUtils, GR32_Image;

type
  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    Button1: TButton;
    Image1: TImage;
    Timer1: TTimer;
    Image321: TImage32;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  F_Ready: boolean = True;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var  ftmpStream: TFileStream;
  Path: String;
begin
  Timer1.Enabled := True;
  {Try
    With IdTCPClient1 do
      begin
        F_Ready := False;
        IdTCPClient1.Connect();
        WriteLn('SRN'); 
        Path := 'C:\test1.jpg';
        If FileExists(Path) then DeleteFile(Path);
        ftmpStream := TFileStream.Create(Path, fmCreate);
        While connected do 
          ReadStream(fTmpStream, -1, True);
        FreeAndNil(fTmpStream);
        Image1.Picture.LoadFromFile(Path);
        F_Ready := True;
      end;
  Except
  end; }
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Form1.Left := 0;
  Form1.Top := 0;
  IdTCPClient1.Connect();
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  IdTCPClient1.Disconnect;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var  ftmpStream: TFileStream;
  Path: String;
  SizeStr: String;
begin
  If F_Ready Then
  Begin
    Try
    With IdTCPClient1 do
      begin
        F_Ready := False;
        WriteLn('SRN');
        Path := 'C:\test1.jpg';
        If FileExists(Path) then DeleteFile(Path);
        ftmpStream := TFileStream.Create(Path, fmCreate);

        //Größe des Streams ermitteln
        SizeStr := ReadLn();
        While SizeStr = '' do
        begin
          SizeStr := ReadLn();
          Application.ProcessMessages;
        end;
        If LeftStr(SizeStr, 5) <> 'SIZE:' Then
        Begin
          FreeAndNil(fTmpStream);
          Exit;
        End;
        SizeStr := RightStr(SizeStr, Length(SizeStr) - 5);

        ReadStream(fTmpStream, strtoint(SizeStr), False);
        {While Connected do
        begin
          ReadStream(fTmpStream, -1, False);
          Application.ProcessMessages;
        end;}
        
        FreeAndNil(fTmpStream);
        Image321.Bitmap.LoadFromFile(Path);
        //Image1.Picture.LoadFromFile(Path);
        F_Ready := True;
      end;
      Except
    end;
  End;
end;

end.

Mein Problem ist, dass das einfach zu langsam ist.
Gibt es eine Möglichkeit das schneller zu machen?

[hazard999]

VNC verwenden?

[Yakumo500]

Danke die Komponente hab ich bereits gefunden.

Aber gibt es auch ein Tutorial?

[_frank_]

ich glaube hazard999 meinte nicht die Komponenten sondern eins der vorhanden Programme (RealVNC,UltraVNC,TinyVnc,...)

Gruß Frank

[alleinherrscher]

Wenn du es selber programmieren willst, hier ein paar tipps:

1. mache ein screenshot
2. komprimiere ihn und schicke ihn an den remote computer
3. mache kurze zeit später wieder einen screenshot, vergleiche mit dem ersten screenshot auf unterschiede
4. speichere nur die unterschiede, komprimiere wieder und schick an den remote computer


so macht es mein Programm Lan.Fs

achja und farbtiefe reduzieren bringt auch einiges ;-) Bin ich grade selber dran, für die nächste version :)


Stichwort dazu ist BitBlt,

Grüße, Michael