Subversion Repositories alarming

Rev

Blame | Last modification | View Log | RSS feed

  1. {
  2. MJPEG Decoder Class
  3. Copyright 2006, Steve Blinch
  4. http://code.blitzaffe.com
  5.  
  6. This script is free software; you can redistribute it and/or modify it under the
  7. terms of the GNU General Public License as published by the Free Software
  8. Foundation; either version 2 of the License, or (at your option) any later
  9. version.
  10.  
  11. This script is distributed in the hope that it will be useful, but WITHOUT ANY
  12. WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  13. FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  14. details.
  15.  
  16. You should have received a copy of the GNU General Public License along
  17. with this script; if not, write to the Free Software Foundation, Inc.,
  18. 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19. }
  20.  
  21. unit MJPEGDecoderUnit;
  22.  
  23. {$M+} // Added VTS 06.05.2019 to supress compiler warning
  24.  
  25. interface
  26.  
  27. uses Classes, ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, MJPEGDecoderThread, Messages, JPEG;
  28.  
  29. type
  30.   TMJPEGFrameEvent = procedure(Sender: TObject; Frame: TJPEGImage) of object;
  31.   TMJPEGMessageEvent = procedure(Sender: TObject; Msg: String) of object;
  32.  
  33.   TMJPEGDecoder = class(TObject)
  34.     private
  35.       FOnFrame: TMJPEGFrameEvent;
  36.       FOnError: TMJPEGMessageEvent;
  37.       FOnMessage: TMJPEGMessageEvent;
  38.       FOnConnected: TNotifyEvent;
  39.       FOnDisconnected: TNotifyEvent;
  40.  
  41.       FConnected: Boolean;
  42.  
  43.       FOwner: TComponent;
  44.  
  45.       ClientURI: String;
  46.       Client: TIdTCPClient;
  47.  
  48.       FHeaders: TStringList;
  49.  
  50.       FWindowHandle: THandle;
  51.  
  52.       Thread: TMJPEGDecoderThread;
  53.       ThreadActive: Boolean;
  54.  
  55.       procedure HandleConnected(Sender: TObject);
  56.       procedure HandleThreadTerminate(Sender: TObject);
  57.  
  58.       function IsMixedReplace(CType: String): Boolean;
  59.       procedure InternalWinProc(var Msg: TMessage);
  60.  
  61.       procedure Error(Msg: String);
  62.       procedure Info(Msg: String);
  63.  
  64.     public
  65.       constructor Create(AOwner: TComponent);
  66.       destructor Destroy; override;
  67.  
  68.       // connect to Hostname on port Port, and fetch the MJPEG stream from URI
  69.       procedure Connect(Hostname: String; Port: Integer; URI: String);
  70.  
  71.       // disconnect (if connected)
  72.       procedure Disconnect;
  73.     published
  74.       // called when a frame is received; you MUST dispose of the frame yourself!
  75.       property OnFrame: TMJPEGFrameEvent read FOnFrame write FOnFrame;
  76.  
  77.       // called when an error occurs
  78.       property OnError: TMJPEGMessageEvent read FOnError write FOnError;
  79.  
  80.       // called when a debug message is generated
  81.       property OnMessage: TMJPEGMessageEvent read FOnMessage write FOnMessage;
  82.  
  83.       // called when MJPEGDecoder connects to an MJPEG source
  84.       property OnConnected: TNotifyEvent read FOnConnected write FOnConnected;
  85.  
  86.       // called when MJPEGDecoder disconnects
  87.       property OnDisconnected: TNotifyEvent read FOnDisconnected write FOnDisconnected;
  88.  
  89.       // contains the headers received from the HTTP server
  90.       property Headers: TStringList read FHeaders;
  91.  
  92.       // returns TRUE if connected, otherwise FALSE
  93.       property Connected: Boolean read FConnected;
  94.     end;
  95.  
  96. implementation
  97.  
  98. uses SysUtils;
  99.  
  100. procedure TMJPEGDecoder.InternalWinProc(var Msg: TMessage);
  101. var
  102.   JPEGImage: TJPEGImage;
  103.   JPEGStream: TMemoryStream;
  104. begin
  105.   if (Msg.Msg = WM_USER) then
  106.     begin
  107.       case Msg.WParam of
  108.           MSG_MJPEG_ERROR:
  109.             begin
  110.               Error('Decoder thread error: '+IntToStr(Msg.LParam));
  111.               try
  112.                 Client.Disconnect;
  113.               except;
  114.               end;
  115.               FConnected:=False;
  116.             end;
  117.           MSG_MJPEG_MESSAGE:
  118.             begin
  119.               with TMJPEGDecoderMsg(Msg.LParam) do
  120.                 begin
  121.                   Info(msg);
  122.                   Free;
  123.                 end;
  124.             end;
  125.           MSG_MJPEG_FRAME:
  126.             begin
  127.               JPEGStream:=TMemoryStream(Msg.LParam);
  128.               JPEGStream.Position:=0;
  129.  
  130.               if Assigned(FOnFrame) then
  131.                 begin
  132.                   JPEGImage:=TJPEGImage.Create;
  133.                   JPEGImage.LoadFromStream(JPEGStream);
  134.  
  135.                   FOnFrame(Self,JPEGImage);
  136.                 end;
  137.  
  138.               JPEGStream.Free;
  139.             end;
  140.         end;
  141.     end;
  142. end;
  143.  
  144.  
  145. constructor TMJPEGDecoder.Create(AOwner: TComponent);
  146. begin
  147.   inherited Create;
  148.  
  149.   FOwner:=AOwner;
  150.  
  151.   FOnFrame:=nil;
  152.   FOnConnected:=nil;
  153.   FOnDisconnected:=nil;
  154.  
  155.   Thread:=nil;
  156.   ThreadActive:=False;
  157.  
  158.   FWindowHandle := AllocateHWnd(InternalWinProc);
  159.  
  160.   FHeaders:=TStringList.Create;
  161.   FHeaders.NameValueSeparator:=':';
  162.   Client:=TIdTCPClient.Create(FOwner);
  163. end;
  164.  
  165. destructor TMJPEGDecoder.Destroy;
  166. begin
  167.   if Assigned(Thread) and ThreadActive then Thread.Terminate;
  168.  
  169.   FHeaders.Free;
  170.   Client.Free;
  171.   inherited;
  172. end;
  173.  
  174. procedure TMJPEGDecoder.HandleThreadTerminate(Sender: TObject);
  175. begin
  176.   ThreadActive:=False;
  177. end;
  178.  
  179.  
  180. procedure TMJPEGDecoder.Connect(Hostname: String; Port: Integer; URI: String);
  181. begin
  182.   if FConnected then exit;
  183.  
  184.   Client.Host:=Hostname;
  185.   Client.Port:=Port;
  186.   ClientURI:=URI;
  187.   FHeaders.Clear;
  188.  
  189.   Client.OnConnected:=HandleConnected;
  190.   try
  191.     Client.Connect; // (10);
  192.   except
  193.     if not Client.Connected then Error('Could not connect to server');
  194.   end;
  195.  
  196. end;
  197.  
  198. procedure TMJPEGDecoder.Disconnect;
  199. begin
  200.   if not FConnected then exit;
  201.  
  202.   Thread.Terminate;
  203.   Client.Disconnect;
  204.   if (FConnected) and Assigned(FOnDisconnected) then FOnDisconnected(Self);
  205.   FConnected:=False;
  206. end;
  207.  
  208. procedure TMJPEGDecoder.HandleConnected(Sender: TObject);
  209. var
  210.   S: String;
  211.   CType: String;
  212.  
  213. begin
  214.   Info('Connected, sending request');
  215.   Client.IOHandler.WriteLn('GET '+ClientURI+' HTTP/1.1');
  216.   Client.IOHandler.WriteLn;
  217.   while (true) do
  218.     begin
  219.       S:=Client.IOHandler.ReadLn();
  220.       if (S='') then break;
  221.  
  222.       FHeaders.Add(S)
  223.     end;
  224.   CType:=FHeaders.Values['Content-Type'];
  225.   if (not IsMixedReplace(CType)) then
  226.     begin
  227.       Error('Invalid content type received from server: '+CType);
  228.       Error(FHeaders.Text);
  229.       Disconnect;
  230.       exit;
  231.     end;
  232.  
  233.   Info('Request sent, spawning decoder thread');
  234.   Thread:=TMJPEGDecoderThread.Create(Client,FWindowHandle);
  235.   Thread.OnTerminate:=HandleThreadTerminate;
  236.   ThreadActive:=True;
  237.   Thread.Resume;
  238.   FConnected:=True;
  239. end;
  240.  
  241. function TMJPEGDecoder.IsMixedReplace(CType: String): Boolean;
  242. var p: Integer;
  243. begin
  244.   CType:=Trim(Ctype);
  245.   p:=Pos(';',CType);
  246.   if (p>0) then SetLength(CType,p-1);
  247.  
  248.   Result:=(CType='multipart/x-mixed-replace');
  249. end;
  250.  
  251. procedure TMJPEGDecoder.Error(Msg: String);
  252. begin
  253.   if Assigned(FOnError) then FOnError(Self,Msg);
  254. end;
  255.  
  256. procedure TMJPEGDecoder.Info(Msg: String);
  257. begin
  258.   if Assigned(FOnMessage) then FOnMessage(Self,Msg);
  259. end;
  260.  
  261. end.
  262.  
  263.