|
Johan, I made this in Kylix/Delphi. It is a small deamon which listens on a tcp port. When you make a tcp connection to the port it will open the specified device and stream it over the connection. I use this to watch tv with xine. The daemon can handle mulptiple connections. I'm currently working on a complete set of programs but this should show how to read from a device in kylix/delphi. Regards, Michel Verbraak. Johan Duinkerken wrote: Thanks! It will have to run in a thread of it's own, because I'm decoding a sliced VBI-stream at the same time, but that shouldn't be a problem (Ha!) :-)I'm going to give it a try tonight (it's about 10 AM here), I'll let you know what the results are. cheers, Johan Duinkerken. |
program tvpump;
{$APPTYPE CONSOLE}
// Created by M. Verbraak ([EMAIL PROTECTED])
// Date 13-Aug-2004 Version 1.0
//
// tvpump is an mpeg2 tcp stream server.
// Multiple clients can connect to the server and will al receive
// the same mpeg2 stream.
// Streams are started at a GOP start.
//
// Tested with xine.
uses
SysUtils,
Types,
Classes,
Variants,
IdIOHandler,
IdTCPServer,
IdThread,
IdThreadMgr,
IdResourceStrings,
IdGlobal,
LibC;
Var
CAPTURE_DEVICE : String = '/dev/video0';
DEFAULT_PORT : Integer = 6767;
Const
MAX_READ_SIZE = 128 * 1024; // 128K
GOP_START = $BA010000;
Type
TByteArray = Array[0..MAX_READ_SIZE] Of Byte;
TConsole = class(TObject)
tcpServer: TIdTCPServer;
CDHandle : Integer;
ClientCount : Integer;
ShutDownServer: boolean;
Clients : TThreadList;
Locked :Boolean;
BytesRead : Integer;
Buffer : TByteArray;
DataAvailable : Boolean;
constructor create;
private
procedure keep_alive;
Procedure activateServer (VAR Component: TIdTCPServer; Port: word);
Procedure Send(AThread: TidPeerThread; Buffer: TByteArray; BytesRead:
Integer);
Public
procedure ServerConnect(AThread: TidPeerThread);
procedure ServerDisconnect(AThread: TidPeerThread);
procedure ServerExecute(AThread: TidPeerThread);
end;
TClientData = Record
Receiving : Boolean;
End;
PCLientData = ^TClientData;
var
Console: TConsole;
Function CheckGOPHeader(Buffer: TByteArray; Len: Integer; Var StartPos:
Integer): Boolean;
Var
TmpLWord : ^LongWord;
Begin
syslog( LOG_INFO, 'Finding GOP Header.');
TmpLWord := @Buffer;
While (StartPos <= Len -4) And
(TmpLWord^ <> GOP_START) Do
Begin
StartPos := StartPos + 1;
TmpLWord := @Buffer[StartPos];
End;
If (TmpLWord^ = GOP_START) And (StartPos <= Len -4) Then
Begin
Result := True;
syslog( LOG_INFO, 'Found GOP Header.');
End
Else
Begin
Result := False;
StartPos := 0;
End;
End;
Procedure TConsole.Send(AThread: TidPeerThread; Buffer: TByteArray; BytesRead:
Integer);
Var
StartPos : Integer;
ClientData : PClientData;
begin
StartPos := 0;
ClientData := PCLientData(AThread.Data);
If Not ClientData^.Receiving Then
ClientData^.Receiving := CheckGOPHeader(Buffer, BytesRead, StartPos);
AThread.Connection.CheckForDisconnect(True, True);
If (AThread.Connection.Connected) And (ClientData^.Receiving) Then
Try
Athread.Connection.WriteBuffer(Buffer[StartPos], BytesRead - StartPos,
False);
Finally
End;
end;
Constructor TConsole.Create;
begin
inherited Create;
tcpServer := TIdTCPServer.Create(Nil);
ClientCount := 0;
ShutDownServer := False;
Clients := TThreadList.Create;
Locked := False;
tcpServer.Active := False;
tcpServer.OnConnect := ServerConnect;
tcpServer.OnDisconnect := ServerDisconnect;
tcpServer.OnExecute := ServerExecute;
CDHandle := -1;
end;
Procedure TConsole.activateServer (VAR Component: TIdTCPServer; Port: word);
Var
TmpStr : String;
begin
with Component do
begin
active := false;
DefaultPort := Port;
Active := true;
TmpStr := Format('Activated tvpump for device %s on tcp port
%d',[CAPTURE_DEVICE,DEFAULT_PORT]);
syslog( LOG_INFO, Pchar(TmpStr));
end;
end;
procedure TConsole.keep_alive;
begin
DataAvailable := False;
while True do
begin
Try
If Not(DataAvailable) And (CDHandle >0) Then
Begin
// Write('1');
FillChar( Buffer, MAX_READ_SIZE, 0);
BytesRead := __Read( CDHandle, Buffer, MAX_READ_SIZE );
// Write('2');
DataAvailable := True;
End;
Except
On EControlC Do
Begin
ShutDownServer := True;
syslog( LOG_INFO, 'Received Ctrl + C.');
End;
End;
Sleep( 5 );
end;
end;
//Events-----------------------------------------------------------------
procedure TConsole.ServerConnect(AThread: TidPeerThread);
Var
ClientData : PCLientData;
begin
syslog( LOG_INFO, 'Client connected. Starting pump.');
ClientCount := ClientCount + 1;
If CLientCount = 1 Then
Begin
CDHandle := Open64( PChar(CAPTURE_DEVICE), O_RDONLY);
If CDHandle <= 0 Then
Begin
syslog( LOG_INFO, 'Error opening device.');
Halt(CDHandle);
End;
syslog( LOG_INFO, 'Opened device.');
End;
GetMem(ClientData, SizeOf(TCLientData));
ClientData.Receiving := False;
AThread.Data := TObject(ClientData);
Try
Clients.LockList.Add(AThread);
syslog( LOG_INFO, 'Added client to list.');
Finally
Clients.UnlockList;
End;
end;
procedure TConsole.ServerExecute(AThread: TidPeerThread);
Var
Counter : Integer;
begin
If (Not Locked) And (DataAvailable) Then
Begin
// Write('3');
With Clients.LockList Do
Try
Locked := True;
// Write('4');
If BytesRead > 0 Then
Begin
For Counter := 0 To Count - 1 Do
Begin
// Write('.');
Send(Items[Counter], Buffer, BytesRead);
// Write('|');
End;
End
Else
syslog( LOG_INFO, 'No data read from device.');
Finally
Clients.UnlockList;
DataAvailable := False;
Locked := False;
// Write('5');
End;
End;
Sleep(1);
end;
procedure TConsole.ServerDisconnect(AThread: TidPeerThread);
Var
CLientData : PCLientData;
begin
ClientData := PCLientData(AThread.Data);
Freemem(ClientData, SizeOf(TClientData));
ClientCount := ClientCount - 1;
If CLientCount = 0 Then
Begin
// FileClose(CDHandle);
__Close(CDHandle);
CDHandle := -1;
syslog( LOG_INFO, 'Closed device.');
End;
Try
Clients.LockList.Remove(AThread);
syslog( LOG_INFO, 'Removed client from list.');
Finally
Clients.UnlockList;
End;
AThread.Data := Nil;
syslog( LOG_INFO, 'Client disconnected. Stopped pump.');
end;
Var
ProgramName : String;
Parameter : String;
Counter : Integer;
begin
ProgramName := ExtractFileName(ParamStr(0));
OpenLog( PChar(ProgramName), LOG_PID, LOG_USER);
// Proces commandline parameters.
Counter := 1;
While Counter < ParamCount Do
Begin
Parameter := ParamStr(Counter);
If Parameter[1] = '-' Then
Case Parameter[2] Of
'd' : Begin
CAPTURE_DEVICE := ParamStr(Counter + 1);
Counter := Counter + 1;
End;
'p' : Begin
Try
DEFAULT_PORT := StrToInt(ParamStr(Counter + 1));
Except
DEFAULT_PORT := 6767;
End;
Counter := Counter + 1;
End;
Else
Begin
WriteLn;
WriteLn('Usage: ', ProgramName, ' [-d devicename] [-p port]');
WriteLn;
WriteLn(' -d devicename (e.g.: /dev/video0) default =
/dev/video0');
WriteLn(' -c port (e.g.: 8888) default = 6767');
WriteLn;
End;
End;
Counter := Counter + 1;
End;
If Daemon(0, 0) = 0 Then
Begin
Console:= TConsole.Create;
sleep(10);
Console.activateServer(Console.TCPServer, DEFAULT_PORT);
Console.keep_alive;
syslog( LOG_INFO, 'Stopping server.');
Console.tcpServer.Free;
Console.Free;
syslog( LOG_INFO, 'Server stopped.');
End
Else
WriteLn('Could not enter daemon mode. Closing program.');
CloseLog;
end.
