Entwickler-Ecke :: Thema anzeigen - Indy: Bilder über das Web senden mit TIdTCPServer und TIdTCP

chrisdrury - Di 06.12.05 15:53
Titel: Indy: Bilder über das Web senden mit TIdTCPServer und TIdTCP

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-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:

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-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:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:

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 hier im Forum mal etwas von asynchronen Netzwerkverbindungen gelesen, vielleicht liegt ja da der Fehler?

chrisdrury - Mi 07.12.05 08:43

So, ich habe inzwischen eine vorläufige Lösung für mein Problem gefunden: :dance2:
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-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:

  
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.
:wink: :gruebel:

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!