Страницы: 1 2 След.
RSS
Зачитать и сохранить плейлисты
 
Доброго времени!

Есть куча *.m3u* и *.asx, которые надо считать в Excel (Источник, Категория, Название, Ссылка, Сервер, Обложка, Статус).
Все прочие имеющиеся в плейлистах данные надо разместить в столбце "Не классифицировано" для ручного анализа.
После ручной доработки полученной таблицы надо создать новый набор *.m3u, взяв имена *.m3u из столбца Источник.
В идеале - 2 кнопки ("Считать" и "Создать") и очень быстрый код, т.к. файлов и ссылок просто немерено.
Формульный вариант парсера и тестовые плейлисты здесь.

Надеюсь на Вашу помощь!
Изменено: Acid Burn - 25.09.2020 17:36:36
 
Цитата
Acid Burn написал:
В идеале 2 кнопки
Первую пытались сделать? Что не получилось?
 
_Igor_61, пробовал, не получилось адаптировать LoadM3U.
А вообще меня хватает на что-то простое типа такого:
Код
Sub LoadM3U()
  Dim StrBuf As String, FNum As Long, Lines() As String
  FNum = FreeFile
' Открыть файл, создать буфер, скопировать содержимое файла в буфер, закрыть файл
  Open "D:\Tmp\Плейлисты\Films.m3u8" For Binary As #FNum
  StrBuf = Space(LOF(FNum))
  Get #FNum, , StrBuf
  Close #FNum
' Разделите m3u на строки
  Lines = Split(StrBuf, vbCrLf)
  StrBuf = vbNullString
' Пройти все строки в m3u
  Dim I As Long
    For I = 0 To UBound(Lines)
      MsgBox Lines(I)
  Next
End Sub
А дальше уже никак...
Изменено: Acid Burn - 14.09.2020 21:30:45
 
Не, старый я уже, в 2007 сижу, а у Вас 365 :)  
 
Acid Burn, Попробуйте PowerQuery, там мышкоклацанием все просто делается.
По вопросам из тем форума, личку не читаю.
 
_Igor_61, а какая разница 2007 или 365? То, что работает в 2007, в 365 тоже будет.
БМВ, от такого количества файлов мышка развалится. ))) Или руки...
 
В смысле? Натравить на фолдер и одним махом все файлы обработать. Фильтр по HTTP(s) а далее все совсем просто.
По вопросам из тем форума, личку не читаю.
 
Доброе время суток.
Цитата
БМВ написал:
а далее все совсем просто.
Дык и простому нужно учиться, а нужна помощь :)
 
Цитата
Андрей VG написал:
а нужна помощь
Андрей, привет. Ну тут я не совсем согласен. ТС сам делает то что может, это я по одной прошлой теме заметил. Просто тут нужно направить на простой путь.
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
Просто тут нужно направить на простой путь.
Привет, Михаил.
Да я не против. :)
Изменено: Андрей VG - 14.09.2020 22:05:54
 
Цитата
Acid Burn написал:
Зачитать и сохранить
А зачитывать вслух? :)
 
Цитата
БМВ написал:
ТС сам делает то что может, это я по одной прошлой теме заметил. Просто тут нужно направить на простой путь.
Дело в том, что я хотел бы поделиться файлом с народом на 4PDA, не удивлюсь, если для многих там PowerQuery будет словом ругательным. )))
PS: а "ТС" - это кто?
 
Цитата
Acid Burn написал:
а "ТС" - это кто?
Это Вы: ТопикСтартер ) Тот, кто создал тему.
 
Тогда тут ТС ничего не может, кроме как поштучно и построчно зачитать каждый файл...
А тут не обычный файл, а m3u с не простой структурой, а ещё и asx-файлы появляются - приложил к посту №1.
Изменено: Acid Burn - 14.09.2020 23:20:13
 
Цитата
Acid Burn написал:
А тут не обычный файл, а m3u с не простой структурой, а ещё и asx-файлы появляются - приложил к посту №1.
https://www.myqnapcloud.com/smartshare/6e496l18n2opo676wt9645z0_61l3P74 это просто как пример.
Изменено: БМВ - 14.09.2020 23:40:05
По вопросам из тем форума, личку не читаю.
 
БМВ, благодарю, но я не знаю, как придти из этого вида к нужному. Ещё и ошибка в фильтре "Показаны не все элементы", при клике по которой получаем сообщение "Этот столбец содержит более 10000 уникальных элементов. Показаны только первые 10000 уникальных элементов". Да и виснет порядочно при нажатии "Изменить"...
Изменено: Acid Burn - 14.09.2020 23:46:46
 
Ну  а если так
По вопросам из тем форума, личку не читаю.
 
БМВ, так лучше - ошибки нет, тормозит меньше, но до требуемого вида таблицы (Анализ.xlsb в посте #1) ещё далеко. Но, наверное, если я найду консольный конвертер m3u и asx в xml, будет проще?

Update: пока нашёл только Lizzy - поддерживает кучу форматов, но работает на Java, ставить которую нет никакого желания.
Изменено: Acid Burn - 15.09.2020 11:28:54
 
Цитата
Acid Burn написал:
но до требуемого вида таблицы (Анализ.xlsb в посте #1) ещё далеко
А первый лист значит остался незамеченным? Но более чем уверен, что это даже просто через PQ можно сделать, без дополнительной обработки на листе.
Изменено: БМВ - 15.09.2020 11:59:01
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
А первый лист значит остался незамеченным?
Реально не заметил из-за запарки на работе, извиняюсь. Спасибо за "формульное" решение - изучу и сохраню, как запасной вариант.

Но всё же нужен макрос. Надеюсь, кто-нибудь откликнется...
 
Anybody?
 
Цитата
Acid Burn написал:
Anybody?
Думаю такой найдётся, если ТС возьмёт на себя смелость проанализировать представленный набор файлов и для каждого из составить определение, что куда и почему должно быть положено в таблицу файла Анализ
Например, файл Serials, строка 3134
Цитата
#EXTINF:-1 group-title="Апостол" tvg-logo="https://ekzo.ucoz.net/ch_icons/a/apostol.png",(01.01)
(01.01) куда должно попасть?
Вот так случайно выберите в каждом файле строк по двадцать и разберите с комментариями. Тогда, глядишь, и найдутся желающие :)
 
Андрей VG, (01.01) должно попасть в "Название", т.к. более никуда не подходит.
Всего 7 столбцов: "Статус" до проверки всегда "?", и это не Файл, не Категория и не Link (Сервер/Ссылка/Обложка). Так ведь?
Значит остаётся "Название".

Разбор 20 строк из каждого приложенного файла ничего не даст - их уже >1000 шт., продолжаю скачивать, не зная, что внутри.
В любом случае данные "типовые" - можно использовать Regex или какие-то более быстрые алгоритмы разбора.
А дальше уже я смогу откинуть не рабочие ссылки и упорядочить всё остальное в Excel.
Изменено: Acid Burn - 16.09.2020 00:57:26
 
Попробую поднять тему ещё раз, спустя неделю. Может кто откликнется?
 
Цитата
Андрей VG написал:
(01.01) куда должно попасть?
Андрей, там же разделитель есть. То что до него по тегам разбирается, а после  - название.
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
там же разделитель есть
Привет, Михаил.
Это я понял, но ожидал анализа от ТС, как и таблицы соответствия имён столбцов вывода названием тегов.... Ну, а на нет и суда нет :)  Видимо настолько нужно.
 
Андрей VG, простите за задержку с ответом - застрял на работе...
Анализ "формулами" - не проблема. Раз к *.asx вопросов нет, сделал выборку из всех *.m3u:
-- в столбец P вставил содержимое всех *.m3u, предварительно заменив в них табуляцию на пробел;
-- в столбец О вставил имена использованных файлов;
-- в [B:M] растянул формулы (можно улучшить, но в целом сойдёт).
Диапазон [B:E;O:P] излишен, а в [F:M] - как раз то, что хотелось бы видеть. Ссылка в посте №1.
 

Приветствую форумчане.

Давно меня здесь не было, 2 часа пароль вспоминал.

На мой взгляд интересная задачка, решил помочь ТС.

Не пинайте за код, давно не практиковался, решил поразмять мозг немного.

Комментариев к коду мало, только основные моменты, нет достаточного свободного времени.

Кнопку не прикрутил, думаю ТС сможет сам, если нет, то запуск процедуры Alt+F8 в помощь.

Процедура выполняет анализ файлов ASX и m3u8 согласно примера (загруженных файлов плейлисты), каждый проанализированный файл m3u8 выгружается в отдельную книгу EXCEL, файлы ASX собираются в одну таблицу в одной книге. Протестировано на работоспособность в Windows7, Excel 2010, должно работать и в остальных версиях, т.к. функции API не использовались, нестандартные функции не использовались.

В функции GetCollectionM3UfileText лучше использовать регулярные выражения, я в них не силен, текущий код функции возможно будет работать не корректно со всеми файлами m3u8 (ошибки обработки данных).

Процедуры сборки обратно в файл m3u8 не написал.

Код
Код
Public Sub ParserASX_M3U()
'Основная процедура парсинга файлов ASX, m3u8
Dim i As Long, x As Long, n As Long
Dim tmp, temp
Dim arr1(), arr2()
Dim strTemp As String

' Получить коллекцию фалов для обработки.
' Используем внешнюю функцию диалог пользователя открыть файл, _
  дает возможность выбора (обработки) как одного так и всех файлов в папке.
Dim objFilesCollection As Collection
Set objFilesCollection = GetCollectionFilesDialog
If objFilesCollection.Count = 0 Then Exit Sub
' Перебор коллекции поиск фалов ASX и m3u
Dim objASXCollection As New Collection
Dim objM3UCollection As New Collection
For Each tmp In objFilesCollection
  If tmp Like "*.asx" Then
    objASXCollection.Add tmp
  ElseIf tmp Like "*.m3u*" Then
    objM3UCollection.Add tmp
  Else
  End If
Next tmp
Set objFilesCollection = Nothing

' Работаем с файлами ASX
' Считsваем данные файла внешней функцией
If objASXCollection.Count > 0 Then
  arr1 = GetCollectionASXfileText(objASXCollection)
  If LBound(arr1) > 0 Then
    arr1(1, 1) = "TITLE": arr1(1, 2) = "HREF"
    ' Выгружаем данные в новую книгу без сохранения
    Call CreateEXCELfile(arr1, "ASX files", 0)
  End If
End If
' Работаем с файлами m3u8
' Считsваем данные файла внешней функцией
If objM3UCollection.Count > 0 Then
  For Each tmp In objM3UCollection
    strTemp = CreateObject("Scripting.FileSystemObject").GetFileName(tmp)
    arr2 = GetCollectionM3UfileText(tmp)
    If LBound(arr2) > 0 Then
      ' Выгружаем данные в новую книгу без сохранения _
        для каждого файла создается отдельная новая книга
        Call CreateEXCELfile(arr2, strTemp, 1)
    End If
  Next
End If
Set objASXCollection = Nothing
Set objM3UCollection = Nothing
Erase arr1: Erase arr2
End Sub

Private Sub CreateEXCELfile(arrTemp, strNameSht As String, byteDataType As Byte)
''' ЗАГРУЖАЕМ ДАННЫЕ В СОЗДАННУЮ КНИГУ И РАБОТАЕМ С НЕЙ
' byteDataType - тип загружаемых данных (0 = массив файлов ASX, 1 = массив файлов m3u8)
Dim oExcelFile As Object
Dim iMaxRow As Long, iMaxClmn As Long
Dim i As Long, n As Long
iMaxRow = UBound(arrTemp, 1)
iMaxClmn = UBound(arrTemp, 2)

Workbooks.Add -4167 '=xlWBATWorksheet
''' Cоздаем новую книгу с одним листом
With CreateObject("Excel.Sheet"): Set oExcelFile = ActiveWorkbook: End With
With oExcelFile
  ActiveSheet.Name = strNameSht
  With .Sheets(strNameSht)
    ''' Формат ширин полей
    If byteDataType = 0 Then
      For Each oVl In .Range(.Cells(1, 1), .Cells(1, 1).Offset(, iMaxClmn - 1))
        Select Case oVl.Column
          Case Is = 1: oVl.ColumnWidth = 30: Case Is = 2: oVl.ColumnWidth = 145
        End Select
      Next
    ElseIf byteDataType = 1 Then
      For Each oVl In .Range(.Cells(1, 1), .Cells(1, 1).Offset(, iMaxClmn - 1))
        Select Case oVl.Column
          Case Is = 1: oVl.ColumnWidth = 15:  Case Is = 2: oVl.ColumnWidth = 25
          Case Is = 3: oVl.ColumnWidth = 45:  Case Is = 4: oVl.ColumnWidth = 45
          Case Is = 5: oVl.ColumnWidth = 25:  Case Is = 6: oVl.ColumnWidth = 25
          Case Is = 7: oVl.ColumnWidth = 15
        End Select
      Next
    Else
    End If
    ''' Выгружаем данные на лист
    .Range("A1").Resize(iMaxRow, iMaxClmn) = arrTemp '
    ''' Общее форматирование данных на листе
    ''' Форматируем шапку таблицы
    With .Range(.Cells(1, 1), .Cells(1, 1).Offset(, iMaxClmn - 1))
       .HorizontalAlignment = -4108 ' xlCenter
       .VerticalAlignment = -4108   ' xlCenter
       .Interior.Pattern = 1        ' xlSolid
       .Borders.LineStyle = 1       ' xlContinuous
       .Font.Bold = True            ' шрифт жирный
       .WrapText = True             ' перенос текста в ячейке
       .Interior.ColorIndex = 35
       .AutoFilter
    End With
    .Cells(2, 1).Select:  ActiveWindow.FreezePanes = True ''' Закрепить область на второй строке
    ''' Форматируем общие форматы таблицы
    With .Range(.Cells(2, 1), .Cells(iMaxRow, iMaxClmn))
        .HorizontalAlignment = -4131 'xlLeft
        .VerticalAlignment = -4108
        .Borders.LineStyle = 1
        .Interior.ColorIndex = -4105
        .WrapText = False
        .Font.Bold = False
        .Rows.AutoFit
        .Locked = True
    End With
  End With
End With
Erase arrTemp
End Sub

Private Function GetCollectionM3UfileText(strFileName) As Variant
' Функция обрабатывает содержимое файлов ASX возвращая массив
' Источник, Категория, Название, Ссылка, Сервер, Обложка, Статус
Dim oVl, iMaxRow As Long
Dim strLine1 As String, strLine2 As String
Dim arr(), arr1(0, 0), tmp, strTemp, strTemp1
Dim i As Long, n As Long

' Загрузка данных из файла в коллекции, считываем весь текс _
  Используется UTF8 для коррекктного чтения данных
  With CreateObject("ADODB.Stream")
    .Charset = "utf-8": .Mode = 3: .Type = 1
    .Open
    .LoadFromFile strFileName
    .Position = 0: .Type = 2
    strTemp = .ReadText
    oVl = Split(strTemp, vbCrLf)
    iMaxRow = UBound(oVl)
    .Close
    strTemp = vbNullString
  End With
  strFileName = CreateObject("Scripting.FileSystemObject").GetFileName(strFileName)
  ' переопределение массива и формирование шапки
  ReDim arr(1 To (iMaxRow / 2) + 1, 1 To 7)
  i = 1
  arr(i, 1) = "Источник": arr(i, 2) = "Категория": arr(i, 3) = "Название"
  arr(i, 4) = "Ссылка":  arr(i, 5) = "Сервер":  arr(i, 6) = "Обложка":  arr(i, 7) = "Статус"
    
  For n = 1 To iMaxRow Step 2
    If oVl(n) Like "*EXTINF*" Then
      i = i + 1
      strTemp = Split(oVl(n), ",", -1, 1)
      '"Источник"
      arr(i, 1) = strFileName
      '"Категория"
        strTemp(0) = Replace(strTemp(0), "#EXTINF:-1 group-title=", "", 1, -1, 1)
        strTemp(0) = Replace(strTemp(0), Chr(34), "", 1, -1, 1)
        
        If strTemp(0) Like "*tvg-logo*" Then
          strTemp1 = Split(strTemp(0), "tvg-logo=", -1, 1)
          arr(i, 2) = Trim(strTemp1(0))
          '"Обложка"
          arr(i, 6) = Trim(strTemp1(1))
        Else
          arr(i, 2) = Trim(strTemp(0))
          arr(i, 6) = "-"
        End If
      '"Название"
      If strTemp(1) Like "*===*" Then strTemp(1) = Replace(strTemp(1), "=", "", 1, -1, 1)
      arr(i, 3) = strTemp(1)
      ' "Ссылка"
      If oVl(n + 1) Like "*http*" Then arr(i, 4) = oVl(n + 1)
      ' "Сервер"
        strTemp = Split(oVl(n + 1), "/", -1, 1)
        arr(i, 5) = strTemp(2)
      
      ' "Статус"
      arr(i, 7) = "I don't know"
      
    End If
  Next n
Erase oVl: oVl = Empty
strFileName = vbNullString
If i > 0 Then GetCollectionM3UfileText = arr Else GetCollectionM3UfileText = arr1
Erase arr
End Function

Private Function GetCollectionASXfileText(objColl As Object) As Variant
' Функция обрабатывает содержимое файлов ASX возвращая массив
Dim strBuf As String, intFreeFile As Long, Lines() As String
Dim strLine1 As String, strLine2 As String
Dim arr(), arr1(0, 0), tmp, temp
Dim i As Long, n As Long
ReDim arr(1 To objColl.Count + 1, 1 To 2): n = 1
For Each tmp In objColl
  intFreeFile = FreeFile
  Open tmp For Binary As #intFreeFile
  strBuf = Space(LOF(intFreeFile))
  Get #intFreeFile, , strBuf
  Close #intFreeFile
  Lines = Split(strBuf, vbCrLf)
  strBuf = vbNullString
    For i = 0 To UBound(Lines)
      If Lines(i) Like "*<TITLE>*" Then
        Lines(i) = Replace(Lines(i), "<Entry>", "", 1, -1, vbTextCompare)
        Lines(i) = Replace(Lines(i), "<TITLE>", "", 1, -1, vbTextCompare)
        Lines(i) = Replace(Lines(i), "</TITLE>", "", 1, -1, vbTextCompare)
        Lines(i) = Trim(Lines(i))
        strLine1 = Lines(i)
      ElseIf Lines(i) Like "*<ref*" Then
        Lines(i) = Replace(Lines(i), "<ref HREF=", "", 1, -1, vbTextCompare)
        Lines(i) = Replace(Lines(i), "/>", "", 1, -1, vbTextCompare)
        Lines(i) = Replace(Lines(i), Chr(34), "", 1, -1, vbTextCompare)
        Lines(i) = Trim(Lines(i))
        strLine2 = Lines(i)
      Else
      End If
    Next i
    If Len(strLine1) > 0 And Len(strLine2) > 0 Then
      n = n + 1
      arr(n, 1) = strLine1: arr(n, 2) = strLine2
    End If
    strLine1 = vbNullString: strLine2 = vbNullString
Next
If i > 0 Then GetCollectionASXfileText = arr Else GetCollectionASXfileText = arr1
Erase arr
End Function

Private Function GetCollectionFilesDialog() As Collection
''' Функция диалога выбора файлов FileDialog(msoFileDialogFilePicker)
''' Возвращает коллекцию файлов выбраных пользователем
Dim objColl As New Collection
Dim intSelectFile As Long
Dim strMyDocuments
strMyDocuments = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
  With Application.FileDialog(3)
      .AllowMultiSelect = True
      .Title = "Выбрать файлы ASX, m3u8 для обработки"
      .Filters.Clear
      .Filters.Add "All files", "*.*", 1
      .Filters.Add "ASX files", "*.asx", 2
      .Filters.Add "m3u8 files", "*.m3u8", 3
      .FilterIndex = 3
      .InitialFileName = strMyDocuments & "*.*.*.*"
      .InitialView = 2
      If .Show = 0 Then
        Set GetCollectionFilesDialog = objColl
        Exit Function
      End If
      'цикл по коллекции выбранных в диалоге файлов, считываем полный путь к файлу
      For intSelectFile = 1 To .SelectedItems.Count
          objColl.Add .SelectedItems(intSelectFile)
      Next
      Set GetCollectionFilesDialog = objColl
  End With
End Function



Пользуйтесь.

Отпишите помогло или как ?

Изменено: TSN - 23.09.2020 14:58:16
 
TSN, спасибо огромное! Наконец-то тема сдвинулась с мёртвой точки.
Работает быстро, но теряет часть данных (как минимум, не хватает столбца "Не классифицировано") и не собирает всё в одну таблицу (я потом запутаюсь в файлах)...
 
Цитата
Acid Burn написал:
не хватает столбца "Не классифицировано"
Я его не добавил, не обратил внимание когда читал тех задание. Это легко исправить, где он должен быть?.
Если предположить, что это последнее поле таблиц, тогда в
строке кода 142 заменить текст на ReDim arr(1 To (iMaxRow / 2) + 1, 1 To 8
дописать строку 146 (она сейчас пустая)   arr(i,8) = "Не классифицировано"
Код
' переопределение массива и формирование шапки
  ReDim arr(1 To (iMaxRow / 2) + 1, 1 To 8)
  i = 1
  arr(i, 1) = "Источник": arr(i, 2) = "Категория": arr(i, 3) = "Название"
  arr(i, 4) = "Ссылка":  arr(i, 5) = "Сервер":  arr(i, 6) = "Обложка":  arr(i, 7) = "Статус"
  arr(i, 8) = "Не классифицировано"


Я специально сделал так, чтобы каждый файл m3u8 собирался в отдельную книгу и таблицу. Данных много в обрабатываемом файле, если их собрать в одно целое сразу, будет тормозить выполнение процедуры, возможно с зависанием компа. В примерах файлы m3u8 по итогу выгружали таблицу на 10000 строк, если запустить анализ 100 файлов, таблица ответа будет 1000000 строк примерно, что очень тяжело для ексель. Хотя при желании можно сделать дозагрузку ответов в уже имеющуюся таблицу.
Изменено: TSN - 23.09.2020 15:40:42
Страницы: 1 2 След.
Наверх