Visual Basic Foro

Programación => Visual Basic 6 => Mensaje iniciado por: Juan Luis López en Julio 25, 2011, 01:17:31 pm

Título: Cinetube Series Downloader
Publicado por: Juan Luis López en Julio 25, 2011, 01:17:31 pm

Hola a todos!
Aqui os dejo un programa que he hecho para conseguir los links de megaupload de series en cinetube.
http://www.megaupload.com/?d=3M2BCNCY
Me gustaria saber si alguien sabria como hacer que el programa sea el que descarga los archivos esque no se me ocurre como pero de momento lo que se puede hacer es añadir los links a jdownloader una vez conseguidos.

[youtube]http://www.youtube.com/watch?v=Ha5UhNVqs0Q[/youtube]
Saludos!!

Título: Re:Cinetube Series Downloader
Publicado por: xkiz ™ en Julio 25, 2011, 02:02:10 pm

mmmm esta buena la idea, pero para series es....  para las TV-Series yo te recomendaria hacerlo mediante torrent, envez del jDownloader usando como base EZTV, aunke ya esta todo tan automatizado, que............ yo veria la forma de hacer lo mismo, pero con peliculas 1080p 720p etc.....

Título: Re:Cinetube Series Downloader
Publicado por: E N T E R en Julio 25, 2011, 04:57:59 pm

Que bueno esta, y el source  :'( para chusmear un poco

Título: Re:Cinetube Series Downloader
Publicado por: Juan Luis López en Julio 26, 2011, 09:08:21 am

Cinetube.bas

Código: [Seleccionar]

Option Explicit
'Apis Windows
Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

'Tipo donde para cada serie se guardaran los datos de nombre URL y la url de la imagen
Public Type Serie
    Nombre As String
    url As String
    ImagenURL As String
End Type
'Direcciones que usa la API
Const CTURL As String = "http://www.cinetube.es/series/"       'URL de cinetube
Const CTSearchURL As String = "http://www.cinetube.es/buscar/series/?palabra=" 'URL de la pagina de busqueda de cinetube
'Matriz donde guardaremos los datos de las series en formato Type Serie
Public MatSeries() As Serie

Public Sub BuscarSerie(Serie As String)
    Dim Data As String
    Data = HTML(CTSearchURL & Serie)
    Data = Between(Data, "<ul class=" & Chr(34) & "ver_series_list" & Chr(34) & ">", "</ul>")
    CargarMatSeries Data, "<li>", "</li>"
End Sub

'*******************************************
'Grupo de funciones para que funcione la API
'*******************************************
'Carga la matriz de series
Public Sub CargarMatSeries(RawData As String, StartString As String, EndString As String)
    Erase MatSeries()
    Dim Comienzo As Long
    Dim Final As Long
    Dim Mydata As String
    Dim Contador As Integer
    Comienzo = 1
    On Error GoTo Salir
    While Comienzo <> 0
        Comienzo = InStr(Comienzo, RawData, StartString)
        Final = InStr(Comienzo, RawData, EndString)
        Contador = Contador + 1
        Mydata = Mid(RawData, Comienzo + Len(StartString), Final - Comienzo - Len(StartString))
        '
        ReDim Preserve MatSeries(1 To Contador)
        MatSeries(Contador).url = CTURL & Between(Mydata, "/series/", "/")
        MatSeries(Contador).ImagenURL = Between(Mydata, "src=" & Chr(34), Chr(34))
        MatSeries(Contador).Nombre = Between(Mydata, "tit_ficha" & Chr(34) & ">", " <")
        '
        Mydata = ""
        Comienzo = Final
    Wend
   
Salir:
    Exit Sub
End Sub

'Rellena un listView con los datos de las series cargados en Matseries()
Public Sub MostrarSeriesLV(ListView As ListView)
   'Vaciamos el listview
   ListView.ListItems.Clear
   On Error GoTo Salix
   'Si resulta que no tenemos elemntos en Matseries es que la busqueda no dio resultados y añadiremos "No se encontraron Resultados)
   Dim n As Long
   For n = 1 To UBound(MatSeries)
        ListView.ListItems.Add , , AntiAcute(MatSeries(n).Nombre)
        ListView.Enabled = True
   Next n
   Exit Sub
Salix:
   ListView.ListItems.Add , , "No se encontraron resultados..."
   ListView.Enabled = False
   Form1.txtTemporada.Enabled = False
   Form1.TxtLinks.Text = ""
   Form1.LblCopy.Enabled = False
End Sub

'Descarga la imagen de la serie y la coloca en un picturebox
Public Sub PutImage(ImageUrl As String, Picturebox As Picturebox)
    Picturebox.ScaleMode = vbPixels
    Picturebox.ScaleWidth = 170
    Picturebox.ScaleHeight = 262
    URLDownloadToFile 0, ImageUrl, App.Path & "\tmp.jpg", 0, 0
    Picturebox.Picture = LoadPicture(App.Path & "\tmp.jpg")
End Sub
'Guarda en un string la descripcion de la serie determinada por URL
Public Function GetSerieDescription(url As String) As String
Dim RawData As String
RawData = HTML(url & "/")
RawData = Between(RawData, "Ficha de la serie", "</p>")
RawData = RawData & "#"
RawData = Between(RawData, "<p>", "#")
GetSerieDescription = AntiAcute(RawData)
End Function

Public Function AntiAcute(Data As String) As String
Data = Replace(Data, "&aacute;", "á")
Data = Replace(Data, "&eacute;", "é")
Data = Replace(Data, "&iacute;", "í")
Data = Replace(Data, "&oacute;", "ó")
Data = Replace(Data, "&uacute;", "ú")
Data = Replace(Data, "&Aacute;", "Á")
Data = Replace(Data, "&Eacute;", "É")
Data = Replace(Data, "&Iacute;", "Í")
Data = Replace(Data, "&Oacute;", "Ó")
Data = Replace(Data, "&Uacute;", "Ú")
Data = Replace(Data, "&ntilde;", "ñ")
Data = Replace(Data, "&Ntilde;", "Ñ")
Data = Replace(Data, "quot;", Chr(34))
AntiAcute = Data
End Function
Public Function GetTemporadas(url As String) As Integer
    'De la pagina de una serie extrae el numero de temporadas que tiene
    'URL : cinetube.es/series/titulo-de-la-serie/
    Dim Comienzo As Long
    Dim Final As Long
    Dim Mydata As String
    Dim Contador As Integer
    Comienzo = 1
    Dim StartString As String
    Dim EndString As String
    StartString = "Temporada "
    EndString = "<"
    Dim RawData As String
    RawData = HTML(url & "/")
    Debug.Print RawData
    On Error GoTo Salir
   
    While Comienzo <> 0
        Comienzo = InStr(Comienzo, RawData, StartString)
        Final = InStr(Comienzo, RawData, EndString)
        Contador = Contador + 1
        Mydata = Mid(RawData, Comienzo + Len(StartString), Final - Comienzo - Len(StartString))
        '
        GetTemporadas = Val(Mydata)
        '
        Mydata = ""
        Comienzo = Final
    Wend
   
Salir:
    Exit Function
End Function

Public Function GetDownloadLink(url As String, Temporada As Integer, Capitulo As Integer) As String
    'Extrae el link de descarga del capitulo
    'URL : cinetube.es/series/titulo-de-la-serie/temporada-x/capitulo-x/
    Dim RawData As String
    RawData = HTML(url & "/temporada-" & Temporada & "/capitulo-" & Capitulo & "/")
    RawData = Between(RawData, "v_online v_des", "html")
    RawData = Between(RawData, "href=" & Chr(34), ".")
    RawData = HTML("http://cinetube.es" & RawData & ".html")
    RawData = Between(RawData, "xrxa(", ")+")
    RawData = Between(RawData, "xrxa(" & Chr(34), Chr(34))
    RawData = Reverse(RawData)
    GetDownloadLink = RawData
    DoEvents
End Function

Public Function Reverse(Cadena As String) As String
Dim n As Integer
For n = Len(Cadena) To 1 Step -1
Reverse = Reverse & Mid(Cadena, n, 1)
Next n
End Function

Public Sub GetAllDownloadLinks(url As String, Temporada As Integer, LV As ListView)
Dim n As Integer
Dim link As String
For n = 1 To GetCapitulos(url, Temporada)
link = GetDownloadLink(url, Temporada, n)
    If link <> "" Then
    'LV.ListItems.Add , , GetDownloadLink(url, Temporada, n)
    Dim subelemento As ListItem
    Set subelemento = LV.ListItems.Add(, , link)
    'Encabezado Filename
    subelemento.SubItems(1) = GetMegaFileInfo(link).FileName
    End If
    DoEvents
    Form1.LblStatus.Caption = "Recopilando..."
    Form1.LblCopy.Enabled = False
Next n
Form1.LblStatus.Caption = "Terminado"
Form1.LblCopy.Enabled = True
End Sub
Public Function GetCapitulos(url As String, Temporada As Integer) As Integer
    'De la pagina de una temporada extrae el numero de capitulos que tiene
    'URL : cinetube.es/series/titulo-de-la-serie/temporada-x/
    Dim Comienzo As Long
    Dim Final As Long
    Dim Mydata As String
    Dim Contador As Integer
    Comienzo = 1
    Dim StartString As String
    Dim EndString As String
    StartString = "Ver ficha del capítulo"
    EndString = "<"
    Dim RawData As String
    RawData = HTML(url & "/temporada-" & Temporada & "/")
    Debug.Print RawData
    On Error GoTo Salir
   
    While Comienzo <> 0
        Comienzo = InStr(Comienzo, RawData, StartString)
        Final = InStr(Comienzo, RawData, EndString)
        Contador = Contador + 1
        Mydata = Mid(RawData, Comienzo + Len(StartString), Final - Comienzo - Len(StartString))
        '
        GetCapitulos = Val(Mydata)
        '
        Mydata = ""
        Comienzo = Final
    Wend
   
Salir:
    Exit Function
End Function

Megaupload.bas

Código: [Seleccionar]

Option Explicit
Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Public Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000
Public Type MegaFileInfo
FileName As String
FileSize As String
FileDescription As String
FileDirectDownloadURL As String
End Type

Public Function GetHTML(hURL As String, Optional hUserAgent As String = "Mozilla Firefox") As String
    ' // Función para descargar cualquier tipo de documento o texto de internet utilizando wininet.
    Dim hInternet    As Long
    Dim hFile        As Long
    Dim hBuffer      As String * 1000
    Dim hRead        As Long
 
    hInternet = InternetOpen(hUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
        If hInternet <> 0 Then
            hFile = InternetOpenUrl(hInternet, hURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
                 If hFile <> 0 Then
                    Do
                       Call InternetReadFile(hFile, hBuffer, 1000, hRead)
                       GetHTML = GetHTML & Left$(hBuffer, hRead)
                       If hRead = 0 Then Exit Do
                       DoEvents
                    Loop
                 End If
        End If
        If hInternet <> 0 Then Call InternetCloseHandle(hInternet)
        If hFile <> 0 Then Call InternetCloseHandle(hFile)
End Function
Public Function Text_Between_Words(Text As String, String1 As String, String2 As String) As String
    Dim Pos1 As Long, Pos2 As Long, Start As Long
    Pos1 = InStr(Text, String1)
    If Pos1 <> 0 Then Start = Pos1 + Len(String1): Pos2 = InStr(Start, Text, String2) Else Exit Function
    If Pos2 <> 0 Then Text_Between_Words = Mid$(Text, Start, Pos2 - Start)
End Function
'##################################################################################################
Public Function GetMegaFileInfo(url As String) As MegaFileInfo
On Error GoTo NoFile
Dim RawData As String
     RawData = GetHTML(url)
     GetMegaFileInfo.FileDirectDownloadURL = Text_Between_Words(RawData, "downloadlink" & Chr(34) & "><a href=" & Chr(34), Chr(34))
     RawData = Text_Between_Words(RawData, "down_txt2", "</div>")
     GetMegaFileInfo.FileName = Text_Between_Words(RawData, ">", "<")
     GetMegaFileInfo.FileDescription = Trim(Text_Between_Words(RawData, "</strong>", "<br />"))
     Dim n As Long
     n = InStr(1, RawData, GetMegaFileInfo.FileDescription) + Len(GetMegaFileInfo.FileDescription)
     RawData = Mid(RawData, n, Len(RawData) - n)
     GetMegaFileInfo.FileSize = Trim(Text_Between_Words(RawData, "</strong>", "<br />"))
     Exit Function
NoFile:
     GetMegaFileInfo.FileName = "No se encontró el archivo"
End Function

Public Sub DownloadFile(url As String, Nombre As String)
URLDownloadToFile 0, url, Nombre, 0, 0
End Sub

Este para descargar code HTML de una WEb

Código: [Seleccionar]

Option Explicit

Public Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Public Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000

Public Function HTML(hURL As String, Optional hUserAgent As String = "Mozilla Firefox") As String
    ' // Función para descargar cualquier tipo de documento o texto de internet utilizando wininet.
    Dim hInternet    As Long
    Dim hFile        As Long
    Dim hBuffer      As String * 1000
    Dim hRead        As Long
 
    hInternet = InternetOpen(hUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
        If hInternet <> 0 Then
            hFile = InternetOpenUrl(hInternet, hURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
                 If hFile <> 0 Then
                    Do
                       Call InternetReadFile(hFile, hBuffer, 1000, hRead)
                       HTML = HTML & Left$(hBuffer, hRead)
                       If hRead = 0 Then Exit Do
                       DoEvents
                    Loop
                 End If
        End If
        If hInternet <> 0 Then Call InternetCloseHandle(hInternet)
        If hFile <> 0 Then Call InternetCloseHandle(hFile)
End Function

Tambien usa text_between_words()

Saludos!!