[TCP] Bilderstreaming

[Chrissi91]

Alsoooo ......,

den ganzen Tag sitze ich hier schon dran, habe alle Threads in denen TCP Webcam/Bilder/Dateien drinvorkommen mindestens 3x gelesen und trotzdem verzweifel ich.

Vorweg erstmal. Ich wollte anfangs das Webcam-Streamgin mit IdVCLSteam machen, doch das kannte mein D7 PE mit Indy 10 nicht. Also hab ich ein bisschen improvisiert und ich glaube da fehlt mir einiges bei den Streamingbefehlen, da Delphi auch kein OpenWriteBuffer oder so ähnlich kannte.

Hier mal mein Codesalat. :D

Delphi-Quellcode:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, IdIPWatch,
  IdTCPClient, IdTCPServer, Dialogs, ShellAPI, StdCtrls, ExtCtrls, Clipbrd, Math,
  IdComponent, Forms, JPEG, IdTCPConnection, IdCustomTCPServer, IdBaseComponent,
  IdContext;

type
  TfrmMain = class(TForm)
    TCPClient: TIdTCPClient;
    Timer1: TTimer;
    Timer2: TTimer;
    Panel1: TPanel;
    TCPServer: TIdTCPServer;
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure TCPServerExecute(AContext: TIdContext);
  private
    Handle: THandle;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  Status, Diff: Boolean;
  NEW_BMP, OLD_BMP, BUFFER_BMP: TBitmap;
  JPG: TJpegImage;
  
const 
  WM_CAP_DRIVER_CONNECT = WM_USER + 10; 
  WM_CAP_EDIT_COPY = WM_USER + 30; 
  WM_CAP_SET_PREVIEW = WM_USER + 50; 
  WM_CAP_SET_OVERLAY = WM_USER + 51; 
  WM_CAP_SET_PREVIEWRATE = WM_USER + 52;

implementation

{$R *.dfm}

//Berechnen der Farbunterschiede für eine bessere Bildrate
procedure GetDifference(ZielDC,DC1,DC2:HDC;DCwidth:integer;DCheight:integer);
begin
  BitBlt(ZielDC, 0, 0, DCWidth, DCHeight, DC2, 0, 0, SRCCOPY);
  bitblt(ZielDC, 0, 0, DCWidth, DCHeight, DC1, 0, 0, SRCINVERT);
end;

//Notwendige Funktion zum Zugriff auf die Webcam
function capCreateCaptureWindow(lpszWindowName: LPCSTR; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; hwndParent: HWND; nID: Integer): HWND; stdcall;
  external 'AVICAP32.DLL' name 'capCreateCaptureWindowA'; 

//Sucht solange den Server bis er ihn gefunden hat
//Soll später außerhalb des Netzwerkes laufen.
//Abfangen von Fehlermeldungen, wenn der Server
//nicht on ist; Reconnecten bis zum Erfolg
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  If Status = False then
    begin
      TCPClient.Host:= '127.0.0.1';
      Try
        TCPClient.Connect;
      Except
      end;
      Try
        If TCPClient.IOHandler.ReadLn = 'Connecting to Client ...' then Status := True;
      Except
        Status := False;
      end;
    end;
  //Abschalten -und Anschalten der Webcamanzeige
  //und des Streames wenn (keine) Verbindung steht.
  If (Status = True ) and (Timer2.Enabled = False) then Timer2.Enabled := True;
  If (Status = False) and (Timer2.Enabled = True ) then Timer2.Enabled := False;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  //Initialisierung
  Status := False;
  Diff := False;
  NEW_BMP := TBitmap.Create;
  OLD_BMP := TBitmap.Create;
  BUFFER_BMP := TBitmap.Create;
  JPG := TJPEGImage.Create;
  JPG.CompressionQuality := 100;
  //Webcam anzeigen
  Handle := capCreateCaptureWindow('Video', ws_child + ws_visible, 0, 0, 640, 480, Panel1.Handle, 1);
  SendMessage(Handle, WM_CAP_DRIVER_CONNECT,   0, 0);
  SendMessage(Handle, WM_CAP_SET_PREVIEWRATE, 15, 0);
  SendMessage(Handle, WM_CAP_SET_OVERLAY,      1, 0);
  SendMessage(Handle, WM_CAP_SET_PREVIEW,      1, 0);
end;

procedure TfrmMain.Timer2Timer(Sender: TObject);
var
  Datei: textFile;
  S: TMemoryStream;
begin
  //Kopieren des Webcam-Bildes
  SendMessage(Handle, WM_CAP_EDIT_COPY, 1, 0);
  //Wenn es das 1. Bild ist, kann kein Unterschied berechnet werden ...
  If Diff = False then
    begin
      NEW_BMP.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap), 0);
      JPG.Assign(NEW_BMP);
      Diff := True;
    end
  //Wenn es aber schon mind. das 2 ist, kann der Unterschied berechnet werden.
  Else
    begin
      OLD_BMP.Assign(NEW_BMP);
      NEW_BMP.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap), 0);
      BUFFER_BMP.Width := Min(OLD_BMP.Width, NEW_BMP.Width);
      BUFFER_BMP.Height := Min(OLD_BMP.height, NEW_BMP.height);
      GetDifference(BUFFER_BMP.Canvas.Handle, OLD_BMP.Canvas.Handle, NEW_BMP.Canvas.Handle, BUFFER_BMP.Width, BUFFER_BMP.Height);
      JPG.CompressionQuality := 100;
      JPG.Assign(BUFFER_BMP);
    end;
  //Versuche Stream-Verschicken
  Try
    S := TMemoryStream.Create;
    TCPClient.IOHandler.Write(S);
    FreeAndNil(S);
  Except
    ShowMessage('Fehler: Stream konnte nicht verschickt werden.');
  end;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //Freigeben
  OLD_BMP.Free;
  NEW_BMP.Free;
  BUFFER_BMP.Free;
  JPG.Free;
end;

procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
  connected: boolean;
  S: TMemoryStream;
begin
  //"Willkommensmeldung" zur Kontrolle, ob Verbindung zum Clienten steht
  AContext.Connection.IOHandler.WriteLn('Connecting to Client ...');
  connected := true;
  S := TMemoryStream.Create;
  while connected do begin
    try
      //Versuche Stream zu empfangen
      AContext.Connection.IOHandler.ReadStream(S);
      JPG := TJPEGImage.Create;
      JPG.LoadFromStream(S);
      Windows.Beep(1000,2000);
      JPG.SaveToFile('temp.jpg');
      JPG.Free;
    except
      ShowMessage('Fehler: Stream konnte nicht verschickt werden.');
    end;
  end;
  FreeAndNil(S);
end;

end.

Ich hoffe mal ich habe das gut genug auskommentiert um da durchzublicken. Da das eine meiner ersten Anwendungen mit TCP & Co ist, habe ich das in euren Augen wahrscheinlich viel zu umständlich gelöst, z.B. die Connecting-Versuche im Timer1, solange bis es geklappt hat. :D

Ich bin mir ganz sicher, dass das Problem beim Streamen liegt, weil er da gar nichts macht. Hoffe ihr könnt mir ein bisschen Licht ins Dunkeln bringen, welche Befehle falsch sind / fehlen.

Mist! Ich wusste doch, ich hatte noch etwas vergessen. :D Und zwar habe ich der Einfachheit halber den clienten und den Server in eine EXE gepackt. Dürfte dem PC / Delphi eigentlich egal sein.

TCPServer habe ich bereits im OI auf Active = True gestellt.

[Chrissi91]

Huch? Noch keine Antwort? Habe ich mich zu unverständlich ausgedrückt? :lol:

[marabu]

Moin Christopher,

du hast dir zwar durchaus Mühe gegeben, aber von einer guten Problembeschreibung bist du doch noch meilenweit entfernt.

Welcher Code ist schon getestet und funktioniert zuverlässig? Treten Fehler auf? An welcher Stelle verhält sich dein Code anders als du es erwartest?

Delphi-Quellcode:

// ...
  //Versuche Stream-Verschicken
  Try
    S := TMemoryStream.Create;
    TCPClient.IOHandler.Write(S);
    FreeAndNil(S);
  Except
    ShowMessage('Fehler: Stream konnte nicht verschickt werden.');
  end; 
// ...

Warum willst du hier einen leeren Stream verschicken?

Variablen, die nicht unbedingt benötigt werden, solltest du garnicht erst deklarieren. Werden sie benötigt, dann deklariere sie lokal zur Methode, in der sie benötigt werden. Greifen mehrere Methoden auf die Variablen zu, so deklariere sie im private-Abschnit der Form. Sie sind dann automatisch initialisiert. Deaktiviere Timer für die Daier der Ereignisbehandlung, wenn du sicher sein willst, dass kein Mehrfacheintritt vorkommt.

Grüße vom marabu

[Chrissi91]

Ups. :lol:

Der Fehler ist mir gar nicht aufgefallen. Dann versuche ich es jetzt noch ein bisschen deutlicher zu beschreiben:

Ich verschicke den Stream:

Delphi-Quellcode:

Try
    S := TMemoryStream.Create;
    JPG.SaveToStream(S);
    TCPClient.IOHandler.Write(S);
    FreeAndNil(S);
  Except
    ShowMessage('Fehler: SendStream');
  end;

Keine Fehlermeldung und JPG enthält ein richtiges Bild.

Ich empfange den Stream:

Delphi-Quellcode:

  //"Willkommensmeldung" zur Kontrolle, ob Verbindung zum Clienten steht
  AContext.Connection.IOHandler.WriteLn('Connecting to Client ...');
  connected := true;
  S := TMemoryStream.Create;
  while connected do begin
    try
      //Versuche Stream zu empfangen
      AContext.Connection.IOHandler.ReadStream(S);
      JPG := TJPEGImage.Create;
      JPG.LoadFromStream(S);
      Windows.Beep(1000,2000);
      JPG.SaveToFile('temp.jpg');
      JPG.Free;
    except
      ShowMessage('Fehler: GetStream');
    end;
  end;
  FreeAndNil(S);

Zwar ist der DualCore bei 100 % Auslastung, aber passieren tut nichts. Weder ein Windows-Signalton, noch eine Fehlermeldung.

Ich würde ja gerne mal mit Breakpoint testen, doch beim Compilieren kommt gleich:

Zitat:

---------------------------
Debugger Exception Notification
---------------------------
Project Project1.exe raised exception class EIdSocketError with message 'Socket Error # 10061
Connection refused.'. Process stopped. Use Step or Run to continue.
---------------------------
OK Help
---------------------------

Er sagt dann noch, dass er eine IdStackBSDBlaBlaBla nicht finden konnte.

Aber diese Fehlermeldung hab ich eigentlich immer bei den Indys, aber nicht, wenn ich die kompilierte EXE aufrufe, da meckert er dann komischerweise nicht.

Imho hat die Fehlermeldung nichts damit zu tun. Mache ich ein neues Projekt mit TCPClient aus der neuesten Indysammlung auf die Form, schreibe ins FormCreate TCPClient.Host := '127.0.0.1';, kommt beim Kompilieren der selbe Fehler, aber nicht später in der EXE.

[marabu]

Bevor du den Inhalt eines Stream versenden kannst, musst du in der Regel die Position auf 0 setzen.

Zuerst aber solltest du testen, ob und unter welchen Umständen deine Testumgebung (Client und Server im selben Lademodul) überhaupt funktionieren kann. Hat der Server überhaupt die Gelegenheit Pakete anzunehmen, während der Client 128KByte Bilddaten rausschickt, der TCP-Buffer aber nur 16KByte (alles nur Beispielangaben) groß ist?

[Net7]

Hi,

probiere es mal so:

Beispiel

Senden:

Delphi-Quellcode:

 // ...
  FStream := TMemoryStream.Create;
  try
    FBitmap.SaveToStream(FStream);
    Buf := FStream.Memory;
    with ServerSocket1.Socket do
      begin
        for i := 0 to ActiveConnections - 1 do
          begin
            Connections[i].SendText('Daten'
              + IntToStr(FStream.Size));
            Sleep(50);
            Connections[i].SendBuf(Buf^, FStream.Size);
          end; {for i := 0 to ActiveConnections do}
      end; {with ServerSocket1.Socket do}
  finally
    FStream.Free;
  end;

Dabei wird zunächst mit SendText ein Header geschrieben, anschließend wird mit SendBuf das Bild übertragen. Die Anweisung Sleep verhindert, dass der Text und der Anfang der Daten zu einem Paket zusammengefasst werden – dann hätte der Client nämlich Probleme, sie wieder auseinander zu bekommen.


Empfang:

Delphi-Quellcode:

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
  a: array array[0..4096] of Byte;
  i: integer;
  s: string string;
begin
  if FDaten = false then
    begin
      s := Socket.ReceiveText;
      if Copy(s, 1, 5) = 'Daten' then
        begin
          Delete(s, 1, 5);
          try
            FSize := StrToInt(s);
            FDaten := true;
            Image1.Picture.Bitmap := nil nil;
            FStream.Clear;
          except
          end;
        end; {if Copy(s, 1, 5) = 'Daten' then}
    end {if FDaten = false then}

  else
    begin
      i := Socket.ReceiveBuf(a, 4096);
      FStream.Write(a, i);
      FPos := FPos + i;
      if FPos >= FSize then
        begin
          FDaten := false;
          FStream.Position := 0;
          FPos := 0;
          Image1.Picture.Bitmap.LoadFromStream(FStream);
        end;
    end; {else FDaten = false then}

Alle eintreffenden Daten werden nach FStream geschrieben. Sobald FPos gleich FSize ist, sind alle Daten eingetroffen. FDaten wird wieder auf false gesetzt und das
Bitmap aus dem Stream nach Image1 geladen.


Mfg Net7