IPTV ist momentan der große Renner
hier habe ich ein kleines Programm um Livestreams zu testen
es werden rtmp,rtmpe, rtmpt, rtsp, mms, mmsh, http, m3u8 Streams unterstützt
als Player wird der VLC 2.0.6 benötigt und um die Streams umzucodieren rtmpdump.exe und ffmpeg.exe
die dumps könnt ihr auch hier downloaden unter http://www.iptvxtra.net/download/LiveSt ... /dumps.zip
die fertige *.exe (immer aktuell) hier: http://www.iptvxtra.net/download/LiveSt ... Tester.exe
vielleicht kanns jemand brauchen
wenn mein LiveMediaCenter fertig ist (momentan ca 30%), setze ich den Code auch mal rein
Code: Alles auswählen
Global Dir_boot.s = GetCurrentDirectory()
; PB 5.11 - Windoof XP - x386 - unicode
Global vlcfile.s = "c:\programme\videolan\vlc\vlc.exe" , ffmfile.s = "c:\programme\videolan\vlc\ffmpeg.exe"
Global rtmpfile.s = "c:\programme\videolan\vlc\rtmpdump.exe"
Global cache.s = "1000" , para.s , video.s , pfad.s , file.s , arrayposition = 0 , pfadm3u.s = "c:\"
Global Dim MyArray.s(0)
Procedure KillPrgx(ProcessName.s)
Protected snapshot.i
Protected prinfo.PROCESSENTRY32
Protected pname.s
Protected phandle.i
Protected pexitc.i
prinfo\dwSize = SizeOf(PROCESSENTRY32) : snapshot = CreateToolhelp32Snapshot_(#TH32CS_SNAPPROCESS, 0)
If snapshot
If Process32First_(snapshot, prinfo)
Repeat
pname = PeekS(@prinfo\szExeFile)
If ProcessName = pname : phandle = OpenProcess_(#PROCESS_TERMINATE, #False, prinfo\th32ProcessID)
If phandle : TerminateProcess_(phandle, @pexitc) : CloseHandle_(phandle) : EndIf
EndIf
Until Process32Next_(snapshot, prinfo) = 0
EndIf
CloseHandle_(snapshot)
EndIf
ProcedureReturn pexitc
EndProcedure
Procedure read_ini()
If ReadFile(0,Dir_boot + "m3u8tester.ini")
vlcfile = ReadString(0) : If vlcfile = "" : vlcfile = "c:\programme\videolan\vlc\vlc.exe" : EndIf
ffmfile = ReadString(0) : If ffmfile = "" : ffmfile = "c:\programme\videolan\vlc\ffmpeg.exe" : EndIf
pfadm3u = ReadString(0) : If pfadm3u = "" : pfadm3u = "c:\" : EndIf
cache = ReadString(0) : If cache = "" : cache = "1000" : EndIf
video = ReadString(0) : If video = "" : video = "m3u8 Stream hier direkt einfügen" : EndIf
rtmpfile = ReadString(0) : If rtmpfile = "" : rtmpfile = "c:\programme\videolan\vlc\rtmpdump.exe" : EndIf
CloseFile(0)
EndIf
EndProcedure
Procedure save_ini()
If CreateFile(0, Dir_boot + "m3u8tester.ini")
WriteStringN(0,vlcfile)
WriteStringN(0,ffmfile)
WriteStringN(0,pfadm3u)
WriteStringN(0,cache)
WriteStringN(0,video)
WriteStringN(0,rtmpfile)
CloseFile(0)
EndIf
EndProcedure
Procedure.s Parse(html.s,pos1.s,pos3.s)
xp = Len(pos1)
pos = FindString(html,pos1,pos) + xp
pos2 = FindString(html,pos3,pos) - pos
reststring$ = Right(html , Len(html) - (pos2 + pos))
result$ = Mid(html,pos,pos2)
result$ = Trim(result$)
result$ = Trim(result$, Chr(34))
result$ = Trim(result$, Chr(39))
result$ = Trim(result$)
ProcedureReturn result$
EndProcedure
Procedure Refresh(hTray.l)
Result = #False
If hTray : rRect.RECT : If GetClientRect_(hTray, rRect) : z = rRect\bottom / 2
For x = 0 To rRect\right Step 4 : SendMessage_(hTray, #WM_MOUSEMOVE, 0, (z << 16) | x) : Next x : Result = #True
EndIf : EndIf
ProcedureReturn Result
EndProcedure
Procedure.l FindSysTray()
hwnd.l = FindWindow_("Shell_TrayWnd", #Null)
If hwnd : hwnd = FindWindowEx_(hwnd, 0, "TrayNotifyWnd", #Null)
If hwnd : hwnd = FindWindowEx_(hwnd, 0, "SysPager", #Null)
If hwnd : hwnd = FindWindowEx_(hwnd, 0, "ToolbarWindow32", #Null)
EndIf : EndIf : EndIf
ProcedureReturn hwnd
EndProcedure
Procedure SysTrayRefresh()
Result = #False : hSystray.l = FindSysTray() : If Refresh(hSystray) : Result = #True : EndIf
ProcedureReturn Result
EndProcedure
read_ini()
If OpenWindow(0, 100, 200, 800, 510, "www.IPTVxtra.net - Live Stream Tester V1.3 - rtmp / rtmpe / rtmpt / rtsp / mms / mmsh / http / m3u8 ", #PB_Window_MinimizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
TextGadget(6, 20, 23, 150, 18, "Pfad zur vlc.exe :")
StringGadget(0, 150, 20, 530, 20, vlcfile)
ButtonGadget(1, 700, 20, 80, 20, "suchen")
TextGadget(7, 20, 53, 150, 18, "Pfad zur ffmpeg.exe :")
StringGadget(4, 150, 50, 530, 20, ffmfile)
ButtonGadget(5, 700, 50, 80, 20, "suchen")
TextGadget(16, 20, 83, 150, 18, "Pfad zur rtmpdump.exe :")
StringGadget(17, 150, 80, 530, 20, rtmpfile)
ButtonGadget(18, 700, 80, 80, 20, "suchen")
Frame3DGadget(20, 10, 10, 780, 100, "", #PB_Frame3D_Double)
Frame3DGadget(21, 10, 115, 780, 385, "", #PB_Frame3D_Double)
TextGadget(8, 20, 130, 200, 18, "Live Stream Adresse :")
StringGadget(2, 20, 150, 760, 20, video) : SetGadgetColor(2, #PB_Gadget_BackColor, $B9FFFF)
ButtonGadget(3, 20, 175, 505, 30, "testen")
ButtonGadget(15, 530, 175, 250, 30, "Zwischenablage") : DisableGadget(15,1) : GadgetToolTip(15,"letzter Test wird in die Zwischenablage kopiert")
ButtonGadget(9, 20, 215, 250, 25, "Datei mit Links zeilenweise einlesen")
ButtonGadget(10, 275, 215, 250, 25, "nach unten")
ButtonGadget(11, 530, 215, 250, 25, "nach oben")
ListViewGadget(12, 20, 250, 760, 240 )
TextGadget(13, 510, 130, 90, 18, "VLC Cache / kB :") : StringGadget(14, 610, 125, 70, 20, cache)
ButtonGadget(19, 700, 125, 80, 20, "VLC aus")
StickyWindow(0,1)
Repeat
event = WaitWindowEvent()
If event = #PB_Event_Gadget
Select EventGadget()
Case 1
vlcfile = OpenFileRequester("Bitte vlc.exe auswählen", "c:\programme\videolan\vlc\vlc.exe", "VLC (exe Dateien (*.exe)|*.exe", 0)
If vlcfile : SetGadgetText(0, vlcfile) : Else : SetGadgetText(0, "c:\programme\videolan\vlc\vlc.exe") : EndIf
Case 5
ffmfile = OpenFileRequester("Bitte ffmpeg.exe auswählen", "c:\programme\videolan\vlc\ffmpeg.exe", "FFMPEG (exe Dateien (*.exe)|*.exe", 0)
If ffmfile : SetGadgetText(4, ffmfile) : Else : SetGadgetText(4, "c:\programme\videolan\vlc\ffmpeg.exe") : EndIf
Case 18
rtmpfile = OpenFileRequester("Bitte rtmpdump.exe auswählen", "c:\programme\videolan\vlc\rtmpdump.exe", "RTMPDUMP (exe Dateien (*.exe)|*.exe", 0)
If rtmpfile : SetGadgetText(17, rtmpfile) : Else : SetGadgetText(17, "c:\programme\videolan\vlc\rtmpdump.exe") : EndIf
Case 3
KillPrgx("rtmpdump.exe") : KillPrgx("flv.exe") : KillPrgx("vlc.exe") : KillPrgx("cmd.exe") : KillPrgx("ffmpeg.exe") : SysTrayRefresh()
video = GetGadgetText(2) : ffmfile = GetGadgetText(4) : vlcfile = GetGadgetText(0) : cache = Trim(GetGadgetText(14))
para1.s = " -re -i " + video + " -acodec copy -vcodec copy -f mpegts pipe: | "
para2.s = " --network-caching=" + cache
para3.s = " --no-qt-system-tray --qt-start-minimized --no-qt-video-autoresize --no-qt-updates-notif --no-qt-error-dialogs"
para4.s = " --mouse-hide-timeout=500 --no-embedded-video --no-video-title-show --width=300 --height=200"
para5.s = " --video-x=20 --video-y=20 --crop=16:9 --video-title=IPTVxtra Player --play-and-exit --video-on-top --no-qt-error-dialogs"
para6.s = " -v -r " + video + " | "
If FindString(video,"rtmp://",1,#PB_String_CaseSensitive) Or FindString(video,"rtmpt://",1,#PB_String_CaseSensitive) Or FindString(video,"rtmpe://",1,#PB_String_CaseSensitive)
para = rtmpfile + para6 + vlcfile + para2 + para3 + para4 + para5 + " -"
ElseIf FindString(video,".m3u8",1,#PB_String_CaseSensitive) Or FindString(video,"27.131.145",1,#PB_String_CaseSensitive) Or FindString(video,"206.190.157",1,#PB_String_CaseSensitive) Or FindString(video,"93.115.82",1,#PB_String_CaseSensitive)
para = ffmfile + para1 + vlcfile + para2 + para3 + para4 + para5 + " -"
ElseIf FindString(video,"mms://",1,#PB_String_CaseSensitive) Or FindString(video,"mmsh://",1,#PB_String_CaseSensitive) Or FindString(video,"rtsp://",1,#PB_String_CaseSensitive)
para = vlcfile + para2 + para3 + para4 + para5 + " " + video
ElseIf FindString(video,"http://",1,#PB_String_CaseSensitive)
para = vlcfile + para2 + para3 + para4 + para5 + " " + video
EndIf
pfad = GetTemporaryDirectory() : DeleteFile(pfad + "stream.bat")
If CreateFile(0,pfad + "stream.bat") : WriteString(0,para) : CloseFile(0) : DisableGadget(15,0)
RunProgram(pfad + "stream.bat") : Delay(1000) : DeleteFile(pfad + "stream.bat")
EndIf
Case 9
file = OpenFileRequester("Bitte Datei auswählen", pfadm3u, "Dateien (*.*)|*.txt;*.m3u;*.m3u8;*.xml;*.bat", 0)
If file : ClearGadgetItems(12) : Dim MyArray.s(0)
If ReadFile(0,file) : a = 0
While Eof(0) = 0
MyArray(a) = ReadString(0) : MyArray(a) = RemoveString(MyArray(a),Chr(9))
MyArray(a) = Trim(MyArray(a)) : AddGadgetItem(12, -1, MyArray(a)) : a+1 : Redim MyArray.s(a)
Wend
EndIf
SetGadgetText(2, MyArray.s(0)) : arrayposition = 0 : pfadm3u = GetPathPart(file)
EndIf
Case 10
If arrayposition < ArraySize(MyArray())
SetGadgetText(2, MyArray.s(arrayposition+1))
SetGadgetState(12, arrayposition+1)
arrayposition + 1
EndIf
Case 11
If arrayposition > 0
SetGadgetText(2, MyArray.s(arrayposition-1))
SetGadgetState(12, arrayposition+1)
arrayposition - 1
EndIf
Case 12 : If FindString(GetGadgetText(12),">",1) And FindString(GetGadgetText(12),"<",1)
SetGadgetText(2, Parse(GetGadgetText(12),">","<"))
Else : SetGadgetText(2,GetGadgetText(12)) : EndIf
arrayposition = GetGadgetState(12)
Case 15 : SetClipboardText(ffmfile + para1 + vlcfile + " -")
Case 19 : KillPrgx("rtmpdump.exe") : KillPrgx("flv.exe") : KillPrgx("vlc.exe") : KillPrgx("cmd.exe") : KillPrgx("ffmpeg.exe") : SysTrayRefresh()
Case 2 : ;SendMessage_(GadgetID(2),#EM_SETSEL,1,-1)
EndSelect
EndIf
Until event = #PB_Event_CloseWindow
EndIf
save_ini()
KillPrgx("rtmpdump.exe") : KillPrgx("flv.exe") : KillPrgx("vlc.exe") : KillPrgx("cmd.exe") : KillPrgx("ffmpeg.exe") : SysTrayRefresh()
End