alarming
autosfx
aysalia
calllib
checksum-tools
colormanager
cryptochat
currency_converter
decoder
delphiutils
distributed
dpcstudio
dpg2
fastphp
fileformats
filter_foundry
forest
gridgame
ht46f47_simulator
indexer_suite
ipe_artfile_utils
javautils
jumper
lightgame
logviewer
musikbox
mystic_house
oidconverter
oidinfo_api
oidinfo_new_design
oidplus
personal-webbase
php_antispam
php_clientchallenge
php_guestbook
php_utils
plumbers
prepend
recyclebinunit
simple_log_event
sokoban
spacemission
stackman
userdetect2
uuid_mac_utils
vgwhois
vnag
webcounter
winbugtracker
yt_downloader
BlueGrey
calm
Elegant
Català-Valencià – Catalan
中文 – Chinese (Simplified)
中文 – Chinese (Traditional)
Česky – Czech
Dansk – Danish
Nederlands – Dutch
English – English
Suomi – Finnish
Français – French
Deutsch – German
עברית – Hebrew
हिंदी – Hindi
Magyar – Hungarian
Bahasa Indonesia – Indonesian
Italiano – Italian
日本語 – Japanese
한국어 – Korean
Македонски – Macedonian
मराठी – Marathi
Norsk – Norwegian
Polski – Polish
Português – Portuguese
Português – Portuguese (Brazil)
Русский – Russian
Slovenčina – Slovak
Slovenščina – Slovenian
Español – Spanish
Svenska – Swedish
Türkçe – Turkish
Українська – Ukrainian
Oëzbekcha – Uzbek
Subversion Repositories
alarming
alarming
/
trunk
/
Delphi Client
/
MJPEGDecoderUnit.pas
@ 7
– Rev 2
Rev
Blame
|
Last modification
|
View Log
|
RSS feed
{
MJPEG Decoder Class
Copyright 2006, Steve Blinch
http://code.blitzaffe.com
This script is free software; you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.
This script is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
details.
You should have received a copy of the GNU General Public License along
with this script; if not, write to the Free Software Foundation, Inc.,
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit
MJPEGDecoderUnit
;
{$M+}
// Added VTS 06.05.2019 to supress compiler warning
interface
uses
Classes
,
ExtCtrls
,
IdBaseComponent
,
IdComponent
,
IdTCPConnection
,
IdTCPClient
,
MJPEGDecoderThread
,
Messages
,
JPEG
;
type
TMJPEGFrameEvent
=
procedure
(
Sender
:
TObject
;
Frame
:
TJPEGImage
)
of
object
;
TMJPEGMessageEvent
=
procedure
(
Sender
:
TObject
;
Msg
:
String
)
of
object
;
TMJPEGDecoder
=
class
(
TObject
)
private
FOnFrame
:
TMJPEGFrameEvent
;
FOnError
:
TMJPEGMessageEvent
;
FOnMessage
:
TMJPEGMessageEvent
;
FOnConnected
:
TNotifyEvent
;
FOnDisconnected
:
TNotifyEvent
;
FConnected
:
Boolean
;
FOwner
:
TComponent
;
ClientURI
:
String
;
Client
:
TIdTCPClient
;
FHeaders
:
TStringList
;
FWindowHandle
:
THandle
;
Thread
:
TMJPEGDecoderThread
;
ThreadActive
:
Boolean
;
procedure
HandleConnected
(
Sender
:
TObject
)
;
procedure
HandleThreadTerminate
(
Sender
:
TObject
)
;
function
IsMixedReplace
(
CType
:
String
)
:
Boolean
;
procedure
InternalWinProc
(
var
Msg
:
TMessage
)
;
procedure
Error
(
Msg
:
String
)
;
procedure
Info
(
Msg
:
String
)
;
public
constructor
Create
(
AOwner
:
TComponent
)
;
destructor
Destroy
;
override
;
// connect to Hostname on port Port, and fetch the MJPEG stream from URI
procedure
Connect
(
Hostname
:
String
;
Port
:
Integer
;
URI
:
String
)
;
// disconnect (if connected)
procedure
Disconnect
;
published
// called when a frame is received; you MUST dispose of the frame yourself!
property
OnFrame
:
TMJPEGFrameEvent
read
FOnFrame
write
FOnFrame
;
// called when an error occurs
property
OnError
:
TMJPEGMessageEvent
read
FOnError
write
FOnError
;
// called when a debug message is generated
property
OnMessage
:
TMJPEGMessageEvent
read
FOnMessage
write
FOnMessage
;
// called when MJPEGDecoder connects to an MJPEG source
property
OnConnected
:
TNotifyEvent
read
FOnConnected
write
FOnConnected
;
// called when MJPEGDecoder disconnects
property
OnDisconnected
:
TNotifyEvent
read
FOnDisconnected
write
FOnDisconnected
;
// contains the headers received from the HTTP server
property
Headers
:
TStringList
read
FHeaders
;
// returns TRUE if connected, otherwise FALSE
property
Connected
:
Boolean
read
FConnected
;
end
;
implementation
uses
SysUtils
;
procedure
TMJPEGDecoder
.
InternalWinProc
(
var
Msg
:
TMessage
)
;
var
JPEGImage
:
TJPEGImage
;
JPEGStream
:
TMemoryStream
;
begin
if
(
Msg
.
Msg
=
WM_USER
)
then
begin
case
Msg
.
WParam
of
MSG_MJPEG_ERROR
:
begin
Error
(
'Decoder thread error: '
+
IntToStr
(
Msg
.
LParam
)
)
;
try
Client
.
Disconnect
;
except
;
end
;
FConnected
:
=
False
;
end
;
MSG_MJPEG_MESSAGE
:
begin
with
TMJPEGDecoderMsg
(
Msg
.
LParam
)
do
begin
Info
(
msg
)
;
Free
;
end
;
end
;
MSG_MJPEG_FRAME
:
begin
JPEGStream
:
=
TMemoryStream
(
Msg
.
LParam
)
;
JPEGStream
.
Position
:
=
0
;
if
Assigned
(
FOnFrame
)
then
begin
JPEGImage
:
=
TJPEGImage
.
Create
;
JPEGImage
.
LoadFromStream
(
JPEGStream
)
;
FOnFrame
(
Self
,
JPEGImage
)
;
end
;
JPEGStream
.
Free
;
end
;
end
;
end
;
end
;
constructor
TMJPEGDecoder
.
Create
(
AOwner
:
TComponent
)
;
begin
inherited
Create
;
FOwner
:
=
AOwner
;
FOnFrame
:
=
nil
;
FOnConnected
:
=
nil
;
FOnDisconnected
:
=
nil
;
Thread
:
=
nil
;
ThreadActive
:
=
False
;
FWindowHandle
:
=
AllocateHWnd
(
InternalWinProc
)
;
FHeaders
:
=
TStringList
.
Create
;
FHeaders
.
NameValueSeparator
:
=
':'
;
Client
:
=
TIdTCPClient
.
Create
(
FOwner
)
;
end
;
destructor
TMJPEGDecoder
.
Destroy
;
begin
if
Assigned
(
Thread
)
and
ThreadActive
then
Thread
.
Terminate
;
FHeaders
.
Free
;
Client
.
Free
;
inherited
;
end
;
procedure
TMJPEGDecoder
.
HandleThreadTerminate
(
Sender
:
TObject
)
;
begin
ThreadActive
:
=
False
;
end
;
procedure
TMJPEGDecoder
.
Connect
(
Hostname
:
String
;
Port
:
Integer
;
URI
:
String
)
;
begin
if
FConnected
then
exit
;
Client
.
Host
:
=
Hostname
;
Client
.
Port
:
=
Port
;
ClientURI
:
=
URI
;
FHeaders
.
Clear
;
Client
.
OnConnected
:
=
HandleConnected
;
try
Client
.
Connect
;
// (10);
except
if
not
Client
.
Connected
then
Error
(
'Could not connect to server'
)
;
end
;
end
;
procedure
TMJPEGDecoder
.
Disconnect
;
begin
if
not
FConnected
then
exit
;
Thread
.
Terminate
;
Client
.
Disconnect
;
if
(
FConnected
)
and
Assigned
(
FOnDisconnected
)
then
FOnDisconnected
(
Self
)
;
FConnected
:
=
False
;
end
;
procedure
TMJPEGDecoder
.
HandleConnected
(
Sender
:
TObject
)
;
var
S
:
String
;
CType
:
String
;
begin
Info
(
'Connected, sending request'
)
;
Client
.
IOHandler
.
WriteLn
(
'GET '
+
ClientURI
+
' HTTP/1.1'
)
;
Client
.
IOHandler
.
WriteLn
;
while
(
true
)
do
begin
S
:
=
Client
.
IOHandler
.
ReadLn
(
)
;
if
(
S
=
''
)
then
break
;
FHeaders
.
Add
(
S
)
end
;
CType
:
=
FHeaders
.
Values
[
'Content-Type'
]
;
if
(
not
IsMixedReplace
(
CType
)
)
then
begin
Error
(
'Invalid content type received from server: '
+
CType
)
;
Error
(
FHeaders
.
Text
)
;
Disconnect
;
exit
;
end
;
Info
(
'Request sent, spawning decoder thread'
)
;
Thread
:
=
TMJPEGDecoderThread
.
Create
(
Client
,
FWindowHandle
)
;
Thread
.
OnTerminate
:
=
HandleThreadTerminate
;
ThreadActive
:
=
True
;
Thread
.
Resume
;
FConnected
:
=
True
;
end
;
function
TMJPEGDecoder
.
IsMixedReplace
(
CType
:
String
)
:
Boolean
;
var
p
:
Integer
;
begin
CType
:
=
Trim
(
Ctype
)
;
p
:
=
Pos
(
';'
,
CType
)
;
if
(
p>
0
)
then
SetLength
(
CType
,
p
-
1
)
;
Result
:
=
(
CType
=
'multipart/x-mixed-replace'
)
;
end
;
procedure
TMJPEGDecoder
.
Error
(
Msg
:
String
)
;
begin
if
Assigned
(
FOnError
)
then
FOnError
(
Self
,
Msg
)
;
end
;
procedure
TMJPEGDecoder
.
Info
(
Msg
:
String
)
;
begin
if
Assigned
(
FOnMessage
)
then
FOnMessage
(
Self
,
Msg
)
;
end
;
end
.