'•••••••••••••••••••••••••••• VBS •••••••••••••••••••••••••••
' Скачивание бинарных файлов по ссылкам выбранных txt-списков
' в создаваемые при необходимости папки c их базовыми имёнами
' Параметры: %WL "<путь получателя>"
' Ключ на протоколирование ошибок: /l
'••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••
Option Explicit : Dim List, Path, Log, Title, FSO, Dic, Reg, _
F, HTTP, URL, FN, Name, Ext, FType, File, All, Fold, FLog, Cnt
With WSH.Arguments
If .Count Then List = .Item(0) : Path = .Item(1) Else WSH.Quit
Log = .Named.Exists("l")
End With : Title = " Скачивание файлов"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dic = CreateObject("Scripting.Dictionary")
Set Reg = New RegExp : Reg.IgnoreCase = True
Reg.Global = True : Reg.MultiLine = True
Reg.Pattern = "^\s*(https?://[^\r\n\s]+)"
Set HTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
HTTP.Option(4) = 13056 : HTTP.Option(6) = True
HTTP.Option(12) = True : HTTP.Option(14) = 5
Set List = FSO.OpenTextFile(List,,,-1)
Do : File = List.ReadLine
If StrComp(FSO.GetExtensionName(File), "txt", 1) = 0 Then
If Len(File) > 259 Then File = "\\?\" & File
If FSO.GetFile(File).Size Then
With FSO.OpenTextFile(File) All = .ReadAll : .Close :End With
Fold = FSO.BuildPath(Path, FSO.GetBaseName(File))
If Len(Fold) > 259 Then Fold = "\\?\" & Fold
If Reg.Test(All) And Not FSO.FolderExists(Fold) Then FSO.CreateFolder Fold
If Log Then FLog = Left(File, InStrRev(File, ".") - 1) & " Errors.txt" :_
Dim LogFile : Set LogFile = FSO.CreateTextFile(FLog, 1)
For Each URL in Reg.Execute(All)
URL = URL.SubMatches(0) : FN = ""
If Not Dic.Exists(URL) Then
HTTP.Open "GET", URL, False
HTTP.SetRequestHeader "Pragma", "no-cache" : Dic.Add URL, ""
HTTP.SetRequestHeader "Cache-Control", "no-cache" : HTTP.Send
HTTP.WaitForResponse 5, True : URL = HTTP.Option(1)
FType = HTTP.GetResponseHeader("Content-Type")
If HTTP.Status = 200 And InStr(FType, "text/html") = 0 Then
On Error Resume Next
Name = HTTP.GetResponseHeader("Content-Disposition")
If Err.Number = 0 Then FN = Split(Name & """", """")(1)
On Error GoTo 0 : If FN = "" Then FN = FSO.GetFileName(URL) :_
FN = Mid(FN, InStrRev(FN, "?") + 1)
Ext = FSO.GetExtensionName(FN)
If Ext = "" Or IsNumeric(Ext) Then
Ext = Mid(FType, InStrRev(FType, "/") + 1)
If Len(Ext) Then FN = FN & "." & Ext
End If : F = FSO.BuildPath(Fold, FN)
If Len(F) > 259 And Left(F, 1) <> "\" Then F = "\\?\" & F
If Not FSO.FileExists(F) Then
With CreateObject("SAPI.SpFileStream")
.Format.Type = 1 : .Open F, 3, True
.Write HTTP.ResponseBody : .Close
End With : Cnt = Cnt + 1
End If
ElseIf Log Then LogFile.WriteLine URL
End If : HTTP.Abort
End If
Next : If Log Then LogFile.Close :_
If FSO.GetFile(FLog).Size = 0 Then FSO.DeleteFile FLog
End If
End If
Loop Until List.AtEndOfStream : List.Close : If Cnt Then _
MsgBox "Число скачанных файлов: " & Cnt, 4160, Title Else _
MsgBox "Нет подходящих объектов!", 4144, Title |
