
Youtube
- Kwai chang caine
- Messages : 6989
- Inscription : sam. 23/sept./2006 18:32
- Localisation : Isere
Bonjour DROOPY
Je viens de rééssayer pour la troisieme fois de copier ton code et de le coller dans l'IDE de pure et c'est toujours pareil
Par contre comme j'avais vu que l'exe marchait chez moi, j'ai eu l'idée (et oui je sais c'est etonnant
) de compiler ton code.
Et la, l'executable obtenu avec le code du debut du POST marche
Si t'y comprend quelque chose
Enfin ce n'est pas grave, c'etait juste pour t'aider, mais si je suis le seul chez qui ça fait ça, perd pas ton temps si precieux.
ça viens surement de chez moi, tu sais les PC sont mis a rude epreuve avec un comique comme moi, j'ai encore du foirer quelque chose
Une autre question ton super prg peut il capturer d'autre sources streaming que youtube ???
Parce que j'ai éssayé avec cette vidéo, mais ça ne marche pas, ce ne doit pas etre le meme format de streaming.
http://www.tetesaclaques.tv/video.php?vid=22
En tout cas pour ceux qui ne connaissent pas ces vidéos jetez un coup d'oeil c'est trop drole
Encore merci pour tout.
Je viens de rééssayer pour la troisieme fois de copier ton code et de le coller dans l'IDE de pure et c'est toujours pareil

Par contre comme j'avais vu que l'exe marchait chez moi, j'ai eu l'idée (et oui je sais c'est etonnant

Et la, l'executable obtenu avec le code du debut du POST marche
Si t'y comprend quelque chose

Enfin ce n'est pas grave, c'etait juste pour t'aider, mais si je suis le seul chez qui ça fait ça, perd pas ton temps si precieux.
ça viens surement de chez moi, tu sais les PC sont mis a rude epreuve avec un comique comme moi, j'ai encore du foirer quelque chose

Une autre question ton super prg peut il capturer d'autre sources streaming que youtube ???
Parce que j'ai éssayé avec cette vidéo, mais ça ne marche pas, ce ne doit pas etre le meme format de streaming.
http://www.tetesaclaques.tv/video.php?vid=22
En tout cas pour ceux qui ne connaissent pas ces vidéos jetez un coup d'oeil c'est trop drole



Encore merci pour tout.
- Kwai chang caine
- Messages : 6989
- Inscription : sam. 23/sept./2006 18:32
- Localisation : Isere
- Kwai chang caine
- Messages : 6989
- Inscription : sam. 23/sept./2006 18:32
- Localisation : Isere
Voici une nouvelle version :
Le gros avantage de cette version est qu'elle permet de télécharger une liste de vidéos.
- Capture des vidéos à capturer par survol des liens
- Bip aigu = Lien capturé / Bip grâve = Lien déjà capturé
- Suppression des liens inutiles par un clic droit
Le gros avantage de cette version est qu'elle permet de télécharger une liste de vidéos.
- Capture des vidéos à capturer par survol des liens
- Bip aigu = Lien capturé / Bip grâve = Lien déjà capturé
- Suppression des liens inutiles par un clic droit
Code : Tout sélectionner
;/ PureBasic 4.10b2 / Droopy 26/07/07
Global DownloadURL.s, DownloadFilename.s, StopDownload, IsDownloading , Path.s
#Title="YouTube Multi-Downloader at "
Enumeration
#Panel
#Web
#ProgressBar
#Liste
#SBar
#Menu
#Download
#Path
EndEnumeration
Procedure.s FileNameConformation(File.s) ; Renvoie un nom de fichier sans les caractères interdits
For n=1 To Len(File)
c.s=Mid(File,n,1)
If FindString(c,"\",1)
Out.s+" "
ElseIf FindString(c,"/",1)
Out.s+" "
ElseIf FindString(c,":",1)
Out.s+" "
ElseIf FindString(c,"?",1)
Out.s+" "
ElseIf FindString(c,"*",1)
Out.s+" "
ElseIf FindString(c,"<",1)
Out.s+" "
ElseIf FindString(c,">",1)
Out.s+" "
ElseIf FindString(c,"|",1)
Out.s+" "
ElseIf FindString(c,Chr(34),1)
Out.s+" "
Else
Out.s+c
EndIf
Next
ProcedureReturn Out
EndProcedure
ProcedureDLL.s Url2Text(Url.s, OpenType.b=1,ProxyAndPort.s="")
; 1 INTERNET_OPEN_TYPE_DIRECT Resolves all host names locally.
; 0 INTERNET_OPEN_TYPE_PRECONFIG Retrieves the proxy Or direct configuration from the registry.
; 4 INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY Retrieves the proxy Or direct configuration from the registry And prevents the use of a startup Microsoft JScript Or Internet Setup (INS) file.
; 3 INTERNET_OPEN_TYPE_PROXY Passes requests To the proxy unless a proxy bypass list is supplied And the name To be resolved bypasses the proxy. In this Case, the function uses INTERNET_OPEN_TYPE_DIRECT.
isLoop.b=1
INET_RELOAD.l = $80000000
hInet.l=0
hURL.l=0
Bytes.l=0
Buffer.s=Space(2048)
RES.s=""
hInet = InternetOpen_("", OpenType, ProxyAndPort, "", 0)
hURL = InternetOpenUrl_(hInet, Url, #Null, 0, INET_RELOAD, 0)
Repeat
InternetReadFile_(hURL,@Buffer, Len(Buffer), @Bytes)
If Bytes = 0
isLoop=0
Else
RES = RES + Left(Buffer, Bytes)
EndIf
Until isLoop=0
InternetCloseHandle_(hURL)
InternetCloseHandle_(hInet)
ProcedureReturn RES
EndProcedure
Procedure.s VideoIdToTitle(id.s)
Source.s=Url2Text("http://www.youtube.com/watch?v="+id)
SetClipboardText(Source)
Chaine.s="<title>YouTube -"
g=FindString(Source,Chaine,1)+Len(Chaine)
d=FindString(Source,"</title>",g)
Titre.s=Mid(Source,g,d-g)
ProcedureReturn Titre
EndProcedure
Procedure DesactiveInterface(Etat)
DisableGadget(#Liste,Etat)
DisableGadget(#Web,Etat)
EndProcedure
Procedure SaveYoutubeVideo(VideoId.s,SaveFile.s) ; 0 = echec / 1 = succes / -1 = annulé
;/ ( Downloader With progress And Status By Joakim L. Christiansen )
Retour=1
IsDownloading+#True
DownloadURL.s = "http://cache.googlevideo.com/get_video?video_id="+VideoId
Protected hInet, hURL, Bytes
Protected BufferLength = 2048, Buffer.s = Space(BufferLength)
Protected Url.s = DownloadURL.s
Protected Fid
Protected CurrentSize, PreviousSize, FileSize, time, BytesPerSecond
Protected Domain.s, String.s, i, BufferLengthWas = BufferLength
Protected hInetCon, hHttpOpenRequest, iretval
hInet = InternetOpen_("Downloader",0,0,0,0)
hURL = InternetOpenUrl_(hInet,Url.s,0,0,$80000000,0)
;Get filesize
Domain.s = StringField(Url.s,3,"/")
hInetCon = InternetConnect_(hInet,Domain.s,80,#Null,#Null,3,0,0)
If hInetCon
hHttpOpenRequest = HttpOpenRequest_(hInetCon,"HEAD",ReplaceString(Url.s,"http://"+Domain.s+"/",""),#Null,#Null,0,$80000000,0)
If hHttpOpenRequest
iretval = HttpSendRequest_(hHttpOpenRequest,#Null,0,0,0)
If iretval
HttpQueryInfo_(hHttpOpenRequest,19,@Buffer.s,@BufferLength,0) ;changes the buffer length
String.s = PeekS(@Buffer.s,BufferLength): BufferLength = BufferLengthWas
If Trim(String.s) = "200"
HttpQueryInfo_(hHttpOpenRequest,22,@Buffer.s,@BufferLength,0)
String.s = PeekS(@Buffer.s,BufferLength): BufferLength = BufferLengthWas
If FindString(String.s,"Content-Length:",1)
i = FindString(String.s,"Content-Length:",1) + Len("Content-Length:")
String.s = Mid(String.s,i,Len(String.s)-i)
FileSize = Val(Trim(String.s))
EndIf
EndIf
EndIf
EndIf
EndIf
;Download file and update status
If hURL
Fid = CreateFile(#PB_Any,SaveFile.s)
If Fid
time = ElapsedMilliseconds()
SetGadgetAttribute(#ProgressBar,#PB_ProgressBar_Maximum,FileSize)
While InternetReadFile_(hURL,@Buffer.s,BufferLength,@Bytes) And Bytes > 0
If StopDownload
Retour=-1 ;/ Download annulé
Break
EndIf
WriteData(Fid,@Buffer.s,Bytes)
CurrentSize + Bytes
SetGadgetState(#ProgressBar,CurrentSize)
StatusBarText(#SBar,0," "+Str(CurrentSize/1024)+"/"+Str(FileSize/1024)+"kb - "+Str(BytesPerSecond/1024)+"kb/s")
If time < ElapsedMilliseconds() - 1000
time = ElapsedMilliseconds()
BytesPerSecond = CurrentSize - PreviousSize
PreviousSize = CurrentSize
EndIf
Wend
CloseFile(Fid)
EndIf
IsDownloading = #False
SetGadgetState(#ProgressBar,0)
If CurrentSize < FileSize
DeleteFile(SaveFile.s)
If Retour=1
Retour=0
EndIf
EndIf
EndIf
InternetCloseHandle_(hURL)
InternetCloseHandle_(hInetCon)
InternetCloseHandle_(hInet)
ProcedureReturn Retour
EndProcedure
Procedure HttpFileSize(Url.s)
hInet = InternetOpen_("Downloader",0,0,0,0)
hURL = InternetOpenUrl_(hInet,Url,0,0,$80000000,0)
BufferLength = 256
Buffer.s = Space(BufferLength)
BufferLengthWas = BufferLength
Domain.s = StringField(Url,3,"/")
hInetCon = InternetConnect_(hInet,Domain,80,#Null,#Null,3,0,0)
If hInetCon
hHttpOpenRequest = HttpOpenRequest_(hInetCon,"HEAD",ReplaceString(Url,"http://"+Domain+"/",""),#Null,#Null,0,$80000000,0)
If hHttpOpenRequest
iretval = HttpSendRequest_(hHttpOpenRequest,#Null,0,0,0)
If iretval
HttpQueryInfo_(hHttpOpenRequest,19,@Buffer,@BufferLength,0)
String.s = PeekS(@Buffer,BufferLength): BufferLength = BufferLengthWas
If Trim(String.s) = "200"
HttpQueryInfo_(hHttpOpenRequest,22,@Buffer,@BufferLength,0)
String.s = PeekS(@Buffer,BufferLength): BufferLength = BufferLengthWas
If FindString(String.s,"Content-Length:",1)
i = FindString(String.s,"Content-Length:",1) + Len("Content-Length:")
String.s = Mid(String.s,i,Len(String.s)-i)
FileSize = Val(Trim(String.s))
EndIf
EndIf
EndIf
EndIf
EndIf
InternetCloseHandle_(hURL)
InternetCloseHandle_(hInetCon)
InternetCloseHandle_(hInet)
ProcedureReturn FileSize
EndProcedure
Procedure Download()
If CountGadgetItems(#Liste)
;/ Retrouve le titre des vidéos
StatusBarText(#SBar,1,"Search Title")
For n=1 To CountGadgetItems(#Liste)
If GetGadgetItemText(#Liste,n-1,1)=""
id.s=GetGadgetItemText(#Liste,n-1,0)
SetGadgetItemText(#Liste,n-1,"Search Title",3)
Titre.s=VideoIdToTitle(id)
SetGadgetItemText(#Liste,n-1,"",3)
SetGadgetItemText(#Liste,n-1,FileNameConformation(Titre),1)
EndIf
If StopDownload
Anulation=#True
Break
EndIf
Next
;/ Retrouve la taille des vidéos
If StopDownload=#False
StatusBarText(#SBar,1,"Search Video Size")
For n=1 To CountGadgetItems(#Liste)
If GetGadgetItemText(#Liste,n-1,2)=""
id.s=GetGadgetItemText(#Liste,n-1,0)
SetGadgetItemText(#Liste,n-1,"Search Size",3)
Size=HttpFileSize("http://cache.googlevideo.com/get_video?video_id="+id)
Size/1024
SetGadgetItemText(#Liste,n-1,Str(Size)+"Kb",2)
SetGadgetItemText(#Liste,n-1,"",3)
EndIf
If StopDownload
Anulation=#True
Break
EndIf
Next
EndIf
If StopDownload=#False
;/ Video Download
For n=1 To CountGadgetItems(#Liste)
If GetGadgetItemText(#Liste,n-1,3)<>"Success"
id.s=GetGadgetItemText(#Liste,n-1,0)
Titre.s=VideoIdToTitle(id)
StatusBarText(#SBar,1,"Downloading "+Titre)
SetGadgetItemText(#Liste,n-1,"Downloading ...",3)
Retour=SaveYoutubeVideo(id,Path+Titre+".flv")
If Retour=1
SetGadgetItemText(#Liste,n-1,"Success",3)
ElseIf Retour=0
SetGadgetItemText(#Liste,n-1,"Fail *****",3)
ElseIf Retour=-1
SetGadgetItemText(#Liste,n-1,"Aborted",3)
EndIf
EndIf
If StopDownload
Anulation=#True
Break
EndIf
Next
EndIf
If Anulation=#False
MessageRequester("","Download terminé")
EndIf
EndIf
DesactiveInterface(#False)
StopDownload=#False
StatusBarText(#SBar,0,"")
StatusBarText(#SBar,1,"")
Debug "-----------"
EndProcedure
#Largeur=1024
#hauteur=700
;/ Lecture du chemin dans le fichier ini
Ini.s=GetPathPart(ProgramFilename())+StringField(GetFilePart(ProgramFilename()),1,".")+".ini"
OpenPreferences(Ini)
Path.s=ReadPreferenceString("Path","c:\")
OpenWindow(0,0,0,#Largeur,#hauteur,#Title+Path,#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))
CreateMenu(#Menu,WindowID(0))
MenuTitle("File")
MenuItem(#Download,"&Download")
PanelGadget(#Panel,10,10,#Largeur-20,#hauteur-60)
AddGadgetItem(#Panel,-1,"YouTube")
WebGadget(#Web,10,10,#Largeur-40,#hauteur-110,"http://www.Youtube.com")
CloseGadgetList()
AddGadgetItem(#Panel,-1,"Download")
ListIconGadget(#Liste,10,10,#Largeur-90,#hauteur-110,"Video Id",100,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
ProgressBarGadget(#ProgressBar,#Largeur-70,10,30,#hauteur-110,0,100,#PB_ProgressBar_Smooth|#PB_ProgressBar_Vertical)
AddGadgetColumn(#Liste,1,"Title",#Largeur-450)
AddGadgetColumn(#Liste,2,"Size",90)
AddGadgetColumn(#Liste,3,"Status",150)
CreateStatusBar(#SBar,WindowID(0))
AddStatusBarField(200)
AddStatusBarField(1000)
SetActiveGadget(#Web)
Repeat
evt=WaitWindowEvent()
Select evt
Case #PB_Event_Menu
Select EventMenu()
Case #Download
;/ Arrêt Download
If IsThread(Tid)
StopDownload=#True
SetMenuItemText(#Menu,#Download,"Download")
Else
;/ Start Download
If CountGadgetItems(#Liste)
SetGadgetState(#Panel,1)
DesactiveInterface(#True)
SetMenuItemText(#Menu,#Download,"Cancel Download")
Tid=CreateThread(@Download(),0)
EndIf
EndIf
Case #Path
temp.s=PathRequester("Backup Video Path",Path)
If temp<>""
Path=temp
SetWindowTitle(0,#Title+Path)
EndIf
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #Web
StatusMessage.s=GetGadgetItemText(#Web,#PB_Web_StatusMessage)
StatusBarText(#SBar,1," "+StatusMessage)
Source.s=GetGadgetItemText(#Web,#PB_Web_HtmlCode)
SetClipboardText(Source)
If Left(StatusMessage,31)="http://www.youtube.com/watch?v="
id.s=StringField(StatusMessage,2,"=")
;/ L'ajoute à la liste uniquement si non présent
Absent=#True
For n=1 To CountGadgetItems(#Liste)
If GetGadgetItemText(#Liste,n-1,0)=id
Absent=#False
EndIf
Next
If Absent
AddGadgetItem(#Liste,-1,id)
beep_(700,15)
Else
beep_(250,25)
EndIf
EndIf
Case #Liste
If EventType()=#PB_EventType_RightClick
RemoveGadgetItem(#Liste,GetGadgetState(#Liste))
EndIf
EndSelect
EndSelect
Until evt = #PB_Event_CloseWindow
WritePreferenceString("Path",Path)
HideWindow(0,#True)
If ThreadID(Tid)
StopDownload=#True
Repeat
sleep_(1)
WindowEvent()
Until ThreadID(Tid)=0
EndIf
-
- Messages : 1500
- Inscription : jeu. 25/mars/2004 11:23
- Localisation : Sophia Antipolis (Nice)
- Contact :
Salut tout le monde,
Etant frustré de ne pas pouvoir downloader de vidéos depuis Dailymotion (qui est beaucoup plus rapide que Youtube en autre) j'ai modifié les sources d'une des premières versions réalisée par Droopy afin de pouvoir aussi télécharger sur ce deuxième site.
Les sources sont disponibles ci-dessous et un zip (contenant les exécutables) est disponible ici.
DailyMotion.pb
Youtube.pb
Functions.pb4
Events.pb4
N'hésitez à faire des remarques
Lionel
EDIT : les codes ont été mis à jour, mais pas le zip (car Free m'a coupé l'accès FTP)
Etant frustré de ne pas pouvoir downloader de vidéos depuis Dailymotion (qui est beaucoup plus rapide que Youtube en autre) j'ai modifié les sources d'une des premières versions réalisée par Droopy afin de pouvoir aussi télécharger sur ce deuxième site.
Les sources sont disponibles ci-dessous et un zip (contenant les exécutables) est disponible ici.
DailyMotion.pb
Code : Tout sélectionner
;/ PureBasic 4.10
#URL_DAILYMOTION = "http://www.dailymotion.com/get/"
#FULLURL_DAILYMOTION = "url=http%3A%2F%2Fwww.dailymotion.com%2Fget%2F"
#HOME_PAGE = "http://www.dailymotion.com/fr/"
#H1 = "<h1 class="+Chr(34)+"nav with_uptitle"+Chr(34)+">"
#E_H1 = "</h1>"
#LEN = 101
IncludeFile "Functions.pb4"
Procedure HexVal(hex.s)
hex = UCase(hex)
taille = Len(hex)
val = 0
For i = 0 To taille-1
nb = 0
car.c = PeekC(@hex+i)
If car <= '9' And car >= '0'
nb = Val(Chr(car))
ElseIf car <= 'F' And car >= 'A'
nb = car + 10 - 'A'
EndIf
val + nb * Pow(16, taille-(i+1))
Next i
ProcedureReturn val
EndProcedure
; *- RéCUPèRE UNE CHAÎNE INCONNUE ENTRE 2 CHAÎNES CONNUES -*
Procedure.s MyMid(Expression.s, sLeft.s, sRight.s, Start.l = 1)
Protected str.s, lPosL, lPosR
lPosL = FindString(Expression, sLeft, Start)
lPosR = FindString(Expression, sRight, lPosL + 1)
If lPosL > 0 And lPosR > 0
str = Mid(Expression, lPosL + Len(sLeft), lPosR - lPosL - Len(sLeft))
Else
str = #NULL$
EndIf
ProcedureReturn str
EndProcedure
; *- FORMATE UNE URL %X -*
Procedure.s GetFormatedUrl(sUrl.s)
Protected str.s, i.l, sValue.s
For i = 1 To Len(sUrl)
sValue = Mid(sUrl, i, 1)
If sValue = "%"
str = str + Chr(HexVal(Mid(sUrl, i + 1, 2)))
i = i + 2
Else
str = str + sValue
EndIf
Next i
ProcedureReturn str
EndProcedure
Procedure.s GetLink()
sRet.s = MyMid(Source$, #FULLURL_DAILYMOTION, "&allowZoom")
If Len(sRet)
url$ = GetFormatedUrl(#URL_DAILYMOTION + sRet)
ProcedureReturn url$
EndIf
EndProcedure
IncludeFile "Events.pb4"
Code : Tout sélectionner
;/ PureBasic 4.10
#URL_YOUTUBE = "http://cache.googlevideo.com/get_video?video_id="
#HOME_PAGE = "http://www.youtube.com"
#H1 = "<H1 id=video_title>"
#E_H1 = "</H1>"
#LEN = 59
IncludeFile "Functions.pb4"
Procedure.s GetLink()
link.s=StringField(GetGadgetText(#Web),2,"=")
ProcedureReturn #URL_YOUTUBE + StringField(link,1,"&")
EndProcedure
IncludeFile "Events.pb4"
Functions.pb4
Code : Tout sélectionner
Global DownloadEnCours, Titre.s, Path.s, VideoUrl$, Source$, Video.s, ProgramName.s
#BLANK = "about:blank"
;{/ dataSection
DataSection
Back:IncludeBinary "back.ico"
Forward:IncludeBinary "forward.ico"
Home:IncludeBinary "home.ico"
Save:IncludeBinary "save.ico"
Chemin:IncludeBinary "Chemin.ico"
EndDataSection
;}
Enumeration
#Web
#ToolBar
#Home
#Back
#Forward
#Chemin
#Save
#StatusBar
EndEnumeration
;{/ Procédures de Gnozal pour extraire source d'une page web
; Gnozal PB3.94
; Get HTML Text In WebGadget
;
; NOT COMPATIBLE WITH FREAK'S WebGadgetExtras.pb
;
Interface IHTMLDocument2_FIXED
QueryInterface(a,b)
AddRef()
Release()
GetTypeInfoCount(a)
GetTypeInfo(a,b,c)
GetIDsOfNames(a,b,c,d,e)
Invoke(a,b,c,d,e,f,g,h)
get_Script(a)
get_all(a)
get_body(a)
get_activeElement(a)
get_images(a)
get_applets(a)
get_links(a)
get_forms(a)
get_anchors(a)
put_title(a)
get_title(a)
get_scripts(a)
put_designMode(a)
get_designMode(a)
get_selection(a)
get_readyState(a)
get_frames(a)
get_embeds(a)
get_plugins(a)
put_alinkColor(a)
get_alinkColor(a)
put_bgColor(a)
get_bgColor(a)
put_fgColor(a)
get_fgColor(a)
put_linkColor(a)
get_linkColor(a)
put_vlinkColor(a)
get_vlinkColor(a)
get_referrer(a)
get_location(a)
get_lastModified(a)
put_URL(a)
get_URL(a)
put_domain(a)
get_domain(a)
put_cookie(a)
get_cookie(a)
put_expando(a)
get_expando(a)
put_charset(a)
get_charset(a)
put_defaultCharset(a)
get_defaultCharset(a)
get_mimeType(a)
get_fileSize(a)
get_fileCreatedDate(a)
get_fileModifiedDate(a)
get_fileUpdatedDate(a)
get_security(a)
get_protocol(a)
get_nameProp(a)
write(a)
writeln(a)
open(a,b1,b2,b3,b4,c1,c2,c3,c4,d1,d2,d3,d4,e)
close()
clear()
queryCommandSupported(a,b)
queryCommandEnabled(a,b)
queryCommandState(a,b)
queryCommandIndeterm(a,b)
queryCommandText(a,b)
queryCommandValue(a,b)
execCommand(a,b,c,d)
execCommandShowHelp(a,b)
createElement(a,b)
put_onhelp(a1,a2,a3,a4)
get_onhelp(a)
put_onclick(a1,a2,a3,a4)
get_onclick(a)
put_ondblclick(a1,a2,a3,a4)
get_ondblclick(a)
put_onkeyup(a1,a2,a3,a4)
get_onkeyup(a)
put_onkeydown(a1,a2,a3,a4)
get_onkeydown(a)
put_onkeypress(a1,a2,a3,a4)
get_onkeypress(a)
put_onmouseup(a1,a2,a3,a4)
get_onmouseup(a)
put_onmousedown(a1,a2,a3,a4)
get_onmousedown(a)
put_onmousemove(a1,a2,a3,a4)
get_onmousemove(a)
put_onmouseout(a1,a2,a3,a4)
get_onmouseout(a)
put_onmouseover(a1,a2,a3,a4)
get_onmouseover(a)
put_onreadystatechange(a1,a2,a3,a4)
get_onreadystatechange(a)
put_onafterupdate(a1,a2,a3,a4)
get_onafterupdate(a)
put_onrowexit(a1,a2,a3,a4)
get_onrowexit(a)
put_onrowenter(a1,a2,a3,a4)
get_onrowenter(a)
put_ondragstart(a1,a2,a3,a4)
get_ondragstart(a)
put_onselectstart(a1,a2,a3,a4)
get_onselectstart(a)
elementFromPoint(a,b,c)
get_parentWindow(a)
get_styleSheets(a)
put_onbeforeupdate(a1,a2,a3,a4)
get_onbeforeupdate(a)
put_onerrorupdate(a1,a2,a3,a4)
get_onerrorupdate(a)
toString(a)
createStyleSheet(a,b,c)
EndInterface
Interface IHTMLElement_FIXED
QueryInterface(a,b)
AddRef()
Release()
GetTypeInfoCount(a)
GetTypeInfo(a,b,c)
GetIDsOfNames(a,b,c,d,e)
Invoke(a,b,c,d,e,f,g,h)
setAttribute(a,b,c)
getAttribute(a,b,c)
removeAttribute(a,b,c)
put_className(a)
get_className(a)
put_id(a)
get_id(a)
get_tagName(a)
get_parentElement(a)
get_style(a)
put_onhelp(a1,a2,a3,a4)
get_onhelp(a)
put_onclick(a1,a2,a3,a4)
get_onclick(a)
put_ondblclick(a1,a2,a3,a4)
get_ondblclick(a)
put_onkeydown(a1,a2,a3,a4)
get_onkeydown(a)
put_onkeyup(a1,a2,a3,a4)
get_onkeyup(a)
put_onkeypress(a1,a2,a3,a4)
get_onkeypress(a)
put_onmouseout(a1,a2,a3,a4)
get_onmouseout(a)
put_onmouseover(a1,a2,a3,a4)
get_onmouseover(a)
put_onmousemove(a1,a2,a3,a4)
get_onmousemove(a)
put_onmousedown(a1,a2,a3,a4)
get_onmousedown(a)
put_onmouseup(a1,a2,a3,a4)
get_onmouseup(a)
get_document(a)
put_title(a)
get_title(a)
put_language(a)
get_language(a)
put_onselectstart(a1,a2,a3,a4)
get_onselectstart(a)
scrollIntoView(a)
contains(a,b)
get_sourceIndex(a)
get_recordNumber(a)
put_lang(a)
get_lang(a)
get_offsetLeft(a)
get_offsetTop(a)
get_offsetWidth(a)
get_offsetHeight(a)
get_offsetParent(a)
put_innerHTML(a)
get_innerHTML(a)
put_innerText(a)
get_innerText(a)
put_outerHTML(a)
get_outerHTML(a)
put_outerText(a)
get_outerText(a)
insertAdjacentHTML(a,b)
insertAdjacentText(a,b)
get_parentTextEdit(a)
get_isTextEdit(a)
click()
get_filters(a)
put_ondragstart(a1,a2,a3,a4)
get_ondragstart(a)
toString(a)
put_onbeforeupdate(a1,a2,a3,a4)
get_onbeforeupdate(a)
put_onafterupdate(a1,a2,a3,a4)
get_onafterupdate(a)
put_onerrorupdate(a1,a2,a3,a4)
get_onerrorupdate(a)
put_onrowexit(a1,a2,a3,a4)
get_onrowexit(a)
put_onrowenter(a1,a2,a3,a4)
get_onrowenter(a)
put_ondatasetchanged(a1,a2,a3,a4)
get_ondatasetchanged(a)
put_ondataavailable(a1,a2,a3,a4)
get_ondataavailable(a)
put_ondatasetcomplete(a1,a2,a3,a4)
get_ondatasetcomplete(a)
put_onfilterchange(a1,a2,a3,a4)
get_onfilterchange(a)
get_children(a)
get_all(a)
EndInterface
;
Procedure.l GetBSTRLength(bstr)
length = WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, 0, 0, 0, 0)
ProcedureReturn length
EndProcedure
;
Procedure.l ReadBSTRMem(*Buffer, bstr, length)
length = WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, *Buffer, length, 0, 0)
ProcedureReturn length
EndProcedure
;
Procedure.s WebGadget_GextHTMLText(WebGadget.l)
Protected WebObject.IWebBrowser2, HTMLDoc.IHTMLDocument2_FIXED, DocDispatch.IDispatch, HTMLElement.IHTMLElement_FIXED
WebObject = GetWindowLong_(GadgetID(WebGadget), #GWL_USERDATA)
If WebObject\get_document(@DocDispatch) = #S_OK
If DocDispatch\QueryInterface(?IID_IHTMLDocument2, @HTMLDoc) = #S_OK
If HTMLDoc\get_body(@HTMLElement) = #S_OK
If HTMLElement
If HTMLElement\get_innerHTML(@bstr_code) = #S_OK
bstr_len = GetBSTRLength(bstr_code)
If bstr_len
*Buffer = AllocateMemory(bstr_len)
If *Buffer
If ReadBSTRMem(*Buffer, bstr_code, bstr_len) ; Get HTML code in *Buffer
retour.s= PeekS(*Buffer) ; [warning string size limitation, better use memory functions !]
EndIf
FreeMemory(*Buffer)
EndIf
EndIf
SysFreeString_(bstr_code)
EndIf
EndIf
EndIf
DocDispatch\Release()
EndIf
EndIf
ProcedureReturn retour
EndProcedure
DataSection
IID_IHTMLDocument2: ; {332C4425-26CB-11D0-B483-00C04FD90119}
Data.l $332C4425
Data.w $26CB, $11D0
Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
EndDataSection
;}
Procedure.s ConformationNom(Nom.s) ; Renvoie un nom de fichier sans les caractères interdits
For n=1 To Len(Nom)
c.s=Mid(Nom,n,1)
; If FindString(c,"\/:?*<>|"+Chr(34),1)
If FindString(c,"\",1)
Out.s+" "
ElseIf FindString(c,"/",1)
Out.s+" "
ElseIf FindString(c,":",1)
Out.s+" "
ElseIf FindString(c,"?",1)
Out.s+" "
ElseIf FindString(c,"*",1)
Out.s+" "
ElseIf FindString(c,"<",1)
Out.s+" "
ElseIf FindString(c,">",1)
Out.s+" "
ElseIf FindString(c,"|",1)
Out.s+" "
ElseIf FindString(c,Chr(34),1)
Out.s+" "
Else
Out.s+c
EndIf
Next
ProcedureReturn Out
EndProcedure
Procedure DesactiveInterface(etat.l)
DisableGadget(#Web,etat)
DisableToolBarButton(#ToolBar,#Home,etat)
DisableToolBarButton(#ToolBar,#Back,etat)
DisableToolBarButton(#ToolBar,#Forward,etat)
DisableToolBarButton(#ToolBar,#Save,etat)
DownloadEnCours = etat
EndProcedure
Procedure ResizeWebBrowser()
ResizeGadget(#Web, 5, 30, WindowWidth(0)-10, WindowHeight(0)-50)
EndProcedure
Procedure BuildWindow()
OpenWindow(0,0,0,820,660,ProgramName + " - FLV Video Download Program",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget)
CreateGadgetList(WindowID(0))
WebGadget(#Web,0,0, 10,10, #HOME_PAGE)
ResizeGadget(#Web, 10, 30, WindowWidth(0)-20, WindowHeight(0)-60)
If CreateToolBar(#ToolBar,WindowID(0))
ToolBarImageButton(#Home,ImageID(CatchImage(#PB_Any,?Home)))
ToolBarToolTip(#ToolBar,#Home,"www.Youtube.com")
ToolBarImageButton(#Back,ImageID(CatchImage(#PB_Any,?Back)))
ToolBarImageButton(#Forward,ImageID(CatchImage(#PB_Any,?Forward)))
ToolBarSeparator()
ToolBarImageButton(#Chemin,ImageID(CatchImage(#PB_Any,?Chemin)))
ToolBarToolTip(#ToolBar,#Save,"Chemin de sauvegarde des vidéos")
ToolBarSeparator()
ToolBarImageButton(#Save,ImageID(CatchImage(#PB_Any,?Save)))
ToolBarToolTip(#ToolBar,#Home,"Télécharger")
EndIf
If CreateStatusBar(#StatusBar,WindowID(0))
AddStatusBarField(100)
AddStatusBarField(924)
EndIf
EndProcedure
Procedure.s SizeToStr(octets.l)
If octets<1
ProcedureReturn "0 octet"
EndIf
size.f = octets
strSize$ = " o"
If size > 1024
size / 1024
strSize$ = " Ko"
If size > 1024
size / 1024
strSize$ = " Mo"
If size > 1024
size / 1024
strSize$ = " Go"
EndIf
EndIf
EndIf
ProcedureReturn StrF(size,1)+strSize$
EndProcedure
Procedure SaveFLVVideo(Url.s)
size = FileSize(Video)
If size >= 0
rep = MessageRequester("Succès","Un fichier '"+Video+"' ("+SizeToStr(size)+") existe déjà!"+#CRLF$+"Choisir un nouveau nom de fichier ?",#MB_ICONWARNING|#PB_MessageRequester_YesNoCancel)
If rep = #PB_MessageRequester_Yes
Video = SaveFileRequester("Choisir un emplacement pour '"+Titre+"'", Video, "Flash Video(*.FLV)|*.flv", 0)
If Video = #NULL$
ProcedureReturn
EndIf
ElseIf rep = #PB_MessageRequester_No
DeleteFile(Video)
Else
ProcedureReturn
EndIf
EndIf
DesactiveInterface(#True)
ret=URLDownloadToFile_(0, Url, Video, 0, 0)
If ret=0 ; Succès téléchargement
MessageRequester(ProgramName, "Téléchargement terminé."+#CRLF$+"Total : "+SizeToStr(FileSize(Video)),#MB_ICONINFORMATION)
Else
MessageRequester(ProgramName,"Téléchargement impossible !",#MB_ICONERROR)
EndIf
DesactiveInterface(#False)
EndProcedure
Procedure UpdateStatusBar_StatePage(isReady)
Protected message$
Select isReady
Case 1 : message$ = "Chargement"
Case 2 : message$ = "Page chargée"
Case 3 : message$ = "Page inactive"
Case 4 : message$ = "Page chargée"
EndSelect
StatusBarText(#StatusBar, 0, message$)
EndProcedure
Procedure UpdateStatusBar_PageName(isReady)
Protected message$
If DownloadEnCours
message$ = "Téléchargement vers : '"+Video+"'"
Else
Select isReady
Case 4 : message$ = GetGadgetText(#Web)
Default : message$ = "Chargement de : "+GetGadgetText(#Web)
EndSelect
EndIf
StatusBarText(#StatusBar, 1, message$)
EndProcedure
Events.pb4
Code : Tout sélectionner
ProgramName = StringField(GetFilePart(ProgramFilename()),1,".")
Ini.s=GetPathPart(ProgramFilename())+ProgramName+".ini"
OpenPreferences(Ini)
Path.s=ReadPreferenceString("Path","c:\")
ClosePreferences()
BuildWindow()
WebObject.IWebBrowser2 = GetWindowLong_(GadgetID(#Web), #GWL_USERDATA)
Repeat
evt=WaitWindowEvent()
If isBusy > 1
WebObject\get_ReadyState(@isReady)
EndIf
If isReady <> isReady_old Or DownloadEnCours <> DownloadEnCours_old
UpdateStatusBar_StatePage(isReady)
UpdateStatusBar_PageName(isReady)
isReady_old = isReady
DownloadEnCours_old = DownloadEnCours
EndIf
If isReady = 4
If Url.s<>GetGadgetText(#Web)
Url=GetGadgetText(#Web)
Source$ = WebGadget_GextHTMLText(#Web) ; Extrait la source depuis la page web en cours
VideoUrl$ = GetLink()
EndIf
EndIf
Select evt
Case #PB_Event_SizeWindow
ResizeWebBrowser()
Case #PB_Event_Menu
Select EventMenu()
Case #Home
SetGadgetText(#Web, #HOME_PAGE)
Case #Back
SetGadgetState(#Web,#PB_Web_Back)
Case #Forward
SetGadgetState(#Web,#PB_Web_Forward)
Case #Chemin
temp.s=PathRequester("Chemin de sauvegarder des vidéos",Path)
If temp<>""
Path=temp
EndIf
Case #Save
If isReady > 1
If Len(VideoUrl$)=#LEN And DownloadEnCours=#False
; Extrait le titre
g=FindString(LCase(Source$), LCase(#H1), 1)+Len(#H1)
d=FindString(LCase(Source$), LCase(#E_H1), g)
Titre.s = Mid(Source$,g,d-g)
Titre = ConformationNom(Titre)
;MessageRequester("Début du téléchargement...","Sauvegarde de ,#MB_ICONINFORMATION)
;Debug VideoUrl$
Video= Path+Titre+".flv"
CreateThread(@SaveFLVVideo(),VideoUrl$)
Else
Beep_(300,100)
EndIf
EndIf
EndSelect
EndSelect
WebObject\get_busy(@isBusy)
Until evt=#PB_Event_CloseWindow
OpenPreferences(Ini)
WritePreferenceString("Path",Path)
ClosePreferences()
Lionel

EDIT : les codes ont été mis à jour, mais pas le zip (car Free m'a coupé l'accès FTP)
Webmestre de Basic-univers
Participez à son extension: ajouter vos programmes et partagez vos codes !
Participez à son extension: ajouter vos programmes et partagez vos codes !