Je suis entrain de me casser la tête pour extraire et télécharger une vidéo de youtube par un script VBS !
Bon, j'ai pu extraire le lien, mais le problème que lors du téléchargement, par powershell de ce dernier, je reçois toujours une réponse du serveur "403 Interdit"
Voici le code en question : YouTube_Downloader.vbs
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
Option Explicit
Dim Title,Converter,Youtube_URL,SourceCode,Videos,Video,ws,Download_Command,FileName,DEST,Temp
Title = "Youtube Downloader by Hackoo 2018"
Youtube_URL = InputBox("Veuillez saisir le lien de Youtube pour la conversion en lien direct et le télécharger" & vbcrlf & vbcrlf &_
"Please enter Youtube link for conversion to direct link and download it",Title,"https://www.youtube.com/watch?v=IJHPpTYtIqk")
If Youtube_URL = "" Then Wscript.Quit(1)
Converter="https://www.tubeoffline.to/downloadFrom.php?host=OnLine&video="&Youtube_URL
SourceCode = GetSourceCode(Converter)
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Videos = Extracting_Videos(SourceCode)
FileName = "Balti.mp4"
DEST = Temp & "\YouTubeDownloader"
Call SmartCreateFolder(DEST)
For Each Video in Videos
    Video = URLDecode(URLDecode(Video))
    wscript.echo Video
    Download_Command = "Title "& Title & "& color 0A & echo; & echo; & echo    Please be patient Downloading "& DblQuote(FileName) &_
    "... & Powershell.exe -command ""(New-Object System.Net.WebClient).DownloadFile("& SimpleQuote(Video) & "," & SimpleQuote(DEST + "\" + FileName)&")"""
    Call Executer(Download_Command,1)
Next
'***********************************************************************
Function Executer(StrCmd,Console)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
    If Console = 0 Then
        MyCmd = "CMD /C " & StrCmd & ""
        Resultat = ws.run(MyCmd,Console,True)
        If Resultat = 0 Then
        Else
'MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
'La valeur 1 pour montrer la console MS-DOS
    If Console = 1 Then
        MyCmd = "CMD /K " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,True)
        If Resultat = 0 Then
        Else
'MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
    Executer = Resultat
End Function
'------------------------------------------------
Function SimpleQuote(Str)
    SimpleQuote = ChrW(39) & Str & ChrW(39)
End Function
'------------------------------------------------
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'------------------------------------------------
Function Extracting_Videos(URL)
    Dim regEx, Match, Matches, Array_Videos,dico,K
    Set regEx = New RegExp
    regEx.Pattern = "<td>(.*?)</td><td>(.*?)</td><td><a href=.(.*?)"""
    regEx.IgnoreCase = True
    regEx.Global = False
    Set Matches = regEx.Execute(URL)
    Array_Videos = Array()
    Set dico = CreateObject("Scripting.Dictionary")
    For Each Match in Matches
        If Not dico.Exists(Match.Value) Then
            dico.Add Match.submatches(2),Match.submatches(2)
        End If
    Next
    For each K in dico.Keys()
        ReDim Preserve Array_Videos(UBound(Array_Videos) + 1)
        Array_Videos(UBound(Array_Videos)) = K
    Next
    Extracting_Videos = Array_Videos
End Function
'------------------------------------------------
Function GetFileName(URL)
    Dim ArrFile,FileName
    ArrFile = Split(URL,"/")
    FileName = ArrFile(UBound(ArrFile))
    GetFileName = FileName
End Function
'------------------------------------------------
Sub SmartCreateFolder(strFolder)
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(strFolder) then
            SmartCreateFolder(.getparentfoldername(strFolder))
            .CreateFolder(strFolder)
        End If
    End With
End Sub
'------------------------------------------------
Function GetSourceCode(URL)
    Dim http
    Set http = CreateObject("Msxml2.XMLHTTP")
    http.open "GET",URL,False
    http.send
    GetSourceCode = http.responseText
End Function
'------------------------------------------------
Function URLDecode(str)
Dim list,i,strLen,sT,depth,val,sR,by
set list = CreateObject("System.Collections.ArrayList")
strLen = Len(str)
    for i = 1 to strLen
        sT = mid(str, i, 1)
        if sT = "%" then
            if i + 2 <= strLen then
                list.Add cbyte("&H" & mid(str, i + 1, 2))
                i = i + 2
            end if
        else
            list.Add asc(sT)
        end if
    next
    depth = 0
    for each by in list.ToArray()
        if by and &h80 then
            if (by and &h40) = 0 then
                if depth = 0 then Err.Raise 5
                val = val * 2 ^ 6 + (by and &h3f)
                depth = depth - 1
                if depth = 0 then
                    sR = sR & chrw(val)
                    val = 0
                end if
            elseif (by and &h20) = 0 then
                if depth > 0 then Err.Raise 5
                val = by and &h1f
                depth = 1
            elseif (by and &h10) = 0 then
                if depth > 0 then Err.Raise 5
                val = by and &h0f
                depth = 2
            else
                Err.Raise 5
            end if
        else
            if depth > 0 then Err.Raise 5
            sR = sR & chrw(by)
        end if
    next
    if depth > 0 then Err.Raise 5
    URLDecode = sR
End Function
'------------------------------------------------
Merci de votre aide