babaev-an/lasarus_compotents
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Стартовый пул

Browse Source
This commit is contained in:
Александр Бабаев
2024-04-02 08:46:59 +03:00
parent fd57fffd3a
commit 3bb34d000b
5591 changed files with 3291734 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
PasLibVlc/Delphi2007/DemoPlayViaPipe/DemoPlayViaPipe.dpr Normal file
View File

@@ -0,0 +1,49 @@
(*
* This program 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 program 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 program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*
* Any non-GPL usage of this software or parts of this software is strictly
* forbidden.
*
* The "appropriate copyright message" mentioned in section 2c of the GPLv2
* must read: "Code from FAAD2 is copyright (c) Nero AG, www.nero.com"
*
*)
{$I ..\..\source\compiler.inc}
program DemoPlayViaPipe;
uses
Forms,
PasLibVlcUnit in '..\..\source\PasLibVlcUnit.pas',
PasLibVlcClassUnit in '..\..\source\PasLibVlcClassUnit.pas',
PasLibVlcPlayerUnit in '..\..\source.vcl\PasLibVlcPlayerUnit.pas',
MainFormUnit in 'MainFormUnit.pas' {MainForm};
{$R *.res}
begin
{$IFDEF DELPHI2007_UP}
ReportMemoryLeaksOnShutdown := TRUE;
{$ENDIF}
Application.Initialize;
{$IFDEF DELPHI2007_UP}
Application.MainFormOnTaskbar := True;
{$ENDIF}
Application.Title := 'PasLibVlcDemo';
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

79
PasLibVlc/Delphi2007/DemoPlayViaPipe/DemoPlayViaPipe.dproj Normal file
View File

@@ -0,0 +1,79 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{a6a45d80-2711-48be-a5c7-f881477954ff}</ProjectGuid>
<MainSource>DemoPlayViaPipe.dpr</MainSource>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>DemoPlayViaPipe.exe</DCC_DependencyCheckOutputName>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_Define>RELEASE</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_Define>DEBUG</DCC_Define>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
<BorlandProject xmlns=""> <Delphi.Personality> <Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1045</VersionInfo>
<VersionInfo Name="CodePage">1250</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
<VersionInfoKeys Name="ProductName"></VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
<Source>
<Source Name="MainSource">DemoPlayViaPipe.dpr</Source>
</Source>
</Delphi.Personality> </BorlandProject></BorlandProject>
</ProjectExtensions>
<ItemGroup />
<ItemGroup>
<DelphiCompile Include="DemoPlayViaPipe.dpr">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\..\source.vcl\PasLibVlcPlayerUnit.pas" />
<DCCReference Include="..\..\source\PasLibVlcClassUnit.pas" />
<DCCReference Include="..\..\source\PasLibVlcUnit.pas" />
<DCCReference Include="MainFormUnit.pas">
<Form>MainForm</Form>
</DCCReference>
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
</Project>

20
PasLibVlc/Delphi2007/DemoPlayViaPipe/MainFormUnit.dfm Normal file
View File

@@ -0,0 +1,20 @@
object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'DemoPlayFromStream'
ClientHeight = 310
ClientWidth = 474
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnActivate = FormActivate
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
end

313
PasLibVlc/Delphi2007/DemoPlayViaPipe/MainFormUnit.pas Normal file
View File

@@ -0,0 +1,313 @@
(*
* This program 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 program 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 program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*
* Any non-GPL usage of this software or parts of this software is strictly
* forbidden.
*
* The "appropriate copyright message" mentioned in section 2c of the GPLv2
* must read: "Code from FAAD2 is copyright (c) Nero AG, www.nero.com"
*
*)
{$I ..\..\source\compiler.inc}
unit MainFormUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, PasLibVlcUnit;
const
PIPE_BUFF_SIZE = 1024;
type
TPipeServer = class(TThread)
private
FOverlapped : Boolean;
FStream : TStream;
FPipeName : string;
hEvent : THandle;
hPipe : THandle;
oOverlap : TOverlapped;
fPendingIO : BOOL;
dwState : DWORD;
cbToWrite : DWORD;
cbWritten : DWORD;
fSuccess : BOOL;
dwWait : DWORD;
chBuff : packed array[0..PIPE_BUFF_SIZE-1] of byte;
procedure Execute_non_overlapped();
procedure Execute_overlapped();
protected
procedure Execute(); override;
public
constructor Create(AStream : TStream; pipeName : string; AOverlapped : Boolean = TRUE);
destructor Destroy; override;
end;
type
TMainForm = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
pname : string;
stream : TFileStream;
server : TPipeServer;
p_li : libvlc_instance_t_ptr;
p_mi : libvlc_media_player_t_ptr;
public
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
constructor TPipeServer.Create(AStream : TStream; pipeName : string; AOverlapped : Boolean = TRUE);
var
dwPipeMode : DWORD;
begin
inherited Create(TRUE);
FStream := AStream;
FPipeName := pipeName;
FOverlapped := AOverlapped;
dwPipeMode := PIPE_ACCESS_OUTBOUND;
if FOverlapped then
begin
FillChar(oOverlap, sizeof(oOverlap), 0);
hEvent := CreateEvent(NIL, TRUE, TRUE, NIL);
oOverlap.hEvent := hEvent;
dwPipeMode := dwPipeMode or FILE_FLAG_OVERLAPPED;
end;
hPipe := CreateNamedPipe(
PChar(FPipeName),
dwPipeMode,
PIPE_TYPE_MESSAGE or
PIPE_WAIT,
1,
PIPE_BUFF_SIZE,
PIPE_BUFF_SIZE,
50,
NIL);
end;
destructor TPipeServer.Destroy;
begin
CloseHandle(hPipe);
if (FOverlapped) then
begin
CloseHandle(hEvent);
end;
inherited Destroy;
end;
procedure TPipeServer.Execute_non_overlapped;
var
bConn : Bool;
begin
bConn := FALSE;
while not Terminated do
begin
bConn := ConnectNamedPipe(hPipe, NIL);
if bConn then break;
if (GetLastError() = ERROR_PIPE_CONNECTED) then
begin
bConn := TRUE;
break;
end;
end;
if bConn then
begin
while not Terminated do
begin
cbToWrite := FStream.Read(chBuff, PIPE_BUFF_SIZE);
if (cbToWrite < 1) then break;
fSuccess := WriteFile(
hPipe,
chBuff,
cbToWrite,
cbWritten,
NIL);
if (not fSuccess) then break;
if (cbToWrite <> cbWritten) then break;
end;
end;
end;
procedure TPipeServer.Execute_overlapped;
begin
if (ConnectNamedPipe(hPipe, @oOverlap)) then exit;
cbToWrite := 0;
fPendingIO := FALSE;
case GetLastError() of
ERROR_IO_PENDING : fPendingIO := TRUE;
ERROR_PIPE_CONNECTED : if (not SetEvent(oOverlap.hEvent)) then exit;
end;
if (fPendingIO) then dwState := 0 else dwState := 1;
while not Terminated do
begin
dwWait := WaitForSingleObject(hEvent, 50);
if (dwWait = WAIT_TIMEOUT) then continue;
if (dwWait <> WAIT_OBJECT_0) then break;
if (fPendingIO) then
begin
fSuccess := GetOverlappedResult(hPipe, oOverlap, cbWritten, FALSE);
if not fSuccess then break;
if (dwState = 1) then
begin
if (cbWritten <> cbToWrite) then break;
end;
if (dwState = 0) then
begin
dwState := 1;
end;
end;
if (dwState = 1) then
begin
cbToWrite := FStream.Read(chBuff, PIPE_BUFF_SIZE);
if (cbToWrite < 1) then break;
fSuccess := WriteFile(
hPipe,
chBuff,
cbToWrite,
cbWritten,
@oOverlap);
if (fSuccess and (cbWritten = cbToWrite)) then
begin
fPendingIO := FALSE;
continue;
end;
if ((not fSuccess) and (GetLastError() = ERROR_IO_PENDING)) then
begin
fPendingIO := TRUE;
continue;
end;
break;
end;
end;
end;
procedure TPipeServer.Execute();
begin
if (FOverlapped) then Execute_overlapped() else Execute_non_overlapped();
end;
// =============================================================================
procedure TMainForm.FormCreate(Sender: TObject);
var
p_md : libvlc_media_t_ptr;
begin
pname := '\\.\pipe\vlcpipe' + IntToStr(Round(Now() * SecsPerDay));
stream := TFileStream.Create('..\..\_testFiles\test.ts', fmOpenRead);
server := TPipeServer.Create(stream, pname, TRUE);
libvlc_dynamic_dll_init();
if (libvlc_dynamic_dll_error <> '') then
begin
MessageDlg(libvlc_dynamic_dll_error, mtError, [mbOK], 0);
exit;
end;
with TArgcArgs.Create([
libvlc_dynamic_dll_path,
'--intf=dummy',
'--ignore-config',
'--quiet',
'--no-video-title-show',
'--no-video-on-top'
// '--vout=vdummy',
// '--aout=adummy'
]) do
begin
p_li := libvlc_new(ARGC, ARGS);
Free;
end;
p_mi := NIL;
p_md := libvlc_media_new_location(p_li, PAnsiChar('stream://\' + pname));
if (p_md <> NIL) then
begin
p_mi := libvlc_media_player_new_from_media(p_md);
if (p_mi <> NIL) then
begin
libvlc_media_player_set_display_window(p_mi, SELF.Handle);
end;
libvlc_media_player_play(p_mi);
libvlc_media_release(p_md);
end;
end;
procedure TMainForm.FormActivate(Sender: TObject);
begin
OnActivate := NIL;
Sleep(50);
server.Resume;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
server.Terminate;
server.WaitFor;
server.Free;
if (p_mi <> NIL) then
begin
libvlc_media_player_stop(p_mi);
libvlc_media_player_release(p_mi);
p_mi := NIL;
end;
if (p_li <> NIL) then
begin
libvlc_release(p_li);
p_li := NIL;
end;
stream.Free;
end;
end.