Просмотров: 33438 | Дата: 04.07.2022 | Коментарии (0)

Онлайн TV




Онлайновый просмотр телевизионных каналов.
Программа основана на парсинге сервиса www.guzei.com.
Для предания внешнего вида окну, применена библиотека SkinFeature.dll
Так, как библиотека не работает в режиме Unicode, применена процедура Utf2Ansi() для преобразования текста.
Если не применять SkinFeature.dll, то и Utf2Ansi() - не нужна.

Скачать архив файлов 

PS. Из за наличия html тегов в коде, PB код на странице отображается не корректно.

; Последнее изменение:3 Апрель, 2011 @ 5:41:44 PM
;===========================Стиль окна Dark Soft==============================================
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
 #Container
 #List
 #Web
 #But:#But2:#Text
 #Image:#fon
EndEnumeration
UsePNGImageDecoder()
Global Dim Name.s(100),Dim Adres.s(100)

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
SetGadgetText(#Web,"file://localhost/"+GetPathPart(ProgramFilename())+"HTML.htm")
EndProcedure

Procedure Guzei(url.s) ; парсинг сервиса www.guzei.com
ClearGadgetItems(#List)
URLDownloadToFile_(0,url.s,"guzei.txt",0,0)
 If ReadFile(0,"guzei.txt")
 While Eof(0) = 0 
 string.s= ReadString(0)
 ;--------------Имя канала--------------------------------------------
 CreateRegularExpression(0,"(?<=()name"+Chr(34)+">)\S(.*?)(?=()/span)",#PB_RegularExpression_DotAll)
 Name.i = ExtractRegularExpression(0,String.s,Name())
 For i = 0 To (Name - 1)
 AddGadgetItem(#List,-1,Utf2Ansi(RemoveString(Name(i), "<")),0)
 Next
 FreeRegularExpression(0)
 ;--------------Адрес канала------------------------------------------
 CreateRegularExpression(0,"(?<=()watch.php)\S(.*?)(?=()"+Chr(34)+")",#PB_RegularExpression_DotAll)
 Adres.i = ExtractRegularExpression(0,String.s,Adres())
 FreeRegularExpression(0)
 Wend 
 CloseFile(0)
 EndIf
EndProcedure

Procedure TV(url.s) ;парсинг странисы выбранного канала
URLDownloadToFile_(0,url.s,"TV.txt",0,0)
 If ReadFile(0,"TV.txt")
 While Eof(0) = 0 
 string.s= ReadString(0)
 HTML.s= Between_2(string,"")
 If HTML <>""
 HTM.s= "
" EndIf Wend CloseFile(0) HTML2(HTM.s) EndIf EndProcedure p=1 ;номер страницы CatchImage(#fon, ?Im0, ?Im0End -?Im0) ;фон OpenWindow(#Window_0,0,0,388,580,"www.guzei.com",#PB_Window_MinimizeGadget|#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible) ;#CRLF$ SetWinBackgroundColor(WindowID(#Window_0),RGB(16, 16, 16)) ;****************************************************************** ListIconGadget(#List,7,328,360,200,"List of Russian-language channels",0) AddGadgetColumn(#List,0, "List of Russian-language channels",200) SetGadgetColor(#List, #PB_Gadget_BackColor, RGB(16, 16, 16)) SetGadgetColor(#List, #PB_Gadget_FrontColor,RGB(112, 112, 112)) ;SetWindowLongPtr_(GadgetID(#List),#GWL_STYLE,#WS_CHILD|#WS_VISIBLE) ;****************************************************************** ImageGadget(#Image,8,8,360,310,ImageID(#fon)) ContainerGadget(#Container,-1008,8,360,310,0) WebGadget(#Web,0,0,450,350,"") ;file://localhost/"+GetPathPart(ProgramFilename())+"HTML.htm CloseGadgetList() ;****************************************************************** ButtonGadget(#But,30,534,130,20,"<<<") TextGadget(#Text,175,537,30,15,"1",#PB_Text_Center) ButtonGadget(#But2,220,534,130,20,">>>") ;****************************************************************** GadgetToolTip(#Image, "Перейти на: www.guzei.com/online_tv") GadgetToolTip(#List, "Выбор канала") ;****************************************************************** Guzei("http://www.guzei.com/online_tv/") ;****************************************************************** HideWindow(#Window_0, 0) Repeat Event = WaitWindowEvent() If Event = #WM_RBUTTONDOWN min = min ! 1 If min ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,394,373) Else ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,394,610) EndIf EndIf Select Event Case #PB_Event_Gadget Select EventGadget() Case #List Spisok=GetGadgetState(#List) If EventType()=#PB_EventType_LeftDoubleClick And Spisok <>-1 MessageBeep(#MB_ICONASTERISK) ; вывод системного звука TV("http://www.guzei.com/online_tv/watch.php"+Adres(Spisok)) SetWindowTitle(#Window_0,GetGadgetText(#List)) ResizeGadget(#Container,8,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Image,-1008,#PB_Ignore,#PB_Ignore,#PB_Ignore) EndIf Case #But p=p-1 If p<1 p=1 EndIf SetGadgetText(#Text,Str(p)) Guzei("http://www.guzei.com/online_tv/?p="+Str(p)) Case #But2 p=p+1 If p>15 p=15 EndIf SetGadgetText(#Text,Str(p)) Guzei("http://www.guzei.com/online_tv/?p="+Str(p)) Case #Image If EventType()=#PB_EventType_LeftDoubleClick RunProgram("http://www.guzei.com/online_tv/") EndIf EndSelect EndSelect If Event = #PB_Event_CloseWindow Break EndIf ForEver DataSection Im0: IncludeBinary "logo2.png" Im0End: EndDataSection If rez=1 CallFunctionFast(UnLoadSkin) EndIf ;












Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.