Total Commander

Код: Выделить всё

'•••••••••••••••••••••••••••• 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