as Source is still under Construction it have some "onDummy()" DEBUG Code
fwTVCL.PRG
Code: Select all | Expand
*+--------------------------------------------------------------------
*+
*+ Source Module => c:\fwh\0\IPTV\FWVLC.PRG
*+
*+ Copyright(C) 1983-2022 by Auge & Ohr
*+
*+ Functions: Class FWTVlc
*+
*+ Reformatted by Click! 2.05.40 on Aug-2-2022 at 9:10 pm
*+
*+--------------------------------------------------------------------
#include "fivewin.ch"
#include "common.ch"
#define HB_VERSION_BITWIDTH 17
#define VLC_INPUT_STATE_IDLE 0
#define VLC_INPUT_STATE_OPENING 1
#define VLC_INPUT_STATE_BUFFERING 2
#define VLC_INPUT_STATE_PLAYING 3
#define VLC_INPUT_STATE_PAUSED 4
#define VLC_INPUT_STATE_STOPPING 5
#define VLC_INPUT_STATE_ENDED 6
#define VLC_INPUT_STATE_ERROR 7
#define MK_LBUTTON 0x0001
#define MK_RBUTTON 0x0002
#define MK_SHIFT 0x0004
#define MK_CONTROL 0x0008
*+--------------------------------------------------------------------
*+
*+ Class FWTVlc
*+
*+--------------------------------------------------------------------
*+
CLASS FWTVlc FROM TActiveX
DATA oControl, oPlayList, oInput, oVideo, oAudio, oMedia
DATA nStepVolume, nVolumen, nFilterRec, nRECNO, nIndex
DATA cFileName
DATA lRun
DATA lLoop
DATA lEndless
DATA bRClicked, bMenu, bPlayNext
DATA oFont, oParent
DATA cTimer, lStream
METHOD New( oParent, nRow, nCol, nWidth, nHeight, nIndex ) CONSTRUCTOR
METHOD Destroy()
METHOD SetFile( cFileName )
METHOD Play()
METHOD Stop()
METHOD Position( nPosition )
METHOD GetLength()
METHOD GetLengthStr()
METHOD GetTime()
METHOD GetTimeStr()
METHOD GetVersion()
METHOD SetTime( n )
METHOD Mute( lIn )
METHOD IsPlaying()
METHOD State()
METHOD Marquee( cText, cPos, nTimeout, nSize )
METHOD VLCevent( cEvent, aParams )
METHOD VLCstate()
METHOD CheckFullScreen()
METHOD IsFullScreen()
METHOD Time2MiliSec( cTime )
METHOD MiliSec2Time( nMiliSec )
METHOD Play_Next()
ENDCLASS
METHOD New( oParent, nRow, nCol, nWidth, nHeight, nIndex, oFont ) CLASS FWTVlc
LOCAL oError, bOldError
DEFAULT nIndex TO 1
::cTimer := "VLC_TIMER"
::cTimer += STRZERO( nIndex, 3 )
::oParent := oParent
::lEndless = .T.
::lLoop := .F.
::cFileName := ""
::lStream := .F.
IF EMPTY( oFont )
DEFINE FONT oFont NAME "TAHOMA" SIZE 0, - 12
#IFDEF __HMG__
END FONT
#ENDIF
ENDIF
// just to be compatible but not used
::oFont := oFont
bOldError := ERRORBLOCK( { | e | BREAK( e ) } )
BEGIN SEQUENCE
::oControl := ::SUPER:New( oParent, "VideoLAN.VLCPlugin.2", nRow, nCol, nWidth, nHeight )
RECOVER USING oError
ERRORBLOCK( bOldError )
MsgStop( 'This Program Required Installed ' + hb_ntos( hb_Version( HB_VERSION_BITWIDTH ) ) + '-bit AXVLC.DLL!', 'Error VLC ActiveX ' + LTRIM( HB_VALTOSTR( oError:osCode ) ) )
QUIT
END SEQUENCE
ERRORBLOCK( bOldError )
IF hb_isObject( ::oControl )
::nRECNO := 0
::nIndex := nIndex
::nStepVolume := 10
::nvolumen := 100
::oControl:Toolbar := .T.
::oControl:volume := ::nvolumen
::oControl:FullscreenEnabled := .T.
::oPlaylist := ::oControl:playlist
::oInput := ::oControl:input
::oVideo := ::oControl:video
::oAudio := ::oControl:audio
::oMedia := ::oControl:MediaDescription
::oAudio:mute := .T.
// Events
::oControl:bOnEvent = { | cEvent, aParams | ::VLCevent( cEvent, aParams ) }
::bMenu := { || NIL } // init with Codeblock
::bPlayNext := { || NIL } // init with Codeblock
// ActiveX have no Property bRClicked so ADD it
::bRClicked = { | nRow, nCol | EVAL( ::bMenu, nRow, nCol, ::oParent, ::nIndex ) }
* OnDummy( TIME(), "End VLC Setup" )
// for each Instanze internal TIMER
DEFINE TIMER ::cTimer of oParent INTERVAL 100 ACTION ::VLCstate() // check Play-State
ACTIVATE TIMER ::cTimer
ELSE
MsgStop( 'Control not create ?!"+CRLF+"This Program Required Installed ' + hb_ntos( hb_Version( HB_VERSION_BITWIDTH ) ) + '-bit AXVLC.DLL!', 'Error VLC ActiveX ' + LTRIM( HB_VALTOSTR( oError:osCode ) ) )
QUIT
ENDIF
RETURN Self
METHOD Destroy() CLASS FWTVlc
RELEASE TIMER ::cTimer
::oPlaylist := NIL
::oInput := NIL
::oVideo := NIL
::oAudio := NIL
::oMedia := NIL
::oControl := NIL
RETURN NIL // ::SUPER:Destroy()
METHOD SetFile( cFileName ) CLASS FWTVlc
LOCAL oError, bOldError := ERRORBLOCK( { | e | BREAK( e ) } )
LOCAL lRet := NIL
IF ::IsPlaying()
::Stop()
ENDIF
::cFileName := TRIM( cFileName )
IF !EMPTY( ::cFileName )
::oPlaylist:items:clear()
IF "http" $ LOWER( ::cFileName )
// add Stream
lRet := ::oPlaylist:add( ::cFileName )
ELSE
// add local Media
lRet := ::oPlaylist:add( "File:///" + ::cFileName )
ENDIF
IF ::State() == VLC_INPUT_STATE_ERROR
msginfo( "VLC_INPUT_STATE_ERROR", "Error" )
RETURN lRet
ENDIF
::oInput:position := 0
::oVideo:aspectRatio := "16:9"
::oControl:Toolbar := .T.
::oControl:FullscreenEnabled := .T.
::nRECNO := RECNO()
::Marquee( "Record : " + LTRIM( STR( ::nRECNO ) ), "top-right", 1000 * 5 )
* onDummy( TIME(), "SetFile()", ::nIndex, lRet, ::nRECNO, ::cFileName )
// lRet := .t.
ELSE
MsgInfo( "can not use Empty Filename" )
ENDIF
RETURN lRet
METHOD Play() CLASS FWTVlc
LOCAL lRet := NIL
IF ::IsPlaying()
::Stop()
ENDIF
lRet := ::oPlaylist:playitem( 0 )
SysRefresh()
::lRun := .T.
* onDummy( TIME(), "PlayURL()", ::nIndex, lRet, RECNO(), TRIM( TVURL->TVURL ) )
RETURN lRet
METHOD Stop() CLASS FWTVlc
LOCAL lRet := NIL
lRet := ::oPlaylist:stop()
RETURN lRet
METHOD Position( nPosition ) CLASS FWTVlc
IF HB_ISNIL( nPosition )
RETURN ::oControl:input:position
ELSE
IF nPosition >= 0 .AND. nPosition <= 1
::oControl:input:position := nPosition
ENDIF
ENDIF
RETURN NIL
METHOD GetLength() CLASS FWTVlc
RETURN ::oInput:length()
METHOD GetLengthStr() CLASS FWTVlc
RETURN ::MiliSec2Time( ::oInput:length() )
METHOD GetTime() CLASS FWTVlc
RETURN ::oInput:time()
METHOD GetTimeStr() CLASS FWTVlc
RETURN ::MiliSec2Time( ::oInput:time() )
METHOD GetVersion() CLASS FWTVlc
RETURN ::oControl:getVersionInfo()
METHOD SetTime( n ) CLASS FWTVlc
LOCAL nRet := ::oInput:time * 1000
IF HB_ISNUMERIC( n )
nRet := ::oInput:time := n * 1000
ENDIF
RETURN nRet
METHOD Mute( lIn ) CLASS FWTVlc
IF PCOUNT() > 0
::oAudio:mute := lIn
ENDIF
RETURN ::oAudio:mute
METHOD IsPlaying() CLASS FWTVlc
RETURN ::oPlaylist:IsPlaying
METHOD IsFullScreen() CLASS FWTVlc
RETURN ::oVideo:fullscreen
METHOD State() CLASS FWTVlc
RETURN ::oInput:state
METHOD Marquee( cText, cPos, nTimeout, nSize ) CLASS FWTVlc
LOCAL nAt := 1, acPos := { "center", "left", "right", "top", "top-left", "top-right", "bottom", "bottom-left", "bottom-right" }
IF HB_ISSTRING( cText )
::oVideo:marquee:text := cText
IF HB_ISSTRING( cPos )
nAt := ASCAN( acPos, { | i | i == cPos } )
ENDIF
IF HB_ISNUMERIC( nTimeout )
::oVideo:marquee:timeout := nTimeout
ENDIF
IF HB_ISNUMERIC( nSize )
::oVideo:marquee:size := nSize
ENDIF
::oVideo:marquee:position := acPos[ nAt ]
::oVideo:marquee:enable()
ENDIF
RETURN NIL
METHOD Time2MiliSec( cTime ) CLASS FWTVlc
LOCAL nMiliSec := 0
LOCAL nH, nM, nS, nT
IF !EMPTY( cTime )
nH = VAL( SUBSTR( cTime, 1, 2 ) )
nM = VAL( SUBSTR( cTime, 4, 2 ) )
nS = VAL( SUBSTR( cTime, 7, 2 ) )
nT = ( nH * 3600 ) + ( nM * 60 ) + nS
nMiliSec := nT * 1000
ENDIF
RETURN nMiliSec
METHOD MiliSec2Time( nMiliSec ) CLASS FWTVlc
LOCAL cTime := "00:00:00"
LOCAL nHora, nMinuto, nSegundo
IF nMiliSec > 0
nMiliSec := INT( nMiliSec / 1000 )
nHora := INT( nMiliSec / 3600 )
nMiliSec := nMiliSec - ( nHora * 3600 )
nMinuto := INT( nMiliSec / 60 )
nSegundo := nMiliSec - ( nMinuto * 60 )
cTime := STRZERO( nHora, 2 ) + ":" + STRZERO( nMinuto, 2 ) + ":" + STRZERO( nSegundo, 2 )
ENDIF
RETURN cTime
METHOD VLCevent( cEvent, aParams ) CLASS FWTVlc
// now by internal TIMER
// ::VLCstate() // check Play-State
// SysRefresh()
DO CASE
CASE cEvent == "MediaPlayerNothingSpecial"
// ::Marquee( "NothingSpecial", "top-right" )
CASE cEvent == "MediaPlayerOpening"
// ::Marquee( "Opening", "top-right" )
CASE cEvent == "MediaPlayerBuffering"
// ::Marquee( "Buffering", "top-right" )
CASE cEvent == "MediaPlayerPlaying"
// ::Marquee( "Record : " + LTRIM( STR( ::nRECNO ) ), "top-right" )
CASE cEvent == "MediaPlayerPaused"
CASE cEvent == "MediaPlayerForward"
CASE cEvent == "MediaPlayerBackward"
CASE cEvent == "MediaPlayerStopped"
CASE cEvent == "MediaPlayerEncounteredError"
* onDummy( TIME(), "MediaPlayer Encountered Error" )
MsgInfo( "MediaPlayer Encountered Error" + CRLF + ::cFileName )
// ::Play_Next()
CASE cEvent == "MediaPlayerEndReached"
* onDummy( TIME(), "MediaPlayer End Reached" )
// MsgInfo( "MediaPlayer End Reached" )
// ::Play_Next()
CASE cEvent == "MediaPlayerStopAsyncDone"
CASE cEvent == "MediaPlayerTimeChanged"
CASE cEvent == "MediaPlayerPositionChanged"
CASE cEvent == "MediaPlayerSeekableChanged"
CASE cEvent == "MediaPlayerPausableChanged"
CASE cEvent == "MediaPlayerMediaChanged"
CASE cEvent == "MediaPlayerTitleChanged"
CASE cEvent == "MediaPlayerLengthChanged"
CASE cEvent == "MediaPlayerChapterChanged"
CASE cEvent == "MediaPlayerVout"
CASE cEvent == "MediaPlayerMuted"
CASE cEvent == "MediaPlayerUnmuted"
CASE cEvent == "MediaPlayerAudioVolume"
CASE cEvent == "Click"
CASE cEvent == "DblClick"
// MsgInfo( "DblClick " + VAR2CHAR( aParams ) )
// ::ovideo:toggleFullscreen()
CASE cEvent == "KeyDown"
// MsgInfo( "KeyDown " + VAR2CHAR( aParams ) )
* OnDummy( TIME(), "KeyDown ", VAR2CHAR( aParams ), VK_F9 )
CASE cEvent == "KeyPress"
// MsgInfo( "KeyPress " + VAR2CHAR( aParams ) )
* OnDummy( TIME(), "KeyPress ", VAR2CHAR( aParams ), VK_F9 )
IF aParams[ 1 ] = VK_F9
::ovideo:toggleFullscreen()
ENDIF
CASE cEvent == "KeyUp"
CASE cEvent == "MouseDown"
// MsgInfo( "MouseDown " + VAR2CHAR( aParams ), VALTYPE(aParams) )
IF aParams[ 1 ] = MK_RBUTTON
IF !EMPTY( ::bRClicked )
EVAL( ::bRClicked, aParams[ 4 ], aParams[ 3 ] )
ENDIF
ENDIF
CASE cEvent == "MouseMove"
CASE cEvent == "MouseUp"
ENDCASE
SysRefresh()
RETURN NIL
METHOD VLCstate() CLASS FWTVlc
LOCAL bOldError := ERRORBLOCK( { | e | BREAK( e ) } )
LOCAL nPosi := 0
LOCAL cPosi
LOCAL oError
LOCAL nDuration
LOCAL xKey
LOCAL nPlayState
BEGIN SEQUENCE
IF ::lRun = .T.
nPlayState := ::State()
DO CASE
CASE nPlayState = VLC_INPUT_STATE_IDLE
CASE nPlayState = VLC_INPUT_STATE_OPENING
CASE nPlayState = VLC_INPUT_STATE_BUFFERING
CASE nPlayState = VLC_INPUT_STATE_PLAYING
IF ::lStream = .F.
cPosi := ::GetTimeStr()
// nPosi := TIMETOSEC( cPosi )
nPosi := ::Time2MiliSec( cPosi )
nDuration := INT( ::GetLength() / 1000 )
IF !EMPTY( nDuration )
IF nPosi >= nDuration - 1
* OnDummy( TIME(), "EOF", nPosi, nDuration )
::lRun := .F.
::Stop()
::SetTime( 0 )
IF ::IsFullScreen()
::ovideo:toggleFullscreen()
ENDIF
DO CASE
CASE ::lLoop = .T.
::Play()
CASE ::lEndless = .T.
// ::Play_Next()
ENDCASE
ENDIF
ENDIF
ENDIF
CASE nPlayState = VLC_INPUT_STATE_PAUSED
CASE nPlayState = VLC_INPUT_STATE_STOPPING
CASE nPlayState = VLC_INPUT_STATE_ENDED
CASE nPlayState = VLC_INPUT_STATE_ERROR
ENDCASE
ENDIF
END SEQUENCE
ERRORBLOCK( bOldError )
RETURN NIL
METHOD CheckFullScreen() CLASS FWTVlc
LOCAL cFile := "Start"
STATIC clastFile := ""
IF ::oVideo:fullscreen = .T.
IF ::oAudio:mute == .T.
::oAudio:toggleMute()
::Marquee( "Record : " + LTRIM( STR( ::nRECNO ) ), "top-right", 1000 * 5 )
ENDIF
cFile := ::cFileName
IF clastFile <> cFile
clastFile := cFile
// CopyToClipboard( cFile )
ENDIF
ELSE
IF ::oAudio:mute == .F.
::oAudio:toggleMute()
ENDIF
ENDIF
RETURN NIL
METHOD Play_Next() CLASS FWTVlc
LOCAL cItem := ""
IF !EMPTY( ::bPlayNext )
cItem := EVAL( ::bPlayNext )
IF !EMPTY( cItem )
::SetFile( cItem )
::Play()
ENDIF
ENDIF
RETURN NIL
*+ EOF: FWVLC.PRG
ReadM3U.PRG
Code: Select all | Expand
*+--------------------------------------------------------------------
*+
*+ Source Module => c:\fwh\0\IPTV\READM3U.PRG
*+
*+ Copyright(C) 1983-2022 by Auge & Ohr
*+
*+ Functions: Procedure ImportM3U()
*+ Static Procedure DoReadM3U()
*+ Static Procedure DoCheck()
*+ Static Procedure ReadExtinf()
*+ Static Procedure ReadName()
*+ Static Procedure ReadLogo()
*+ Static Procedure ReadGroup()
*+ Static Procedure Read_Country()
*+ Static Procedure Read_Language()
*+ Static Procedure ReadTVID()
*+ Static Procedure ReadChNo()
*+ Static Procedure ReadRadio()
*+ Static Procedure ReadShift()
*+ Static Procedure CheckAddAfter()
*+ Static Function CalcPos()
*+
*+ Tables: USE (cDBF) EXCLUSIVE ALIAS "IMPORT" VIA "DBFCDX"
*+
*+ Reformatted by Click! 2.05.40 on Aug-2-2022 at 9:10 pm
*+
*+--------------------------------------------------------------------
#include "fivewin.ch"
#include "common.ch"
*+--------------------------------------------------------------------
*+
*+ Procedure ImportM3U()
*+
*+ Called from ( fwiptv.prg ) 1 - static function buildmenu()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE ImportM3U( oBrw )
LOCAL cFile, nMaxLen, nEvery, nCount, cDBF
LOCAL cTitle := "Open Playlist"
LOCAL nStart := 1
LOCAL zPath := hb_DirBase()
LOCAL aFilters := { { "M3U Playlist", "*.M3U" } }
// cFile := Getfile( aFilters, cTitle, zPath, .F., .F., 1 )
cFile := cGetfile( "M3U Playlist|*.M3U|" + "all Files|*.*", cTitle,, zPath )
IF .NOT. EMPTY( cFile )
IF ".M3U" $ UPPER( cFile )
DoReadM3U( cFile )
cDBF := STRTRAN( UPPER( cFile ), ".M3U", ".DBF" )
IF FILE( cDBF )
IF MsgYesNo( "Append " + cDBF + " ?" )
SELECT 1
APPEND FROM ( cDBF )
GO TOP
oBrw:SetFocus()
oBrw:Refresh()
ENDIF
ENDIF
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoReadM3U()
*+
*+ Called from ( readm3u.prg ) 1 - procedure importm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoReadM3U( cFile )
LOCAL cAppdir := hb_DirBase()
LOCAL lTVgroup := .F.
LOCAL lTVName := .F.
LOCAL lTVid := .F.
LOCAL cMarker := CHR( 10 ) + CHR( 10 )
LOCAL cMemo, aLines, n, nMax, nPosi, cLine, cDBF, nEvery
LOCAL cTVname
LOCAL lTVradio
LOCAL cTVlogo
LOCAL cTVid
LOCAL cTVchno
LOCAL cTVgroup
LOCAL cTVurl
LOCAL cTVCountry
LOCAL cTVLanguage
LOCAL cTVshift
LOCAL aRow, nRow, nComma
IF FILE( cFile )
SELECT 2
cDBF := STRTRAN( UPPER( cFile ), ".M3U", ".DBF" )
IF !FILE( cDBF )
CreateDbf( cDBF )
ENDIF
USE (cDBF) EXCLUSIVE ALIAS "IMPORT" VIA "DBFCDX"
ZAP
cMemo := HB_MEMOREAD( cFile )
cMarker := CHR( 10 ) + CHR( 13 )
cMemo := STRTRAN( cMemo, CHR( 10 ), cMarker )
aLines := AtInside( cMarker, cMemo )
// aLines := HB_ATOKENS( cMemo, cMarker )
nMax := LEN( aLines )
nEvery := ROUND( nMax / 100, 0 )
// SetProperty( "IPTVMAIN", "ProgressBar_1", "Value", 0 )
// DoMethod( "IPTVMAIN", "Progressbar_1", "show" )
FOR n := 1 TO nMax
cLine := TRIM( aLines[ n ] )
IF EMPTY( cLine )
LOOP
ENDIF
IF "EXTM3U" $ cLine
LOOP
ENDIF
cTVname := ""
lTVradio := .F.
cTVlogo := ""
cTVid := ""
cTVchno := ""
cTVgroup := ""
cTVurl := ""
cTVCountry := ""
cTVLanguage := ""
cTVshift := ""
IF SUBSTR( LOWER( cLine ), 1, 4 ) = "http"
cTVurl := cLine
// CheckAddAfter( @cTVurl )
REPLACE FIELD->TVURL WITH STRTRAN( cTVurl, CHR( 34 ), "" )
LOOP
ELSE
lTVgroup := .F.
aRow := AtInside( " ", cLine )
FOR nRow := 1 TO LEN( aRow )
cLine := aRow[ nRow ]
DO CASE
CASE EMPTY( cLine )
CASE "EXTINF:-1," $ cLine
lTVName := .T.
ReadExtinf( @cTVname, cLine, @lTVName )
lTVgroup := .F.
lTVid := .F.
CASE "EXTINF:-1" $ cLine
lTVName := .F.
lTVgroup := .F.
lTVid := .F.
CASE "EXTINF:0" $ cLine
lTVName := .F.
ReadExtinf( @cTVname, cLine, @lTVName )
lTVgroup := .F.
lTVid := .F.
CASE AT( "tvg-name=", cLine ) > 0
lTVName := .T.
ReadName( @cTVname, cLine, @lTVName )
lTVgroup := .F.
lTVid := .F.
CASE AT( "tvg-logo=", cLine ) > 0
lTVName := .T.
ReadLogo( @cTVlogo, cLine, @cTVname, @lTVName )
lTVgroup := .F.
lTVid := .F.
CASE AT( "tvg-language=", cLine ) > 0
Read_Language( @cTVLanguage, cLine )
lTVName := .F.
lTVgroup := .F.
lTVid := .F.
CASE AT( "tvg-country=", cLine ) > 0
Read_Country( @cTVCountry, cLine )
lTVName := .F.
lTVgroup := .F.
lTVid := .F.
CASE AT( "tvg-id=", cLine ) > 0
lTVid := .T.
ReadTVID( @cTVid, cLine, @cTVName )
lTVgroup := .F.
lTVName := .F.
CASE AT( "tvg-chno=", cLine ) > 0
ReadChNo( @cTVchno, cLine )
lTVgroup := .F.
lTVName := .F.
lTVid := .F.
CASE AT( "radio=", cLine ) > 0
ReadRadio( @lTVradio, cLine )
lTVgroup := .F.
lTVName := .F.
lTVid := .F.
CASE AT( "group-title=", cLine ) > 0
lTVgroup := .T.
lTVName := .F.
ReadGroup( @cTVgroup, cLine, @cTVname, @lTVgroup, @lTVName )
lTVid := .F.
CASE AT( "tvg-shift", cLine ) > 0
ReadShift( @cTVshift, cLine )
lTVgroup := .F.
lTVName := .F.
lTVid := .F.
OTHERWISE
IF lTVgroup = .T.
cTVgroup += " " + cLine
ENDIF
IF lTVName = .T.
cTVname += " " + cLine
ENDIF
IF lTVid = .T.
cTVid += " " + cLine
ENDIF
ENDCASE
NEXT
ENDIF
DoCheck( @cTVname, @cTVlogo, @cTVurl, @cTVgroup )
APPEND BLANK
IF EMPTY( cTVname )
// REPLACE FIELD->TVNAME WITH STRTRAN( UPPER(cTVgroup), CHR( 34 ), "" )
ELSE
REPLACE FIELD->TVNAME WITH LTRIM( STRTRAN( UPPER( cTVname ), CHR( 34 ), "" ) )
ENDIF
IF EMPTY( VAL( cTVchno ) )
REPLACE FIELD->TVCHNO WITH RECNO()
ELSE
REPLACE FIELD->TVCHNO WITH VAL( STRTRAN( cTVchno, CHR( 34 ), "" ) )
ENDIF
REPLACE FIELD->TVID WITH STRTRAN( cTVid, CHR( 34 ), "" )
REPLACE FIELD->TVLOGO WITH STRTRAN( cTVlogo, CHR( 34 ), "" )
// CheckAddAfter( @cTVurl )
// can be longer > 255 so use MEMO
REPLACE FIELD->TVURL WITH STRTRAN( cTVurl, CHR( 34 ), "" )
REPLACE FIELD->TVLANG WITH STRTRAN( UPPER( cTVLanguage ), CHR( 34 ), "" )
REPLACE FIELD->TVGROUP WITH STRTRAN( UPPER( cTVgroup ), CHR( 34 ), "" )
REPLACE FIELD->TVRADIO WITH lTVradio
// IF ( n % nEvery ) = 0
// SetProperty( "IPTVMAIN", "ProgressBar_1", "Value", CalcPos( n, nMax ) )
// DO EVENTS
// SysRefresh()
// ENDIF
NEXT
// DoMethod( "IPTVMAIN", "Progressbar_1", "hide" )
ENDIF
IF USED()
CLOSE
ENDIF
SELECT 1
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoCheck()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoCheck( cTVname, cTVlogo, cTVurl, cTVgroup )
LOCAL nComma
cTVname := ALLTRIM( cTVname )
cTVlogo := ALLTRIM( cTVlogo )
cTVurl := ALLTRIM( cTVurl )
cTVgroup := ALLTRIM( cTVgroup )
nComma := AT( ",", cTVlogo )
IF nComma > 0
IF EMPTY( cTVname )
cTVname := SUBSTR( cTVgroup, nComma + 1 )
ENDIF
cTVlogo := SUBSTR( cTVlogo, 1, nComma - 1 )
ENDIF
cTVurl := STRTRAN( cTVurl, CRLF, "" )
cTVurl := STRTRAN( cTVurl, CHR( 0 ), "" )
nComma := AT( ",", cTVurl )
IF nComma > 0
IF EMPTY( cTVname )
cTVname := SUBSTR( cTVgroup, nComma + 1 )
ENDIF
cTVurl := SUBSTR( cTVurl, 1, nComma - 1 )
ENDIF
nComma := AT( ",", cTVgroup )
IF nComma > 0
IF EMPTY( cTVname )
cTVname := SUBSTR( cTVgroup, nComma + 1 )
ENDIF
cTVgroup := SUBSTR( cTVgroup, 1, nComma - 1 )
ENDIF
nComma := AT( ",", cTVname )
IF nComma > 0
cTVname := SUBSTR( cTVname, 1, nComma - 1 )
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ReadExtinf()
*+
*+ Called from ( readm3u.prg ) 2 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ReadExtinf( cTVname, cLine, lTVName )
LOCAL nComma
nComma := AT( ",", cLine )
IF nComma > 0
cTVname := SUBSTR( cLine, nComma + 1 )
lTVName := .T.
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ReadName()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ReadName( cTVname, cLine, lTVName )
LOCAL nComma
LOCAL nPosi := AT( "tvg-name=", cLine )
IF nPosi > 0
cTVname := SUBSTR( cLine, nPosi + 9 )
nComma := AT( ",", cTVname )
IF nComma > 0
cTVname := SUBSTR( cTVname, 1, nComma - 1 )
lTVName := .T.
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ReadLogo()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ReadLogo( cTVlogo, cLine, cTVname )
LOCAL nComma
LOCAL nPosi := AT( "tvg-logo=", cLine )
IF nPosi > 0
cTVlogo := SUBSTR( cLine, nPosi + 9 )
nComma := AT( ",", cTVlogo )
IF nComma > 0
IF EMPTY( cTVname )
cTVname := SUBSTR( cTVlogo, nComma + 1 )
cTVname := STRTRAN( cTVname, ".", " " )
cTVname := ALLTRIM( cTVname )
ENDIF
cTVlogo := SUBSTR( cTVlogo, 1, nComma - 1 )
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ReadGroup()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ReadGroup( cTVgroup, cLine, cTVname, lTVgroup, lTVName )
LOCAL nComma
LOCAL nPosi := AT( "group-title=", cLine )
IF nPosi > 0
cTVgroup := SUBSTR( cLine, nPosi + 12 )
nComma := AT( ",", cTVgroup )
IF nComma > 0
lTVgroup := .F.
lTVName := .T.
cTVname := SUBSTR( cTVgroup, nComma + 1 )
cTVgroup := SUBSTR( cTVgroup, 1, nComma - 1 )
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure Read_Country()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE Read_Country( cTVCountry, cLine )
LOCAL nPosi := AT( "tvg-country=", cLine )
IF nPosi > 0
cTVCountry := SUBSTR( cLine, nPosi + 12 )
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure Read_Language()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE Read_Language( cTVLanguage, cLine )
LOCAL nPosi := AT( "tvg-language=", cLine )
IF nPosi > 0
cTVLanguage := SUBSTR( cLine, nPosi + 13 )
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ReadTVID()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ReadTVID( cTVid, cLine, cTVName )
LOCAL nPosi := AT( "tvg-id=", cLine )
IF nPosi > 0
cTVid := SUBSTR( cLine, nPosi + 7 )
IF EMPTY( cTVName )
cTVName := UPPER( cTVid )
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ReadChNo()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ReadChNo( cTVchno, cLine )
LOCAL nPosi := AT( "tvg-chno=", cLine )
IF nPosi > 0
cTVchno := SUBSTR( cLine, nPosi + 9 )
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ReadRadio()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ReadRadio( lTVradio, cLine )
LOCAL nPosi := AT( "radio=", cLine )
IF nPosi > 0
lTVradio := .T.
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ReadShift()
*+
*+ Called from ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ReadShift( cTVshift, cLine )
LOCAL nPosi := AT( "tvg-shift", cLine )
IF nPosi > 0
cTVshift := SUBSTR( cLine, nPosi + 9 )
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure CheckAddAfter()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE CheckAddAfter( cTVurl )
LOCAL nPosi := RAT( ".m3u8", cTVurl )
LOCAL nLen := LEN( TRIM( cTVurl ) )
IF nPosi > 0
IF nPosi + 4 < nLen
cTVurl := SUBSTR( cTVurl, 1, nPosi + 4 )
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function CalcPos()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION CalcPos( nValue, iMax ) // for Progressbar
LOCAL nRet := 0
LOCAL nEvery
LOCAL xScale
IF iMax < 100
nEvery := 100 / iMax
nRet := nValue * nEvery
ELSE
nEvery := INT( iMax / 100 )
xScale := iMax * nEvery // Scale to 100%
nRet := iMax / xScale * nValue
ENDIF
RETURN ROUND( nRet, 0 )
*+ EOF: READM3U.PRG
! Note : work in SELECT 2 Workspace while MAIN in SELECT 1
fwIPTV.PRG
Code: Select all | Expand
Your message contains 65872 characters. The maximum number of allowed characters is 60000.
compile with
for BCC 32 Bit
for MSVC 64 Bit
for BCC 32 Bit you can also use Go.BAT / FWIPTV.MAK
Code: Select all | Expand
set BCDIR=c:\bcc7
%BCDIR%\bin\make -fFWIPTV.MAK
if errorlevel 0 FWIPTV.exe
Code: Select all | Expand
HBDIR=C:\HARBOUR
BCDIR=C:\BCC7
FWDIR=C:\FWH
#change these paths as needed
.path.obj=.\objh
PRG = \
FWIPTV.PRG \
FWVLC.PRG \
READM3U.PRG
PROJECT : FWIPTV.EXE
FWIPTV.EXE : $(PRG:.PRG=.OBJ) FWIPTV.res
echo off
echo $(BCDIR)\lib\c0w32.obj + > b32.bc
echo .\objh\FWIPTV.obj .\objh\FWVLC.obj .\objh\READM3U.obj, + >> b32.bc
echo FWIPTV.exe, + >> b32.bc
echo FWIPTV.map, + >> b32.bc
echo $(FWDIR)\lib\FiveH.lib $(FWDIR)\lib\FiveHC.lib $(FWDIR)\lib\libmysql.lib + >> b32.bc
echo $(FWDIR)\lib\hbpgsql.lib $(FWDIR)\lib\libpq.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbhpdf.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\libhpdf.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\png.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbwin.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\gtgui.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbrtl.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbvm.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hblang.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbmacro.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbrdd.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\rddntx.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\rddcdx.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\rddfpt.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbsix.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbdebug.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbcommon.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbpp.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbcpage.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbcplr.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbct.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbpcre.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\xhb.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbziparc.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbmzip.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbzlib.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\minizip.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbusrrdd.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbtip.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbzebra.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\hbcurl.lib + >> b32.bc
echo $(HBDIR)\lib\win\bcc\libcurl.lib + >> b32.bc
echo $(FWDIR)\lib\dolphin.lib + >> b32.bc
echo $(BCDIR)\lib\cw32.lib + >> b32.bc
echo $(BCDIR)\lib\uuid.lib + >> b32.bc
echo $(BCDIR)\lib\import32.lib + >> b32.bc
echo $(BCDIR)\lib\ws2_32.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\odbc32.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\nddeapi.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\iphlpapi.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\msimg32.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\psapi.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\rasapi32.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\gdiplus.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\shell32.lib , >> b32.bc
IF EXIST FWIPTV.res echo FWIPTV.res >> b32.bc
$(BCDIR)\bin\ilink32 -Gn -aa -Tpe -s @b32.bc
del b32.bc
.PRG.OBJ:
if not exist objh mkdir objh
$(HBDIR)\bin\harbour $< /L /N /W /Oobjh\ /I$(FWDIR)\include;$(HBDIR)\include
$(BCDIR)\bin\bcc32 -c -tWM -I$(HBDIR)\include -oobjh\$& objh\$&.c
FWIPTV.res : FWIPTV.rc
$(BCDIR)\bin\brc32 -r FWIPTV.rc
---
Source is based on MiniGUI Extended Verson c:\minigui\Samples\vlc\myplayer.prg
* VideoLan VLC ActiveX demo
*
* Author: Carlos Vargas <cvargaz[at]donboscocorp.com
>
i have not used all Methode for IP-TV Player but add new Method
and Property
Code: Select all | Expand
DATA lStream
DATA lLoop
DATA lEndless
DATA bRClicked, bMenu, bPlayNext
in VLCevent() you can get Keyboard / Mouse "down" from ActiveX e.g. right-click for POPUP Menu
---
normal a "Stream" have no "Duration", it run endless
when play a Media it will end after "Duration" and here VLCstate() can help
Code: Select all | Expand
CASE nPlayState = VLC_INPUT_STATE_PLAYING
// if File not "Stream"
IF ::lStream = .F.
cPosi := ::GetTimeStr()
nPosi := TIMETOSEC( cPosi )
nDuration := INT( ::GetLength() / 1000 )
IF !EMPTY( nDuration )
IF nPosi >= nDuration - 1
just before EOF of Media i can call "NEXT" or "LOOP"
Code: Select all | Expand
DO CASE
CASE ::lLoop = .T.
::Play()
CASE ::lEndless = .T.
::Play_Next()
ENDCASE
some *.M3U does not contain a "Stream" but a "Media"
---
Codeblock bMenu
Code: Select all | Expand
// Codeblock for Menu "over" VLC ( not when playing )
oVLCX:bMenu := { | nRow, nCol | VLCmenu( nRow, nCol, oDlg, 1 ) }
and will be use "internal"
Code: Select all | Expand
// ActiveX have no Property bRClicked so ADD it
::bRClicked = { | nRow, nCol | EVAL( ::bMenu, nRow, nCol, ::oParent, ::nIndex ) }
! Note : you can use multi Instanze of VLC ( ::nIndex ) which have "own" right-click Menu
Codeblock bPlayNext
Code: Select all | Expand
// Codeblock for Function to load next Item. MUST return String to load !
oVLCX:bPlayNext := { || DoSkipNext() ) }
Code: Select all | Expand
METHOD Play_Next()
LOCAL cItem := ""
IF !EMPTY( ::bPlayNext )
cItem := EVAL( ::bPlayNext )
IF !EMPTY(cItem)
::SetFile(cItem)
::Play()
ENDIF
ENDIF
RETURN NIL
---
when start App it will create new DBF (if not Exist)
! Note : as URL can be > 255 you need a MEMO to be "compatible".
i use harbour Setting
Code: Select all | Expand
PROCEDURE CreateDbf( datei )
...
AADD( field_list, { "TVURL", "C", 640, 0 } )
download from above HMG-Forum "Playlist" and "Import" it ( see MENU of App )
you need to re-start to "fill" COMBOBOX with UNIQUE FIELD->TVGROUP
you can start with different DBF as Parameter where you have import Playlist
Index will create new every Time
---
you can Dblclick or ENTER in XBROWSE to start "Stream" ... it can take some Time until connect
when "Stream" it "playing" you can DblCLick on VLC or use F9 for "Fullscreen". ESC will return to normal Size
you can re-size WINDOW but XBROWSE FONT Size will "stay".
use CTRL and "+" of NumPad (or CTRL + Wheel) to "zoom" XBROWSE
btw. TIMER in MAIN using CheckFullScreen() will switch Sound ON when Maximize and OFF when Normalize
XBROWSE have implement increment search
---
todo : "mark" multiple Channel to display multiple VLC-Player at same Time on Screen
(Depend on Hardware and Connection Speed)
