Удалить первые 50 секунд видеофайла - VB

Option Explicit
. . . 
ДЕКЛАРАЦИИ
. . .
Dim currentFile As String           ' Текущее имя файла
Dim hAvi        As Long             ' Текущий файл
Dim frameCount  As Long             ' Общее количество кадров в файле
Dim frameStart  As Long             ' Первый кадр
Dim vidStream   As Long             ' Видеопоток
Dim IGetFrame   As Long             ' Объект для рендеринга
Dim vidInfo     As AVI_STREAM_INFO  ' Информация о видеопотоке
 
' // Обновить фрейм
Private Sub Update()
    Dim lpDIB   As Long
    Dim bi      As BITMAPINFOHEADER
    Dim x       As Long
    Dim y       As Long
    Dim dx      As Long
    Dim dy      As Long
    Dim aspect  As Single
    
    If IGetFrame = 0 Then Exit Sub
    ' Получаем фрейм
    lpDIB = AVIStreamGetFrame(IGetFrame, sldFrame.Value)
    ' Получаем информацию о растре
    memcpy bi, ByVal lpDIB, Len(bi)
    ' Центруем
    aspect = bi.biHeight / bi.biWidth
    
    If aspect < 1 Then
        x = 0
        dx = picOut.ScaleWidth
        dy = picOut.ScaleWidth * aspect
        y = (picOut.ScaleHeight - dy) / 2
    Else
        y = 0
        dy = picOut.ScaleHeight
        dx = picOut.ScaleHeight / aspect
        x = (picOut.ScaleWidth - dx) / 2
    End If
    ' Выводим
    StretchDIBits picOut.hdc, x, y, dx, dy, 0, 0, bi.biWidth, bi.biHeight, ByVal lpDIB + bi.biSize, ByVal lpDIB, 0, vbSrcCopy
 
    ' Обновляем время
    Dim tim As Date
    
    tim = TimeSerial(0, 0, (sldFrame.Value - frameStart) / (vidInfo.dwRate / vidInfo.dwScale))
    
    lblTime.Caption = tim
    
End Sub
 
' // Функция загружает AVI файл
Private Sub LoadAVI(fileName As String)
    Dim ret     As Long
    ' Очистка
    Clear
    ' Открываем файл
    ret = AVIFileOpen(hAvi, StrPtr(fileName), OF_READWRITE, ByVal 0&)
    If ret Then GoTo ErrHandler
    ' Открываем поток
    ret = AVIFileGetStream(hAvi, vidStream, streamtypeVIDEO, 0)
    If ret Then GoTo ErrHandler
    ' Получаем информацию о потоке
    AVIStreamInfo vidStream, vidInfo, Len(vidInfo)
    ' Узнаем кадры
    frameStart = AVIStreamStart(vidStream)
    frameCount = AVIStreamLength(vidStream)
    If frameStart = -1 Or frameCount = -1 Then ret = 1: GoTo ErrHandler
    ' Получаем IGetFrame объект
    IGetFrame = AVIStreamGetFrameOpen(vidStream, ByVal AVIGETFRAMEF_BESTDISPLAYFMT)
    If IGetFrame = 0 Then GoTo ErrHandler
    
    currentFile = fileName
    
    sldFrame.Min = frameStart
    sldFrame.Max = frameStart + frameCount - 1
    sldFrame.SelStart = sldFrame.Min
    sldFrame.SelLength = frameCount - 1
    
    picOut.Cls
    
    Update
    
    Exit Sub
    
ErrHandler:
    Clear
    currentFile = vbNullString
    
    MsgBox "Error"
    
End Sub
 
' // Очистка
Private Sub Clear()
    If IGetFrame Then AVIStreamGetFrameClose IGetFrame: IGetFrame = 0
    If vidStream Then AVIStreamRelease vidStream: vidStream = 0
    If hAvi Then AVIFileRelease hAvi: hAvi = 0
End Sub
 
' // Сохранить изменения
Private Sub cmdSave_Click()
    Dim hNewFile    As Long
    Dim hNewStream  As Long
    Dim newFileName As String
    Dim ret         As Long
    Dim info        As AVI_STREAM_INFO
    Dim firstFrame  As Long
    Dim lastFrame   As Long
    Dim curFrame    As Long
    Dim nextKeyFr   As Long
    Dim index       As Long
    Dim sampleCount As Long
    Dim dataSize    As Long
    Dim isKeyFrame  As Boolean
    Dim buffer()    As Byte
 
    If hAvi = 0 Then Exit Sub
    ' Мы не можем просто так скопировать стрим с любого места, т.к. данные в стриме
    ' могут быть зависимы и мы можем копировать стрим только если есть опорный кадр
    ' Ищем ближайший опорный кадр
    firstFrame = AVIStreamFindSample(vidStream, sldFrame.SelStart, FIND_KEY Or FIND_NEXT)
    lastFrame = AVIStreamFindSample(vidStream, sldFrame.SelStart + sldFrame.SelLength, FIND_KEY Or FIND_PREV)
    ' Корректируем
    If firstFrame < 0 Then firstFrame = 0
    If lastFrame < 0 Then lastFrame = 0
    ' Получаем параметры текущего видео стрима
    AVIStreamInfo vidStream, info, Len(info)
    ' Корректируем количество кадров исходя из новой длины
    info.dwLength = lastFrame - firstFrame + 1
    ' Имя результирующего файла
    newFileName = left$(currentFile, Len(currentFile) - 4) & "_Edited.avi"
    ' Создаем новый файл
    ret = AVIFileOpen(hNewFile, StrPtr(newFileName), OF_CREATE Or OF_READWRITE, ByVal 0&)
    If ret Then GoTo ErrHandler
    ' Создаем новый видео стрим
    ret = AVIFileCreateStream(hNewFile, hNewStream, info)
    If ret Then GoTo ErrHandler
    ' Копируем формат
    ret = AVIStreamReadFormat(vidStream, 0, ByVal 0, dataSize)
    If ret Then GoTo ErrHandler
    ReDim buffer(dataSize - 1)
    ret = AVIStreamReadFormat(vidStream, 0, buffer(0), dataSize)
    If ret Then GoTo ErrHandler
    ret = AVIStreamSetFormat(hNewStream, 0, buffer(0), dataSize)
    If ret Then GoTo ErrHandler
    ' Проход по кадрам и их копирование в новый файл
    curFrame = firstFrame
    nextKeyFr = curFrame
    
    prgProgress.Visible = True
    
    Do While index < info.dwLength
        ' Читаем данные
        ret = AVIStreamRead(vidStream, index + firstFrame, AVISTREAMREAD_CONVENIENT, ByVal 0&, 0, dataSize, sampleCount)
        If ret Then GoTo ErrHandler
        ReDim Preserve buffer(dataSize - 1)
        ret = AVIStreamRead(vidStream, index + firstFrame, AVISTREAMREAD_CONVENIENT, buffer(0), dataSize, dataSize, sampleCount)
        If ret Then GoTo ErrHandler
        ' Если это опорный кадр, то
        If curFrame = nextKeyFr Then
            isKeyFrame = True
            ' Ищем следующий опорный кадр
            nextKeyFr = AVIStreamFindSample(vidStream, nextKeyFr + 1, FIND_KEY Or FIND_NEXT)
        End If
 
        If dataSize Then
            ' Если текущий - опорный
            If isKeyFrame Then
                ' Записываем опорный
                ret = AVIStreamWrite(hNewStream, index, sampleCount, buffer(0), dataSize, AVIIF_KEYFRAME, sampleCount, dataSize)
                isKeyFrame = False
            Else
                ' Неопорный
                ret = AVIStreamWrite(hNewStream, index, sampleCount, buffer(0), dataSize, 0, sampleCount, dataSize)
            End If
            If ret Then GoTo ErrHandler
            
        End If
        ' Следующий кадр
        curFrame = curFrame + sampleCount
        index = index + sampleCount
        ' Обновляем прогрессбар
        prgProgress.Value = (index / info.dwLength) * 50
    Loop
    ' Освобождаем стрим
    AVIStreamRelease hNewStream:    hNewStream = 0
    
    Dim audStream   As Long
    Dim firstSample As Long
    Dim lastSample  As Long
    Dim timeStart   As Single
    Dim timeEnd     As Single
    Dim curSample   As Long
    Dim nextKeySmp  As Long
    ' Получаем аудио стрим из файла
    ret = AVIFileGetStream(hAvi, audStream, streamtypeAUDIO, 0)
    If ret Then
        ' Аудио стрима нет
        ret = 0
        GoTo ErrHandler
    End If
    ' Узнаем время кадров
    timeStart = firstFrame / (info.dwRate / info.dwScale)
    timeEnd = lastFrame / (info.dwRate / info.dwScale)
    ' Получаем параметры текущего аудио стрима
    AVIStreamInfo audStream, info, Len(info)
    ' Определяем семплы
    firstSample = AVIStreamFindSample(audStream, (info.dwRate / info.dwScale) * timeStart, FIND_KEY Or FIND_NEXT)
    lastSample = AVIStreamFindSample(audStream, (info.dwRate / info.dwScale) * timeEnd, FIND_KEY Or FIND_PREV)
    ' Создаем новый аудио стрим
    ret = AVIFileCreateStream(hNewFile, hNewStream, info)
    If ret Then GoTo ErrHandler
    info.dwLength = lastSample - firstSample
    ' Копируем формат
    ret = AVIStreamReadFormat(audStream, 0, ByVal 0, dataSize)
    If ret Then GoTo ErrHandler
    ReDim buffer(dataSize - 1)
    ret = AVIStreamReadFormat(audStream, 0, buffer(0), dataSize)
    If ret Then GoTo ErrHandler
    ret = AVIStreamSetFormat(hNewStream, 0, buffer(0), dataSize)
    If ret Then GoTo ErrHandler
    ' Проход по семплам и их копирование в новый файл
    curSample = firstSample
    nextKeySmp = curSample
    index = 0
    
    Do While index < info.dwLength
        ' Читаем данные
        ret = AVIStreamRead(audStream, index + firstSample, AVISTREAMREAD_CONVENIENT, ByVal 0&, 0, dataSize, sampleCount)
        If ret Then GoTo ErrHandler
        ReDim Preserve buffer(dataSize - 1)
        ret = AVIStreamRead(audStream, index + firstSample, AVISTREAMREAD_CONVENIENT, buffer(0), dataSize, dataSize, sampleCount)
        If ret Then GoTo ErrHandler
        ' Если это опорный семпл, то
        If curSample = nextKeySmp Then
            isKeyFrame = True
            ' Ищем следующий опорный кадр
            nextKeySmp = AVIStreamFindSample(audStream, nextKeySmp + sampleCount, FIND_KEY Or FIND_NEXT)
        End If
 
        If dataSize Then
            ' Если текущий - опорный
            If isKeyFrame Then
                ' Записываем опорный
                ret = AVIStreamWrite(hNewStream, index, sampleCount, buffer(0), dataSize, AVIIF_KEYFRAME, sampleCount, dataSize)
                isKeyFrame = False
            Else
                ' Неопорный
                ret = AVIStreamWrite(hNewStream, index, sampleCount, buffer(0), dataSize, 0, sampleCount, dataSize)
            End If
            If ret Then GoTo ErrHandler
 
        End If
        ' Следующий семпл (группа семплов)
        curSample = curSample + sampleCount
        index = index + sampleCount
        ' Обновляем прогрессбар
        prgProgress.Value = (index / info.dwLength) * 50 + 50
    Loop
    
    prgProgress.Visible = False
    
ErrHandler:
    ' Освобождаем ресурсы
    If audStream Then AVIStreamRelease audStream
    If hNewStream Then AVIStreamRelease hNewStream
    If hNewFile Then AVIFileRelease hNewFile
    
    If ret Then MsgBox "Error saving"
    
End Sub
 
' // Установить последний кадр
Private Sub cmdSetEnd_Click()
    If sldFrame.Value < sldFrame.SelStart Then Exit Sub
    sldFrame.SelLength = sldFrame.Value - sldFrame.SelStart
End Sub
 
' // Установить начальный кадр
Private Sub cmdSetStart_Click()
    sldFrame.SelStart = sldFrame.Value
End Sub
 
Private Sub Form_Load()
    AVIFileInit
    SetStretchBltMode picOut.hdc, HALFTONE
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Clear
    AVIFileExit
End Sub
 
' // Событие бросания файла на бокс
Private Sub picOut_OLEDragDrop(Data As DataObject, _
                               Effect As Long, _
                               Button As Integer, _
                               Shift As Integer, _
                               x As Single, _
                               y As Single)
    
    If IsAviFile(Data) Then
        LoadAVI Data.Files(1)
    End If
    
End Sub
 
' // Проверяем AVI ли файл?
Private Sub picOut_OLEDragOver(Data As DataObject, _
                               Effect As Long, _
                               Button As Integer, _
                               Shift As Integer, _
                               x As Single, _
                               y As Single, _
                               State As Integer)
    
    If IsAviFile(Data) Then Effect = ccOLEDropEffectMove Else Effect = ccOLEDropEffectNone
    
End Sub
 
' // Является ли AVI файлом
Private Function IsAviFile(Data As DataObject) As Boolean
    
    If Data.Files.Count = 1 Then
        Dim fileName As String
        
        fileName = Data.Files(1)
        
        IsAviFile = LCase(right(fileName, 4)) = ".avi"
        
    End If
        
End Function
 
Private Sub picOut_Paint()
    Update
End Sub
 
Private Sub sldFrame_Change()
    Update
End Sub
 
Private Sub sldFrame_Scroll()
    Update
End Sub