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

С 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