Программа для ведения архива медиафайлов в полевых условиях

С 2009 года я участвую в комплексных исследовательских экспедициях, которые проводит фонд “Электронная энциклопедия истории и культуры русских сёл и деревень” в сотрудничестве со школой №1553 имени В.И. Вернадского.

За многие годы поездок у нас сформировался такой порядок работы:
Весной мы исследуем сёла и подбираем одно в которое поедем летом. Какого-то определённого алгоритма выбора у нас нет - либо нас приглашают уже знакомые с нашей работой, либо мы ищем по друзьям и друзьям друзей место для поездки - небольшое село с историей, в котором остались коренные жители (а не только дачники).
Летом выезжаем в экспедицию с группой волонтёров и в течение 10-14 дней занимаемся исследованиями: 

• записываем интервью с местными жителями, 

• оцифровываем фотографии и документы, 

• снимаем фильмы 

и одновеременно на основе собранных материалов создаём несколько медиапродуктов:

• сайт, 

• фильмы, 

• выставку и 

• родовые древа. 

Кроме того, мы обучаем работе с сайтом. Примеры наших работ можно посмотреть на сайте derevni-sela.ru. 

В нашей команде работают взрослые и школьники старших классов до 30-ти человек. За всё время экспедиции мы собираем около 300 часов интервью, а фотографий и оцифрованных документов получается около 2000. Все эти материалы должны стать основой для статьи на сайте или кусочком фильма или помочь в следующих интервью, поэтому описание всех материалов - это необходимый этап работы в экспедиции. Более того, волонтёры-школьники, участвующие в экспедиции после поездки уже не так активно участвуют в описании архива, поэтому мы стремимся к полному описанию всех материалов именно за этот короткий период поездки. 

Так стало понятно, что все материалы должны были быть описаны подробно и сложены в архив.

Решение 1. Локальное сетевое хранилище

Первое решение, которое мы предприняли, это создали локальную сеть, в которую добавили все ноутбуки и на одном из компьютеров расшарили общую папку, в которой лежал архив. Описание медиафайлов было разделено на 2 части: у фотографий меняли название. Для аудио и видео создавался отдельный файлик, в котором поминутно было описано, что происходит (тематическая разметка, но не дословная расшифровка). 

Процесс разметки аудио и видео был достаточно трудоёмким, особенно из-за того, что приходилось переключаться между окнами разных программ. Поэтому возникла идея создать программу, ускоряющую этот процесс.

Решение 2. Программа для описи интервью

Сразу оговорюсь, почему мы не взяли программы для создания субтитров, например. Или программы типо Audacity. Дело в том, что во всех этих программах функции были заточены слишком узко. Кроме того помимо описания самого содержимого файла уже давно хотелось хранить какую-то метаинформацию: участников интервью, обстоятельства, место, время и множество других подробностей.

Благодаря неустанному энтузиазму Сергея Махотина была создана первая версия программы описи. В ней использовался для основы MS Excel и Visual Basic for Applications. 

Программа была протестирована и доработана автором данной статьи в экспедициях 2019, 2021 годов и получила название exelOpis (да-да, с опечаткой в слове Excel).

Однако структура описания и хранения не изменилась. Для каждого аудиофайла было необходимо создавать отдельный экселевский файл, чтобы описать его содержимое. А фотографии описывались по-старому. Но описание фотографий по-старому приводило к ужасно длинным названиям (как бы вы описали фото, где 10 человек и всех нужно подписать с датами рождения и полным ФИО).

Кроме того, после экспедиции архив нужно было переносить на другие жесткие диски и тогда возникали проблемы с этими длинными подписями. Таким образом стало понятно, что нужен какой-то общий способ, объединяющий все способы описания и хранения медиафайлов.

Sub deleteRowsToStart()
    Dim lastRowIndex
    Dim RowIndex
    Dim UsedRng
    Set UsedRng = ActiveSheet.UsedRange
  
    lastRowIndex = UsedRng.row - 1 + UsedRng.Rows.Count
    Application.ScreenUpdating = False
    For RowIndex = lastRowIndex To START_ROW + 1 Step -1
            Rows(RowIndex).ClearContents
    Next RowIndex
    Application.ScreenUpdating = True
End Sub

Public Sub processUpdate(ByVal Target As Range, table As String, oldValue As Variant, Optional timeFormat As String = "")
    If Not Sheets("Ôàéëû").connectToBataBaseCheckBox.Value Then Exit Sub
    If Not sqlConnector.isUserTyping Then Exit Sub                              ' Это пользователь делает?
    If Target.Cells.Count > 1 Then Exit Sub                                     'Редактируется только одна ячейка?
    If Not (Target.row > START_ROW And Target.Column > START_COL) Then Exit Sub ' Редактируются только разрешённые ячейки?
    If oldValue = Target.Value Then Exit Sub                                    ' Значение вообще менялось?
    prevColor = Target.Font.Color
    Target.Font.Color = RGB(200, 150, 0)
    
On Error GoTo Catch
    'Target.Format
    tableTitle = Target.Worksheet.Cells(START_ROW, Target.Column)
    idColumn = START_COL + 1
    ID = Target.Worksheet.Cells(Target.row, idColumn)
    If ID <> "" Then
        sqlConnect
        If timeFormat = "" Then
            sqlQuery ("UPDATE " + table + " SET `" & tableTitle & "`='" & Target.Value & "' WHERE id=" & ID & ";")
            Call storeHistory(table, tableTitle, oldValue, Target.Value, getAuthor(), ID)
        Else
            sqlQuery ("UPDATE " + table + " SET `" & tableTitle & "`='" & Format(Target.Value, timeFormat) & "' WHERE id=" & ID & ";")
            Call storeHistory(table, tableTitle, Format(oldValue, timeFormat), Format(Target.Value, timeFormat), getAuthor(), ID)
        End If
        Target.Font.Color = prevColor
    End If
Catch:
End Sub

Дла обработки ошибок использовался аналог try и catch - GoTo, отправляющий в конец кода после ошибки.

Для выбора файлов использовался стандартный диалог Windows.

Private Sub Скругленныйпрямоугольник1_Щелчок()
    Set FILE_CHOOSER = Application.FileDialog(msoFileDialogFilePicker)
        With FILE_CHOOSER
        .Title = "Выберите файл для сохранения в базу"
        .AllowMultiSelect = True
        
        ProgressForm.Show
        
         If .Show = True Then
            ProgressForm.StartCopyMediaFiles
         End If
         
    End With
End Sub

ProgressForm - это окно, которое показывало процесс копирования файлов в архив.

Здесь самая главная процедура это StartCopyMediaFiles. В ней переименовываются файлы, запускается процедура их копирования, а также после удачного исполнения вся информация заносится в таблицу базы данных.

Public Sub StartCopyMediaFiles()
    
    Dim sOldFilePath As String, sOldFileName As String, sNewFileName  As String, sExt As String
    
    
    Dim objFSO As Object, objFile As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ProgressForm.Show
    Dim i As Integer
     For i = 1 To FILE_CHOOSER.SelectedItems.Count
        sOldFilePath = FILE_CHOOSER.SelectedItems(i)                       'полное имя исходного файла
        oldPathListBox.AddItem sOldFilePath
    Next
    Dim f
    For i = 1 To FILE_CHOOSER.SelectedItems.Count
        sOldFilePath = FILE_CHOOSER.SelectedItems(i)                       'полное имя исходного файла
        sExt = objFSO.GetExtensionName(sOldFilePath)                        ' Расширение файла
        sOldFileName = objFSO.GetFileName(FILE_CHOOSER.SelectedItems(i))   'короткое имя файла
        Set f = objFSO.getfile(sOldFilePath)
        Dim dc
        If f.DateLastModified < f.DateCreated Then
            dc = f.DateLastModified
        Else
             dc = f.DateCreated
        End If
        dcStr = Format(dc, "yyyy-mm-dd hh:mm:ss")
        
        sNewFileName = Format(dc, "yyyyMMdd_hhmmss") + "_" + Left(getAuthor, 3) + CStr(i) + "_" + CStr(Second(Now())) + "." + sExt
        sNewFilePath = MEDIA_STORAGE_PATH + sNewFileName 'полный новый путь файла
        
        DoEvents ' эта штука позволяет не фризить окно копирования
        newPathListBox.AddItem sNewFilePath
        
        Set objFile = objFSO.getfile(sOldFilePath)
        objFile.Copy sNewFilePath
        Call insertFileToBase(sOldFileName, sNewFilePath, dcStr)
        LabelProg.Caption = CStr(CInt(100 * i / FILE_CHOOSER.SelectedItems.Count)) + "%"  'Отображение количества скопированных файлов
    Next
    Sheets("Файлы").updateTable
    okButton.Enabled = True
End Sub

Private Sub FindFileButton_Click()
    Shell "explorer.exe /select," + Me.Cells(selectedRow, SEARCH_PATH_COL), vbNormalFocus
End Sub

Предполагается, что все файлы доступны пользователю по SMB.

Нажатие клавиш активирует таймер:

Private Sub tbWords_Change()
    'Запускаем таймер на WaitTimeValue
    Dim alertTime As Date
    LastKeyEvent = Now 'remember when the last key event was
    alertTime = LastKeyEvent + TimeValue(WaitTimeValue)
    Application.OnTime alertTime, "updateDescriptionTimer"
End Sub

После срабатывания таймера происходит запись в базу данных того, что в данный момент введено в TextBox при помощи метода updateDescription.

Public Sub updateDescriptionTimer()
    'test if last key event is at least 3 seconds ago.
    'If so: run your search or message box
    'If not: do nothing
    On Error GoTo Catch
    If LastKeyEvent <> 0 And LastKeyEvent + TimeValue(WaitTimeValue) <= Now Then
        LastKeyEvent = 0 'Ensure this is only triggered once:
                         'If we don't do this and multiple keys are pressed within 1 second
                         'then it would run multiple times.
        Call UserForm1.updateDescription
    End If
Catch:
End Sub

Источник

Запускаем поиск при нажатии клавиши Enter (код 13):

Private Sub SearchBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        startSearch
    End If
End Sub

Процедура поиска делает запрос в базу данных:

Sub startSearch()
 If SearchBox.Value = "" Then
        deleteRowsToStart
        MsgBox "Напишите, что вы ищете!"
        Exit Sub
    End If
    search_str = SearchBox.Value
    quer = "(SELECT f.id AS id` , 'files' AS `Таблица`, f.path,  CAST(`f`.`date_created` AS CHAR(255) CHARSET utf8mb4) AS `Время начала`, f.tags As `Описание файла`, ' ' AS `Описание` , f.`кто загрузил` " + _
                        " FROM `files_ext` as `f` " + _
                        " WHERE `f`.`tags` LIKE '%" + search_str + "%' OR `f`.`Информанты` LIKE '%" + search_str + "%') " + _
                    " UNION ALL " + _
                    " (SELECT `fs`.`id` AS `id`, 'marks' AS `Таблица`, fs.path, `m`.`start_time` AS `start_time`, fs.tags,`m`.`describtion` AS `describtion`, fs.`кто загрузил` " + _
                        " FROM `marks` as `m` " + _
                        " LEFT JOIN files as fs ON  (fs.id = m.file_id) WHERE `m`.`describtion` LIKE '%" + search_str + "%' OR `m`.`tags` LIKE '%" + search_str + "%') "
    sqlConnect
    sqlQuery (quer)
    deleteRowsToStart
    Call printTable(SQL_RECORDS, START_ROW, START_COL)
    Me.Cells(START_ROW + 1, START_COL + 1).Activate
End Sub

При помощи 'files' AS Таблица, я подписываю из какой таблицы была сформирована данная строчка и затем при клике мышью на данной строчке нетрудно запустить аудио с нужного места (если это фрагмент описи) или с начала (если это строчка соответствующая целому файлу):

Private Sub OpenButton_Click()
On Error GoTo Catch:
    table_name = Me.Cells(selectedRow, SEARCH_TABLE_COL).Value ' Определяем строчка из какой таблицы была выделена пользователем
  
    time_s = "00:00:00"
    If table_name = "marks" Then
         time_s = Me.Cells(selectedRow, SEARCH_TIME_COL).Value
    End If
    
    t = TimeValue(time_s)
    time_fmt = Second(t) + Minute(t) * 60 + Hour(t) * 3600
    Call showPreview(Me.Cells(selectedRow, SEARCH_PATH_COL), time_fmt) ' Отображаем плеер
Catch:
End Sub