На просторах интернета достаточно много ресурсов транслирующих потоковое видео.
Для просмотра видео роликов, ваш интернет должен иметь хорошую пропускную способность.
На этих сайтах, как правило, кроме полезной нам информации присутствует много всего прочего, не очень нам интересного, контекстная рекламы и.т.д. Нам навязывают все это смотреть: мигающие картинки, всплывающие банеры,
различные едкие надписи -режущие глаза. Оконный вариант
от всего этого избавлен.
.
Используется самый простой принцип - это отображение страницы встроенной функцией
Первым делом - ищем ресурс который подходит нам по своим параметрам. Это рабочие ссылки на видео трансляции и качество самого видео.
Необходимо проверить возможность работы страницы на локальном компьютере, не все ресурсы это позволяют делать.
Рассмотрим к примеру сайт:
.
Из интересных особенностей - это наличие обновляющихся скринов текущих трансляций и довольно хорошее качество самого видео.
На данном сайте, перейдем по любой ссылке на видео трансляцию и сохраним данную странице себе на компьютер.
Для дальнейшего удобства зададим простое имя без пробелов, английскими буквами, нашему
файлу.
файл и папка с ресурсами (картинки, скрипты, и.т.д.).
файл и смотрим: происходит видео трансляция, или нет.
Если видео транслируется - можно работать дальше.
файл в любом HTML-редакторе или в блокноте и внимательно изучаем исходный код.
Нас будет интересовать строки кода отвечающие за работу плеера. Если имеется малейшее представление о назначении
разметку преподают даже в средней школе) Вы легко их определите. Или можно воспользоваться "методом научного тыка" исключая фрагменты кода и проверяя на работоспособность.
- код самого плеера. В его структуру не будем вникать.
Можно приступать к программированию.
наш сохраненный файл.
Если всё было сделано правильно, то после компиляции, мы должны получить следующий результат:
наслаждаясь онлайновым просмотром интересных фильмов о космосе...
Для того, чтоб не создавать себе дополнительные трудности и если не планируем коммерческое использование данного ПО, воспользуемся полной версией
функции.
Добавим в наш онлайн плеер список текущих трансляций.
для сохранения страницы себе на компьютер.
Просмотрев результат в окне отладки, мы обнаружим наличие английского текста и непонятных
иероглифов. Наша программа не восприняла
. Если не планируется использовать русский текст со страницы, на это можно закрыть глаза. Но в нашей программе используются как английские названия телетрансляций, так и русские.
1. Включить в настройках компилятора поддержку
(но здесь тоже есть свои не всегда приемлемые нюансы).
2. Применить специальную процедуру на основе
.
Поступим по второму варианту. Тогда наш код примет такой вид:
.
.
В двух словах: по ключевым словам находим нужные нам строки и вырезаем из них нужный нам текст.
Это название видео трансляций, адрес видео потоков и адрес скринов изображений.
Global Dim Name.s(30),Dim Adres.s(30), Dim Img.s(30)
Procedure.s Utf2Ansi(string.s) ; перевод с Unicode
len_s=Len(string)*2+2
*out = AllocateMemory(len_s)
*out1 = AllocateMemory(len_s)
MultiByteToWideChar_(65001, 0, string, -1, *out, len_s)
WideCharToMultiByte_(#CP_ACP,0,*out,-1,*out1,len_s,0,0)
Text$ = PeekS(*out1 , -1, #PB_Ascii)
FreeMemory(*out)
FreeMemory(*out1)
If Left(Text$, 1)="?" : Text$=LTrim(Text$, "?") : EndIf
ProcedureReturn Text$
EndProcedure
Procedure.s Between_2(string.s, L.s, R.s) ; вырезаем между L-R
Position = FindString(string, L.s, 1)
string2.s = Right(string, Len(string)+1-Position-Len(L.s))
Position2 = FindString(string2, R.s, 1)
string3.s = Left(string2, Position2-1)
If Position <> 0
ProcedureReturn string3.s
EndIf
EndProcedure
Procedure Yatv(url.s) ; парсинг сервиса
URLDownloadToFile_(0,url.s,"yatv.txt",0,0)
If ReadFile(0,"yatv.txt")
While Eof(0) = 0
string.s= ReadString(0)
If FindString(string, "")
Name.s(t) = Between_2(string,"/"+Chr(34)+">","")
t=t+1
EndIf
If FindString(string, Chr(34)+"thumb"+Chr(34)+" style=",1)
string= Utf2Ansi(string.s)
url_img.s =Between_2(string,"(",")")
Img(r)=url_img
r=r+1
EndIf
Wend
CloseFile(0)
EndIf
EndProcedure
url.s = "http://yatv.ru/ru/tv,channels?page=0"
Yatv(url.s)
В принципе для получения списка всё готово, можно создавать оконный интерфейс.
При дальнейшем написании кода всплыла такая проблема: долгая загрузка картинок скринов.
И если ждать окончания загрузки последнего скрина, а потом создавать окно с гаджетами, проходит достаточно много времени.
Есть смысл сначала создать окно с ImageGadget() и использовать одно изображение в качестве фона.
А скрины скачивать в потоке CreateThread() и постепенно заменять наполнение ImageGadget() по мере скачивани.
При выборе видео трансляции из списка, происходит парсинг страницы и поиск строк с кодом плеера.
Принцип аналогичен описанному выше (применяется библиотека PureBasic - String и процедура Between_2()).
Далее создаём новый htm файл и загружаем его в WebGadget()
Для ScrollAreaGadget() используем заранее нарисованный фон (в любимом вашем редакторе).
В нижней части окна можно создать кнопки с фаворитами каналов.
Добавить две кнопки 'вперед' 'назад' для перелистывания страниц или выпадающий список для быстрого перехода по страницах.
; Последнее изменение:17 Июнь, 2011 @ 4:18:00 PM
;=============================================================================================
Global UnLoadSkin.l
Procedure.l Skin(skin.s)
If OpenLibrary(0, "SkinFeature.dll")
InitializeSkin.l = GetFunction(0, "InitializeSkin")
LoadSkinFile.l = GetFunction(0, "LoadSkinFile")
UnLoadSkin.l = GetFunction(0, "UnLoadSkin")
InitLicenKeys.l = GetFunction(0, "InitLicenKeys")
CallFunctionFast(InitializeSkin)
CallFunctionFast(InitLicenKeys, @"EB3E7432-D0A3-4fbe-AADE-D73C7903ABB6")
CallFunctionFast(LoadSkinFile, @"Dark Soft.rss", @"") ; Надеваем скин из файла на диске
rez=1
EndIf
ProcedureReturn rez
EndProcedure
rez=Skin(skin.s)
;=============================================================================================
Enumeration
#Window_0=100
#Cont
#Web
#Scrol
#dep
#nex
#kosmos
#Text
#NG
#ZD
#Lat_TM
#HD_TV_MUSIC
#p1080
#Disco80x
#VLS
#MaskiShow
#CCCR
EndEnumeration
UseJPEGImageDecoder()
url.s = "http://yatv.ru/ru/tv,channels?page=0"
Global Dim Name.s(30),Dim Adres.s(30), Dim Img.s(30)
Procedure.s Utf2Ansi(string.s) ; перевод с Unicode
len_s=Len(string)*2+2
*out = AllocateMemory(len_s)
*out1 = AllocateMemory(len_s)
MultiByteToWideChar_(65001, 0, string, -1, *out, len_s)
WideCharToMultiByte_(#CP_ACP,0,*out,-1,*out1,len_s,0,0)
Text$ = PeekS(*out1 , -1, #PB_Ascii)
FreeMemory(*out)
FreeMemory(*out1)
If Left(Text$, 1)="?" : Text$=LTrim(Text$, "?") : EndIf
ProcedureReturn Text$
EndProcedure
Procedure.s Between_2(string.s, L.s, R.s) ; вырезаем между L-R
Position = FindString(string, L.s, 1)
string2.s = Right(string, Len(string)+1-Position-Len(L.s))
Position2 = FindString(string2, R.s, 1)
string3.s = Left(string2, Position2-1)
If Position <> 0
ProcedureReturn string3.s
EndIf
EndProcedure
Procedure HTML2(HTM.s) ; создание htm файла
DeleteFile("HTML.htm")
If OpenFile(0, "HTML.htm")
FileSeek(0, Lof(0))
WriteString(0,HTM)
CloseFile(0)
EndIf
EndProcedure
Procedure Yatv(url.s) ; парсинг сервиса
URLDownloadToFile_(0,url.s,"yatv.txt",0,0)
If ReadFile(0,"yatv.txt")
While Eof(0) = 0
string.s= ReadString(0)
If FindString(string, "")
Name.s(t) = Between_2(string,"/"+Chr(34)+">","")
t=t+1
EndIf
If FindString(string, Chr(34)+"thumb"+Chr(34)+" style=",1)
string= Utf2Ansi(string.s)
url_img.s =Between_2(string,"(",")")
Img(r)=url_img
r=r+1
EndIf
Wend
CloseFile(0)
EndIf
EndProcedure
Procedure YatvTV(url.s)
URLDownloadToFile_(0,url.s,"yatvTV.txt",0,0)
If ReadFile(0,"yatvTV.txt")
While Eof(0) = 0
string.s= ReadString(0)
If FindString(string, Chr(34)+"application/x-shockwave-flash"+Chr(34),1)
htm.s= "" + #CRLF$
htm = htm + "" + #CRLF$
htm = htm + string
DeleteFile("TV.htm")
If OpenFile(1, "TV.htm")
FileSeek(1, Lof(1))
WriteStringN(1, htm)
CloseFile(1)
EndIf
EndIf
Wend
CloseFile(0)
EndIf
SetGadgetText(#Web,"file://localhost/"+GetPathPart(ProgramFilename())+"TV.htm")
EndProcedure
Procedure UrlToFileImages(*x)
For img=0 To 20
url_img.s=Img(img)
rez= URLDownloadToFile_(0,url_img.s,"img/"+Str(img)+".jpg",0,0)
If rez<0
images.s="фон"
ElseIf rez=0
images.s = Str(img)
EndIf
LoadImage(img,"img/"+images+".jpg")
ResizeImage(img,170,96)
SetGadgetState(img, ImageID(img))
Next
EndProcedure
Procedure Images(d)
SetGadgetText(#Text,"стр: "+Str(d))
url.s = "http://yatv.ru/ru/tv,channels?page="+Str(d)
Yatv(url.s)
For img=0 To 20
images.s = Str(img)
If ReadFile(0, "img/"+Str(img)+".jpg")
If Lof(0) =1293
images ="фон"
EndIf
CloseFile(0)
EndIf
SetGadgetText(30+img,Name(img))
Next
If IsThread(ThreadID)=0
ThreadID=CreateThread(@UrlToFileImages(), 0)
EndIf
EndProcedure
Yatv(url.s)
patch.s = "file://localhost/"+GetPathPart(ProgramFilename())
OpenWindow(#Window_0,0,0,800,420,"Космос TV",#WS_OVERLAPPEDWINDOW|#PB_Window_ScreenCentered|#PB_Window_Invisible)
SetWindowColor(#Window_0,RGB(0,0,0))
ContainerGadget(#Cont,0,10,590,330)
WebGadget(#Web,0,0,650,380,patch+"kosmos.htm")
CloseGadgetList()
ScrollAreaGadget(#Scrol,590,0,250,380,233,2800,80,#PB_ScrollArea_BorderLess)
ImageGadget(777,0,0,315,2800,LoadImage(777,"skrol.jpg")): DisableGadget(777,1)
For img=0 To 20
LoadImage(img,"img/фон.jpg")
ImageGadget(img,10,10+(126*img),207,116,ImageID(img))
HyperLinkGadget(30+img,10,110+(126*img),170,15,Name(img),RGB(253, 2, 2))
SetGadgetColor(30+img,#PB_Gadget_BackColor,RGB(0,0,0))
SetGadgetColor(30+img,#PB_Gadget_FrontColor,RGB(128, 128, 128))
Next
CloseGadgetList()
SetGadgetColor(#Scrol,#PB_Gadget_BackColor,RGB(0,0,0))
HyperLinkGadget(#dep,450,365,30,15,"<<<",RGB(253, 2, 2))
SetGadgetColor(#dep,#PB_Gadget_BackColor,RGB(0,0,0))
SetGadgetColor(#dep,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#nex,550,365,30,15,">>>",RGB(253, 2, 2))
SetGadgetColor(#nex,#PB_Gadget_BackColor,RGB(0,0,0))
SetGadgetColor(#nex,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#kosmos,10,350,70, 12,"Космос TV",RGB(253, 2, 2))
SetGadgetColor(#kosmos,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#kosmos,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#NG,90,350,70, 12,"ЗвездноеТВ",RGB(253, 2, 2))
SetGadgetColor(#NG,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#NG,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#ZD,170,350,70, 12,"ЗадорновТВ",RGB(253, 2, 2))
SetGadgetColor(#ZD,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#ZD,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#Lat_TM,250,350,70, 12,"Латекс ТМ",RGB(253, 2, 2))
SetGadgetColor(#Lat_TM,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#Lat_TM,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#HD_TV_MUSIC,330,350,70, 12,"HD TV MUSIC",RGB(253, 2, 2))
SetGadgetColor(#HD_TV_MUSIC,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#HD_TV_MUSIC,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#p1080,10,375,70, 12,"1080p",RGB(253, 2, 2))
SetGadgetColor(#p1080,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#p1080,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#Disco80x ,90,375,70, 12,"Disco 80x",RGB(253, 2, 2))
SetGadgetColor(#Disco80x ,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#Disco80x ,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#VLS ,170,375,70, 12,"Выж.любой.Ц",RGB(253, 2, 2))
SetGadgetColor(#VLS ,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#VLS ,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#MaskiShow ,250,375,70, 12,"MaskiShow",RGB(253, 2, 2))
SetGadgetColor(#MaskiShow ,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#MaskiShow ,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#CCCR ,330,375,70, 12,"Канал СССР",RGB(253, 2, 2))
SetGadgetColor(#CCCR ,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#CCCR ,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HyperLinkGadget(#Text,490,365,55,15,"стр: 0",RGB(128, 128, 128))
SetGadgetColor(#Text,#PB_Gadget_BackColor,RGB(0, 0, 0))
SetGadgetColor(#Text,#PB_Gadget_FrontColor,RGB(128, 128, 128))
HideWindow(#Window_0, 0)
If IsThread(ThreadID)=0
ThreadID=CreateThread(@UrlToFileImages(), 0)
EndIf
Repeat
Event = WaitWindowEvent()
Gadget = EventGadget()
Select Event
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 30 To 50
YatvTV(Adres(Gadget-30))
SetWindowTitle(#Window_0, GetGadgetText(Gadget))
Case #nex
d=d+1
If d>151
d=151
EndIf
Images(d)
Case #dep
d=d-1
If d<0
d=0
EndIf
Images(d)
Case #kosmos
SetGadgetText(#Web,patch+"kosmos.htm")
SetWindowTitle(#Window_0,"Космос TV")
Case #NG
SetGadgetText(#Web,patch+"ЗвездноеТВ.htm")
SetWindowTitle(#Window_0,"ЗвездноеТВ")
Case #ZD
SetGadgetText(#Web,patch+"ЗадорновТВ.htm")
SetWindowTitle(#Window_0,"ЗадорновТВ")
Case #Lat_TM
SetGadgetText(#Web,patch+"ЛатексТМ.htm")
SetWindowTitle(#Window_0,"Латекс ТМ")
Case #HD_TV_MUSIC
SetGadgetText(#Web,patch+"HD_TV_MUSIC.htm")
SetWindowTitle(#Window_0,"HD TV MUSIC")
Case #p1080
SetGadgetText(#Web,patch+"1080p.htm")
SetWindowTitle(#Window_0,"Кинозал 1080p")
Case #Disco80x
SetGadgetText(#Web,patch+"Disco80x.htm")
SetWindowTitle(#Window_0,"#Disco 80x")
Case #VLS
SetGadgetText(#Web,patch+"Выжить_любой_ценой.htm")
SetWindowTitle(#Window_0,"Выжить любой ценой")
Case #MaskiShow
SetGadgetText(#Web,patch+"MaskiShow.htm")
SetWindowTitle(#Window_0,"Maski Show")
Case #CCCR
SetGadgetText(#Web,patch+"ТелеканалСССР.htm")
SetWindowTitle(#Window_0,"Телеканал СССР")
EndSelect
EndSelect
ForEver
If rez=1
CallFunctionFast(UnLoadSkin)
EndIf
Скачать архив файлов:
По прошествии времени данный код уже не работает...
Забросил html файлы себе на сайт...
Скачать архив файлов: