*+--------------------------------------------------------------------
*+
*+ Source Module => c:\fwh\0\IPTV\FWIPTV.PRG
*+
*+ Copyright(C) 1983-2022 by Auge & Ohr
*+
*+ Functions: Procedure Main()
*+ Procedure VLCmenu()
*+ Static Procedure DoInit()
*+ Static Function BuildMenu()
*+ Static Procedure DoFillCombo()
*+ Static Procedure ChangeCombo()
*+ Static Procedure ChangeFilter()
*+ Static Procedure DoReSize()
*+ Procedure CreateDbf()
*+ Static Procedure CreateIndex()
*+ Static Procedure SwitchFull()
*+ Procedure onDummy()
*+ Static Procedure OpenSndVol()
*+ Static Procedure Do_Store()
*+ Static Procedure Do_Say()
*+ Static Procedure DoLocate()
*+ Static Function DoSeekInc()
*+ Static Function DownloadFromWWW()
*+ Static Function IsProcessRun()
*+ Function VAR2CHAR()
*+ Function AtInside()
*+ Static Function DoShow()
*+ Static Function OwnerDrawItem()
*+
*+ Tables: USE (cDBF) ALIAS "TVURL" EXCLUSIVE VIA "DBFCDX"
*+
*+ Reformatted by Click! 2.05.40 on Aug-2-2022 at 9:10 pm
*+
*+--------------------------------------------------------------------
#include "fivewin.ch"
#include "common.ch"
#define SW_SHOW 5
#define COLOR_HIGHLIGHT 13
#define COLOR_HIGHLIGHTTEXT 14
#define COLOR_WINDOW 5
#define COLOR_WINDOWTEXT 6
REQUEST DBFCDX
REQUEST DBFNTX
STATIC oDlg, oBrw, oImage, oFont
STATIC lDebug := .T.
STATIC aItems := { "Hello", "World" }
STATIC oCombo
STATIC oVLCX
STATIC oControl
STATIC oplaylist
STATIC oVideo
STATIC cVar1 := "Name "
STATIC cVar2 := "Channel "
STATIC cVar3 := "GERMAN "
STATIC cVar4 := "Logo "
STATIC cVar5 := "URL "
STATIC cVar6 := "Group "
STATIC nRadio := 1
STATIC cCombo := "all Record"
STATIC cLastCB := "all Record"
STATIC oGet1
STATIC oGet2
STATIC oGet3
STATIC oGet4
STATIC oGet5
STATIC oGet6
STATIC oRadio
STATIC cVersion := "v0.0.15"
*+--------------------------------------------------------------------
*+
*+ Procedure Main()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE Main( cDBF )
LOCAL oCol, oTimer
LOCAL cAppdir := hb_DirBase()
LOCAL aRect := { 0, 0, 0, 0 }
DEFAULT cDBF TO "TVURL.DBF"
SET ALTER TO "_LOGIT2.TXT"
* OnDummy( TIME(), "Start˙App" )
IF !FILE( cDBF )
CreateDbf( cDBF )
ENDIF
SELECT 1
USE (cDBF) ALIAS "TVURL" EXCLUSIVE VIA "DBFCDX"
// create temporary Index
CreateIndex( "TVURL.CDX" )
SET INDEX TO ( "TVURL.CDX" )
ORDSETFOCUS( "TVCHANNEL" )
DEFINE FONT oFont NAME "TAHOMA" SIZE 0, - 12
#IFDEF __HMG__
END FONT
#ENDIF
DEFINE WINDOW oDlg FROM 0, 0 TO 600, 800 + 16 PIXEL TITLE "TVIP " + cVersion ICON "A1MAIN" MENU BuildMenu()
// Syntax : oDlg, nRow, nCol, nWidth, nHeight, nIndex, oFont
oVLCX := FWTVlc() :New( oDlg, 0, 0, 400, 300, 1, oFont )
// Use Stream ( no Duration for EOF )
oVLCX:lStream = .T.
// Codeblock for Menu "over" VLC ( not when playing )
oVLCX:bMenu := { | nRow, nCol | VLCmenu( nRow, nCol, oDlg, 1 ) }
// Codeblock for Function to load next Item.
// MUST return String to load !
oVLCX:bPlayNext := { || NIL }
@ 310, 010 COMBOBOX oCombo VAR cCombo ITEMS aItems SIZE 300, 300 PIXEL OF oDlg ON CHANGE ChangeCombo() ;
OWNERDRAW OwnerDrawItem( Self, nIdCtl, oItemStruct )
// need to "fill" here for OWNERDRAW
DoInit()
@ 310, 330 XIMAGE oImage SIZE 64, 64 OF oDlg // NOBORDER
oImage:lBmpTransparent := .F.
@ 340, 010 SAY "Name " GET oGet1 VAR cVar1 SIZE 290, 026 PIXEL OF oDlg FONT oFont
@ 370, 010 SAY "Channel " GET oGet2 VAR cVar2 SIZE 120, 026 PIXEL OF oDlg FONT oFont
@ 410, 010 SAY "GERMAN " GET oGet3 VAR cVar3 SIZE 370, 026 PIXEL OF oDlg FONT oFont
@ 440, 010 SAY "Logo " GET oGet4 VAR cVar4 SIZE 370, 026 PIXEL OF oDlg FONT oFont
@ 470, 010 SAY "URL " GET oGet5 VAR cVar5 SIZE 370, 026 PIXEL OF oDlg FONT oFont
@ 500, 010 SAY "Group " GET oGet6 VAR cVar6 SIZE 370, 026 PIXEL OF oDlg FONT oFont
@ 370, 250 RADIO oRadio VAR nRadio ITEMS "TV", "Radio" OF oDlg SIZE 48, 16 PIXEL ON CHANGE ChangeFilter()
@ 000, 400 XBROWSE oBrw SIZE 400, 540 PIXEL OF oDlg ON DBLCLICK DoShow( TVURL->TVURL ) FONT oFont ALIAS 'TVURL'
ADD oCol TO oBrw DATA TVURL->TVCHNO HEADER "Channel"
ADD oCol TO oBrw DATA TVURL->TVNAME HEADER "Name"
oBrw:nMoveType := 5 // no Move
oBrw:bKeyDown := { | nKey | IF( nKey == VK_RETURN, DoShow( TVURL->TVURL ), nil ) }
oBrw:bLDblClick = { || DoShow( TVURL->TVURL ) }
oBrw:bchange := { || Do_Store() }
oBrw:bSeek := { | cSeek | DoSeekInc( cSeek ) }
oBrw:CreateFromCode()
SETKEY( VK_F1, { || MsgInfo( "under construction ..." ) } )
// SETKEY( VK_F1, nil )
// SETKEY( VK_F7, { || DoLocate() } )
SETKEY( VK_F9, { || SwitchFull() } )
// SETKEY( ASC( "F" ), { || SwitchFull() } )
// SETKEY( ASC( "I" ), { || ImportM3U( oBrw ) } )
SETKEY( VK_ESCAPE, { || oVLCX:Stop() } )
// TIMER only "need" to switch Sound ON / OFF in thos App
DEFINE TIMER oTimer OF oDlg ACTION oVLCX:CheckFullScreen() INTERVAL 1000
ACTIVATE TIMER oTimer
#IFDEF __HMG__
END WINDOW
#ENDIF
ChangeFilter() // does SET FILTER
Do_Store() // DBF Field -> cVar
oBrw:SetFocus()
oDlg:Cargo := { oDlg:nWidth, oDlg:nHeight, 18 }
AEVAL( oDlg:aControls, { | o | o:Cargo := { o:nTop, o:nLeft, o:nWidth, o:nHeight, 18 } } ) // o:oFont:nHeight
ACTIVATE WINDOW oDlg CENTERED ;
ON RESIZE DoReSize()
// does not work with OWNERDRAW
// ON INIT DoInit() ;
// EXCESS RELEASE OF FONT TAHOMA[ hFont : 0] ( nCount : 0 )
// <-TFONT:END(303) <-MAIN(0)
// RELEASE FONT oFont
oTimer:End()
oVLCX:End()
* OnDummy( TIME(), "Exit App" )
SET ALTER TO
RETURN
*+--------------------------------------------------------------------
*+
*+ Procedure VLCmenu()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE VLCmenu( nRow, nCol, oParent, nIndex ) // called by FWTVlc:bRClicked
LOCAL oPopup
DEFAULT nIndex TO 1
IF hb_isObject( oParent )
MENU oPopup POPUP
MENUITEM "&POPUP Menu" ACTION MsgInfo( "Hello world " + VAR2CHAR( nIndex ) )
SEPARATOR
ENDMENU
ACTIVATE POPUP oPopup WINDOW oParent AT nRow, nCol
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoInit()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoInit()
DoFillCombo()
oCombo:SetItems( aItems )
oCombo:Set( "all Record" )
// not when using Ownerdraw
// ChangeFilter()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function BuildMenu()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION BuildMenu()
LOCAL oMenu
MENU oMenu
MENUITEM "&Action"
MENU
MENUITEM "E&xit" RESOURCE "B1EXIT" ACTION oDlg:End()
SEPARATOR
MENUITEM "&Import" RESOURCE "B1IMPORT" ACTION ImportM3U( oBrw )
SEPARATOR
MENUITEM "&Sound" RESOURCE "B1SOUND" ACTION OpenSndVol( oDlg )
ENDMENU
ENDMENU
RETURN oMenu
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoFillCombo()
*+
*+ Called from ( fwiptv.prg ) 1 - static procedure doinit()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoFillCombo()
LOCAL nPosi
aItems := { "all Record" }
ORDSETFOCUS( "TVGROUP" ) // UNIQUE
GO TOP
DO WHILE !EOF()
IF EMPTY( FIELD->TVGROUP )
SKIP
LOOP
ENDIF
AADD( aItems, FIELD->TVGROUP )
SKIP
ENDDO
ORDSETFOCUS( "TVCHANNEL" )
GO TOP
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ChangeCombo()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ChangeCombo()
* OnDummy( TIME(), "ChangeCombo()", nRadio )
cLastCB := cCombo
IF nRadio <> 1
cCombo := "all Record"
ENDIF
oCombo:Set( cCombo )
oCombo:refresh()
ChangeFilter()
Do_Store()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure ChangeFilter()
*+
*+ Called from ( fwiptv.prg ) 2 - procedure main()
*+ 1 - static procedure changecombo()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ChangeFilter()
STATIC nLast := 0
IF nRadio <> 1
cCombo := "all Record"
oCombo:Set( cCombo )
ELSE
oCombo:Set( cLastCB )
ENDIF
oCombo:refresh()
DBCLEARFILTER()
ORDSETFOCUS( "TVCHANNEL" )
IF cCombo = "all Record"
IF nRadio = 1
SET FILTER TO FIELD->TVRADIO = .F.
GOTO( 945 ) // STAR TREK
ELSE
SET FILTER TO FIELD->TVRADIO = .T.
GO TOP
ENDIF
ELSE
IF nRadio = 1
SET FILTER TO FIELD->TVRADIO = .F. .AND. FIELD->TVGROUP = cCombo
ELSE
SET FILTER TO FIELD->TVRADIO = .T. .AND. FIELD->TVGROUP = cCombo
ENDIF
GO TOP
ENDIF
IF hb_isObject( oBrw )
oBrw:Refresh()
ENDIF
Do_Store()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoReSize()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoReSize()
LOCAL aRect, nHwnd
LOCAL xFactor := oDlg:nWidth / oDlg:Cargo[ 1 ]
LOCAL yFactor := oDlg:nHeight / oDlg:Cargo[ 2 ]
LOCAL oCtrl, h, lUseFont, nSizeBox := 10
LOCAL oError, bOldError := ERRORBLOCK( { | e | BREAK( e ) } )
ALTD()
* OnDummy( TIME(), "x", xFactor, "y", yFactor )
FOR each oCtrl in oDlg:aControls
WITH OBJECT oCtrl
:nTop := :Cargo[ 1 ] * yFactor
:nLeft := :Cargo[ 2 ] * xFactor
:nWidth := :Cargo[ 3 ] * xFactor
:nHeight := :Cargo[ 4 ] * yFactor
h := - :Cargo[ 5 ]
h := - ROUND( ( h * yFactor ), 0 )
lUseFont := .T.
DO CASE
CASE :IsKindOf( "FWTVLC" )
lUseFont := .F.
CASE :IsKindOf( "TXBROWSE" )
lUseFont := .F.
CASE :IsKindOf( "TXIMAGE" )
lUseFont := .F.
CASE :IsKindOf( "TCOMBOBOX" )
:nHeight := :nWidth
:HGet( h )
lUseFont := .F.
// ondummy( TIME(), :ClassName(), :Cargo[ 5 ], h, yFactor )
CASE :IsKindOf( "TSAY" )
CASE :IsKindOf( "TGET" )
RoundRect( :hDC, :nLeft, :nTop, :nLeft + nSizeBox, :nTop + nSizeBox, 40, 40 )
CASE :IsKindOf( "TRADIO" )
OTHERWISE
msginfo( "Error " + :ClassName() )
lUseFont := .F.
ENDCASE
IF lUseFont = .T.
BEGIN SEQUENCE
// fwVLC have no oFont
IF h != :oFont:nInpHeight
:SetFont( :oFont:Modify( h ) )
ENDIF
END SEQUENCE
ERRORBLOCK( bOldError )
ENDIF
:Refresh()
END
NEXT
RETURN
*+--------------------------------------------------------------------
*+
*+ Procedure CreateDbf()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+ ( readm3u.prg ) 1 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE CreateDbf( datei )
LOCAL field_list := {}
AADD( field_list, { "TVNAME", "C", 070, 0 } )
AADD( field_list, { "TVCHNO", "N", 005, 0 } )
AADD( field_list, { "TVID", "C", 040, 0 } )
AADD( field_list, { "TVGROUP", "C", 020, 0 } )
AADD( field_list, { "TVLANG", "C", 020, 0 } )
AADD( field_list, { "TVRADIO", "L", 001, 0 } )
AADD( field_list, { "TVLOGO", "C", 255, 0 } )
// Note : xBase comaptible are only 255
//
// AADD( field_list, { "TVURL", "C", 255, 0 } )
AADD( field_list, { "TVURL", "C", 640, 0 } )
// you can use MEMO instead when need to be compatible
//
// AADD( field_list, { "TVLOGO", "M", 10, 0 } )
// AADD( field_list, { "TVURL", "M", 10, 0 } )
DBCREATE( datei, field_list, "DBFCDX" )
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure CreateIndex()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE CreateIndex( _cdxname )
LOCAL aFields := { "TVCHNO", "TVNAME", "TVID", "TVGROUP" }
LOCAL _tagname
LOCAL _keyfeld
IF USED()
FERASE( "TVURL.CDX" )
_tagname := "TVCHANNEL"
_KEYFELD := "TVCHNO"
ORDCREATE( _cdxname, _tagname, _keyfeld )
CLOSE INDEX
_tagname := "TVSTATION"
// _KEYFELD := "Upper(TVNAME)"
_KEYFELD := "TVNAME"
ORDCREATE( _cdxname, _tagname, _keyfeld )
CLOSE INDEX
_tagname := "TVIDNAME"
_KEYFELD := "TVID"
ORDCREATE( _cdxname, _tagname, _keyfeld, .t., .t. )
CLOSE INDEX
_tagname := "TVGROUP"
// _KEYFELD := "Upper(TVGROUP)"
_KEYFELD := "TVGROUP"
ORDCREATE( _cdxname, _tagname, _keyfeld, .t., .t. )
CLOSE INDEX
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure SwitchFull()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE SwitchFull()
LOCAL oVideo
IF hb_isObject( oVLCX )
oVideo := oVLCX:Video
// oVideo:fullscreen := .T.
oVideo:toggleFullscreen()
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Procedure onDummy()
*+
*+ Called from ( fwiptv.prg ) 2 - procedure main()
*+ 1 - static procedure changecombo()
*+ 1 - static procedure doresize()
*+ 4 - static function doshow()
*+ ( fwvlc.prg ) 8 - class fwtvlc
*+
*+--------------------------------------------------------------------
*+
PROCEDURE onDummy()
LOCAL iMax := PCOUNT()
LOCAL i
LOCAL cText := ""
LOCAL xValue
IF lDebug = .T.
FOR i := 1 TO iMax - 1
cText += Var2Char( PValue( i ) ) + CHR( 9 )
NEXT
cText += Var2Char( PValue( iMax ) )
IF EMPTY( cText )
cText := TIME() + " no Parameter ? " + CRLF + PROCNAME( 1 ) + STR( PROCLINE( 1 ) ) + CRLF + PROCNAME( 2 ) + STR( PROCLINE( 2 ) )
ENDIF
SET CONSOLE OFF
SET ALTER ON
// ? cText
QOUT( cText )
SET ALTER OFF
SET CONSOLE ON
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure OpenSndVol()
*+
*+ Called from ( fwiptv.prg ) 1 - static function buildmenu()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE OpenSndVol( oParent )
LOCAL cWin := GETENV( "windir" )
LOCAL cPara
// IF IsProcessRun( "SndVol.exe" ) // GERMAN : Lautst„rkemixer
// ELSE
// Parameter : -r Position of SndVol
// calculate : nPosition := y * 65536 + x
// x,y Position as PIXEL
ShellExecute( oParent:hWnd, "open", cWin + "\System32\SndVol.exe", " -r 16384300", hb_DirBase(), SW_SHOW )
// ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure Do_Store()
*+
*+ Called from ( fwiptv.prg ) 2 - procedure main()
*+ 1 - static procedure changecombo()
*+ 1 - static procedure changefilter()
*+ 1 - static procedure dolocate()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE Do_Store()
LOCAL cImage, hBitmap
LOCAL cTempDir := GETENV( "TEMP" )
LOCAL cLocalFileName := cTempDir + "\TVTEMP.BMP"
LOCAL nRecord
IF hb_isObject( oImage )
oImage:SetSource( "" )
cImage := TRIM( FIELD->TVLOGO )
IF DownloadFromWWW( cImage, cLocalFileName, .T. )
oImage:SetSource( cLocalFileName )
// oImage:ReSize(, 64, 64 )
oImage:FitRect()
// oImage:FitWidth()
// oImage:FitHeight()
oImage:nUserControl := 0
// oImage:SetColor( CLR_WHITE, CLR_BLACK )
oImage:SetColor( CLR_WHITE, CLR_GRAY )
// oImage:Shadow()
// oImage:Refresh()
SysRefresh()
ENDIF
ENDIF
IF USED()
cVar1 := TVURL->TVNAME
cVar2 := TVURL->TVCHNO
cVar3 := TVURL->TVID
cVar4 := TVURL->TVLOGO
cVar5 := TVURL->TVURL
cVar6 := TVURL->TVGROUP
nRadio := IF( TVURL->TVRADIO, 2, 1 )
Do_Say()
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure Do_Say()
*+
*+ Called from ( fwiptv.prg ) 1 - static procedure do_store()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE Do_Say()
IF hb_isObject( oGet1 )
oGet1:refresh()
ENDIF
IF hb_isObject( oGet2 )
oGet2:refresh()
ENDIF
IF hb_isObject( oGet3 )
oGet3:refresh()
ENDIF
IF hb_isObject( oGet4 )
oGet4:refresh()
ENDIF
IF hb_isObject( oGet5 )
oGet5:refresh()
ENDIF
IF hb_isObject( oGet5 )
oGet6:refresh()
ENDIF
IF hb_isObject( oRadio )
oRadio:refresh()
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoLocate()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoLocate() // unused
LOCAL nOldRec := RECNO()
STATIC cSeek := " "
IF MsgGet( "Seek for Name", ; // Title
"Name :", ; // Label
@cSeek ) // A variable by reference
IF USED()
// LOCATE FOR FIELD->TVNAME = UPPER( TRIM( cSeek ) )
ORDSETFOCUS( "TVSTATION" )
SEEK( UPPER( TRIM( cSeek ) ) )
IF FOUND()
oBrw:Refresh()
ELSE
GO TOP
SET SOFTSEEK ON
SEEK( UPPER( TRIM( cSeek ) ) )
// LOCATE FOR FIELD->TVNAME = UPPER( TRIM( cSeek ) )
SET SOFTSEEK OFF
oBrw:Refresh()
ENDIF
Do_Store()
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function DoSeekInc()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION DoSeekInc( cSeek )
LOCAL lRet := .F.
IF USED()
// SEEK on all Record
SET FILTER TO
ORDSETFOCUS( "TVSTATION" )
SEEK( UPPER( TRIM( cSeek ) ) )
IF FOUND()
lRet := .T.
END
ENDIF
RETURN lRet
*+--------------------------------------------------------------------
*+
*+ Static Function DownloadFromWWW()
*+
*+ Called from ( fwiptv.prg ) 1 - static procedure do_store()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION DownloadFromWWW( cUrl, cFile )
LOCAL oErr
LOCAL oHttp := Win_OleCreateObject( "MSXML2.ServerXMLHTTP" )
IF FILE( cFile )
hb_FileDelete( cFile )
ENDIF
IF .NOT. "http" $ cUrl
RETURN .F.
ENDIF
BEGIN SEQUENCE WITH { | oErr | BREAK( oErr ) }
oHttp:Open( "GET", cUrl, .F. )
oHttp:setRequestHeader( "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:68.0) Gecko/20100101 Firefox/68.0" )
oHttp:Send()
IF oHttp:Status = 200
StrFile( oHttp:ResponseBody(), cFile )
ENDIF
oHttp:Abort()
RECOVER USING oErr
MsgStop( "Error download " + cUrl )
END SEQUENCE
RETURN FILE( cFile )
*+--------------------------------------------------------------------
*+
*+ Static Function IsProcessRun()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION IsProcessRun( cApp ) // unused
LOCAL oProcesses, oProcess, oWMI, oLocator, nHwnd := 0
LOCAL lRet := .F.
oLocator := CreateObject( "wbemScripting.SwbemLocator" )
IF EMPTY( oLocator )
msginfo( "can not create wbemScripting.SwbemLocator" )
oLocator := NIL
RETURN .F.
ELSE
oWMI := oLocator:ConnectServer()
ENDIF
IF EMPTY( oWMI )
msginfo( "can not connect oLocator:ConnectServer()" )
oLocator := NIL
oWMI := NIL
RETURN .F.
ELSE
oProcesses = oWMI:ExecQuery( "SELECT * FROM Win32_Process" )
IF oProcesses:Count > 0
FOR EACH oProcess in oProcesses
IF UPPER( TRIM( oProcess:Name ) ) = UPPER( TRIM( cApp ) )
nHwnd := VAL( oProcess:Handle )
// oProcess:Terminate( 0 )
lRet := .T.
EXIT
ENDIF
NEXT
ENDIF
ENDIF
oProcesses := NIL
oWMI := NIL
oLocator := NIL
IF !( nHwnd == 0 )
SetForegroundWindow( nHwnd )
BringWindowToTop( nHwnd )
ShowWindow( nHwnd, 1 )
UpdateWindow( nHwnd )
ENDIF
RETURN lRet
*+--------------------------------------------------------------------
*+
*+ Function VAR2CHAR()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure vlcmenu()
*+ 2 - procedure ondummy()
*+ ( fwvlc.prg ) 2 - class fwtvlc
*+
*+--------------------------------------------------------------------
*+
FUNCTION VAR2CHAR( cIn )
LOCAL cOut := hb_valToExp( cIn )
RETURN STRTRAN( cOut, '"', '' )
*+--------------------------------------------------------------------
*+
*+ Function AtInside()
*+
*+ Called from ( readm3u.prg ) 2 - static procedure doreadm3u()
*+
*+--------------------------------------------------------------------
*+
FUNCTION AtInside( cMarker, cText )
LOCAL nPos := 1
LOCAL nIst := 0
LOCAL aRet := {}
DO WHILE .T.
nPos := AT( cMarker, cText )
IF nPos > 0
nIst ++
AADD( aRet, LTRIM( SUBSTR( cText, 1, ( nPos - 1 ) ) ) )
cText := SUBSTR( cText, ( nPos + 1 ), LEN( cText ) - nPos )
ELSE
AADD( aRet, LTRIM( cText ) )
EXIT
ENDIF
ENDDO
RETURN aRet
*+--------------------------------------------------------------------
*+
*+ Static Function DoShow()
*+
*+ Called from ( fwiptv.prg ) 3 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION DoShow( cFileName )
LOCAL aPos, aSize
LOCAL aRect := { 0, 0, 0, 0 }
IF hb_isObject( oVLCX )
* OnDummy( TIME(), "play " + cFileName )
oVLCX:SetTime( 0 )
oVLCX:SetFile( cFileName )
* OnDummy( TIME(), "DoShow SetFile()" )
oVLCX:Play()
* OnDummy( TIME(), "call play()" )
SysRefresh()
IF oVLCX:IsPlaying()
* OnDummy( TIME(), "isplaying" )
ENDIF
ENDIF
RETURN .T.
*+--------------------------------------------------------------------
*+
*+ Static Function OwnerDrawItem()
*+
*+ Called from ( fwiptv.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION OwnerDrawItem( Self, nIdCtl, oItem )
LOCAL oFont1, nClrText, nClrBack, cItem
LOCAL hDC := oItem:hDC
IF oItem:itemID >= 0
cItem := oItem:itemData
DEFINE Font oFont1 NAME oItem:itemData SIZE nil, oItem:nHeight
#IFDEF __HMG__
END FONT
#ENDIF
nClrText := IF( lAnd( oItem:itemState, 1 ), GetSysColor( COLOR_HIGHLIGHTTEXT ), GetSysColor( COLOR_WINDOWTEXT ) )
nClrBack := IF( lAnd( oItem:itemState, 1 ), GetSysColor( COLOR_HIGHLIGHT ), GetSysColor( COLOR_WINDOW ) )
FW_SayText( hDC, oItem:itemData, oItem:aRect, "L", oFont1, ;
nClrText, nARGB( 255, nClrBack ) )
oFont1:End()
ENDIF
RETURN 1
#IFDEF USE_INC
#include "FWVLC.PRG"
#include "READM3U.PRG"
#endif
*+ EOF: FWIPTV.PRG
