Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi Indy: Bilder übers Web versenden mit IdTCPServer + IdTCPClie (https://www.delphipraxis.net/58391-indy-bilder-uebers-web-versenden-mit-idtcpserver-idtcpclie.html)

hincapie 6. Dez 2005 13:56


Indy: Bilder übers Web versenden mit IdTCPServer + IdTCPClie
 
Hallo,
ich möchte meinen Indy-Chat (basierend auf dem entsprechenden Demo) erweitern, um Bilder einer Webcam an die Clients schicken zu können.
Die Einzelbilder der Cam werden als Bitmaps (capture0.bmp, capture1.bmp usw.)gespeichert und vom TCPServer zur Verfügung gestellt:
Delphi-Quellcode:
procedure TfrmMain.tcpServer1Execute(AThread: TIdPeerThread);
var
    s, sCommand, sAction : string;
    fStream : TFileStream;
begin
  CS.Enter;
  try
    s := uppercase(AThread.Connection.ReadLn);
    sCommand := copy(s,1,3);
    sAction := copy(s,5,100);
    if sCommand = 'PIC' then
    begin
      if FileExists(ProgDir + 'images\' + sAction) then
      Begin
        // open file stream to image requested
        fStream := TFileStream.Create(ProgDir + 'images\' +
         sAction,fmOpenRead   + fmShareDenyNone);
        // copy file stream to write stream
        AThread.Connection.OpenWriteBuffer;
        AThread.Connection.WriteStream(fStream);
        AThread.Connection.CloseWriteBuffer;
        // free the file stream
        FreeAndNil(fStream);
      End
      else
        AThread.Connection.WriteLn('ERR - Requested file
         does not exist');
      AThread.Connection.Disconnect;
    End
    else ...
    end;
  except
  on E : Exception do
    ShowMessage(E.Message);
  End;
  CS.Leave;
end;
Der Client fordert dann die einzelnen Bilder an und lädt sie per Timer in ein TImage (VideoOut):
Delphi-Quellcode:
procedure TForm1.ToolButton42Click(Sender: TObject);
begin
  try
    if ToolButton42.Down then
    begin
      ToolButton42.ImageIndex := 20;
      ToolButton42.Hint      := 'Shut down video-cam';
      with IdTCPClient2 do
      begin
        if connected then DisConnect;
        Host := edServer.text;
        Port := sePort.Value +1;
        Connect;
      end;
      Timer2.Enabled := True;
    end
    else
    begin
      ToolButton42.ImageIndex := 20;
      ToolButton42.Hint      := 'Start up video-cam';
      Timer2.Enabled := False;
      IdTCPClient2.Disconnect;
    end;
  except
  { If we have a problem then rest things }
    ToolButton42.Down := false;
  end;
  //Timer2.Enabled := false;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
  Filename: string;
  ftmpStream : TFileStream;
begin
  try
    if FileCounter < 1000 then
    begin
      FileName := 'Capture' + IntToStr(FileCounter) + '.bmp';
      inc(FileCounter);
      IdTCPClient2.WriteLn('PIC:' + Filename);
      ftmpStream := TFileStream.Create(ProgDir + 'images\'
       + Filename,fmCreate);
      while IdTCPClient2.connected do
        IdTCPClient2.ReadStream(fTmpStream,-1,true);
      Application.ProcessMessages;
      FreeAndNil(fTmpStream);
      VideoOut.Picture.LoadFromFile(ProgDir + 'images\' + Filename);
    end;
  except
    on E : Exception do
      ShowMessage(E.Message);
  end;
end;
Doch leider wird nur immer das erste Bitmap übertragen, danach bricht die Übermittlung ab.
Ich habe in einem anderen Forum mal etwas von asynchronen Netzwerkverbindungen gelesen, kenne mich da aber überhaupt nicht aus, vielleicht liegt ja da der Fehler?

Zacherl 6. Dez 2005 18:35

Re: Indy: Bilder übers Web versenden mit IdTCPServer + IdTCP
 
Wird ein Fehler angezeigt?

hincapie 6. Dez 2005 19:48

Re: Indy: Bilder übers Web versenden mit IdTCPServer + IdTCP
 
Zitat:

Zitat von Florian Bernd
Wird ein Fehler angezeigt?

Ja, der ist aber unterschiedlich:
sobald ich den Schalter im Client betätige, wird das erste Bild übertragen und dann kommen hintereinander MessageBoxes "Connection closed gracefullly".
Hat wohl denke ich irgendwie mit dem Timer zu tun, der ja wiederholt versucht, die Bilder beim Server abzuholen.
Wenn ich den Schalter noch einmal betätige, wird wohl ein weiteres Bitmap übertragen, da kommt aber dann die Meldung "Bitmap ist ungültig" und in dem Bitmap befindet sich kein Bild!

hincapie 7. Dez 2005 06:36

Re: Indy: Bilder übers Web versenden mit IdTCPServer + IdTCP
 
So, ich habe inzwischen eine vorläufige Lösung für mein Problem gefunden: :mrgreen:
Der Einfachheit halber lasse ich die Bilder der Webcam nur in einem Bitmap speichern und verschicke dieses über das Netz.
Nach einigem Ausprobieren habe ich die komplette Routine (d.h. Client connect->Stream create->Stream read->Stream freeandnil->Client disconnect) vom Timer abarbeiten lassen.

Delphi-Quellcode:
procedure TForm1.Timer2Timer(Sender: TObject);
var
  Filename: string;
  ftmpStream : TFileStream;
begin
  try
    FileName := 'capture.bmp';
    with IdTCPClient2 do
    begin
      if connected then DisConnect;
      Host := edServer.text;
      Port := sePort.Value +1;
      Connect;
    end;
    IdTCPClient2.WriteLn('PIC');
    ftmpStream := TFileStream.Create(ProgDir +  'images\capture.bmp',fmCreate);
    //while IdTCPClient2.connected do
      IdTCPClient2.ReadStream(fTmpStream,-1,true);
    Application.ProcessMessages;
    FreeAndNil(fTmpStream);
    VideoOut.Picture.LoadFromFile(ProgDir + 'images\capture.bmp');
    ShowMessage('Bild geladen!');
    IdTCPClient2.Disconnect;
  except
    on E : Exception do
    ShowMessage(E.Message);
  end;
end;
Der Schalter zum Abrufen des Bildes aktiviert dann nur noch den Timer.

So scheint es zu funktionieren, es wird keine Fehlermeldung mehr angezeigt und die Meldung 'Bild geladen' erscheint regelmäßig.

Jetzt muss ich mich nur(!) noch um die Komprimierung des Bitmaps kümmern und das Ganze dann mal übers Internet testen. :gruebel: :wink:

hincapie 16. Jan 2006 20:31

Re: Indy: Bilder übers Web versenden mit IdTCPServer + IdTCP
 
Tja, doch ein bißchen zu früh gefreut.
Ich habe die Timer-Funktion nun auf jpg-Dateien umgestellt. Funktioniert auch anfangs prima, die Bilder werden auch im Client angezeigt.
Delphi-Quellcode:
procedure TForm1.Timer2Timer(Sender: TObject);
var
  Filename: string;
  ftmpStream : TFileStream;
begin
  try
    FileName := 'capture.jpg';
    with IdTCPClient2 do
    begin
      if connected then DisConnect;
      Host := edServer.text;
      Port := sePort.Value +1;
      Connect;
    end;
    IdTCPClient2.WriteLn('PIC');
    ftmpStream := TFileStream.Create(ProgDir + 'images\capture.jpg',fmCreate);
    //while IdTCPClient2.connected do
      IdTCPClient2.ReadStream(fTmpStream,-1,true);
    Application.ProcessMessages;
    FreeAndNil(fTmpStream);
    VideoOut.Picture.LoadFromFile(ProgDir + 'images\capture.jpg');
    //ShowMessage('Bild geladen!');
    IdTCPClient2.Disconnect;
  except
    on E : Exception do
    ShowMessage(E.Message);
  end;
end;
Doch nach einiger Zeit kommt dann die Fehlermeldung, dass die Datei 'capture.jpg' nicht erstellt werden
kann. Das Bild "friert" förmlich ein, da offensichtlich nichts mehr geladen wird.


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:45 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz