PureBasic

Je viens d'installer la 4.10 beta 2 et n'ai remarqué aucun soucis

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 ne capture pas la vidéo en streaming, mais la vidéo en cache chez google

Délire les vidéos !!! Ah, ces canadiens. Excellent leur accent. La pub du 'Body Toner' parodie bien le TV Shopping.

(Pardon Droopy, je fais un peu de hors sujet, désolé)

@ DROOPY

Ah d'accord

En tout cas il est quand meme genial ton code (Comme dab)

Et pour l'histoire du compilateur t'as une idée ??

Kwai chang caine a écrit :Et pour l'histoire du compilateur t'as une idée ??

Non aucune

J'ai modifié le code qui maintenant :

- Affiche une barre de progression
- Permet de stopper le téléchargement
- Indique la taille de la vidéo / débit

Nouvelle version dispo

Nikel de mieux en mieux.
Et en plus tu va rire, maintenant ça marche avec l'interpreteur.

C'est du PureMystere

Enfin, on va pas se plaindre, l'important c'est que ça marche.

Pour info, apparement le ZIP n'est pas accessible en ce moment.

Merci pour tout DROOPY

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

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

@Droopy: tu t'amuse bien a ce que je vois

Dobro a écrit :@Droopy: tu t'amuse bien a ce que je vois

Oui c'est un peu calme au taf en ce moment

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

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"

Youtube.pb

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()

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)