Attribute VB_Name = "modExtSW"
' -------------------------------------------------------------------------------
'
'   AVStoDVD - by MrC
'   File: modExtSW.bas
'   Purpose: External Sowftware Calls
'   Requirements: modShellEx.bas, modReg.bas
'
' -------------------------------------------------------------------------------


Option Explicit
Option Compare Binary
Option Base 0


' Shutdown system using Windows built in commands
Public Sub WinShutdown(Time As Long, Str As String)

    On Error GoTo Err_Handling
    
    Select Case SysInfo.WinVerPlatformID
    Case 1
        Select Case SysInfo.WinVerMajor
        Case 4
            Select Case SysInfo.WinVerMinor
            Case 0
                ' Win95
                modShellEx.Execute SysInfo.PathSystem & "\rundll.exe", "USER.EXE,ExitWindows", SW_DEFAULT, False
            Case Is >= 1
                ' Win98 -> WinMe
                modShellEx.Execute SysInfo.PathSystem & "\rundll32.exe", "SHELL32.DLL,SHExitWindowsEx 1", SW_DEFAULT, False
            Case Else
                GoTo Err_Handling
            End Select
        Case Else
            GoTo Err_Handling
        End Select
    Case 2
        Select Case SysInfo.WinVerMajor
        Case 4
            ' WinNT -> Win2k
            modShellEx.Execute SysInfo.PathSystem & "\shutdown.exe", "/L /T:" & Time & " /Y /C", SW_DEFAULT, False
        Case Is >= 5
            ' WinXP -> ...
            modShellEx.Execute SysInfo.PathSystem & "\shutdown.exe", "-s -t " & Time & " -f -c """ & Str & """", SW_DEFAULT, False
        Case Else
            GoTo Err_Handling
        End Select
    Case Else
        GoTo Err_Handling
    End Select
    
    Exit Sub
    
Err_Handling:
MsgBox "Cannot execute shutdown.", vbInformation, App.Title
    
End Sub


' Generate the audio track mapping flag for FFmpeg CLI
Public Function FFmpegAudioTracksMapping(PathName As String, AudioTrack As Integer) As String

    Dim MInfo As New clsMediaInfo
    Dim GeneralInfo As New clsTitleGeneralInfo
    Dim VideoInfo As New clsTitleVideoInfo

    On Error GoTo ErrHandling
    
    MInfo.ReadMediaInfo PathName, , False, True, True, False
    GeneralInfo.Initialize MInfo
    VideoInfo.Initialize MInfo
    
    If Val(GeneralInfo.AudioTracksCount) > 1 Then
        If InStr(1, UCase(VideoInfo.Compression), "MPEG-2") <> 0 And UCase(modFS.ExtOf(PathName)) = "VOB" Then
            FFmpegAudioTracksMapping = " -map 0:" & AudioTrack + 1
        Else
            FFmpegAudioTracksMapping = " -map 0:" & AudioTrack
        End If
    End If
    
    Set VideoInfo = Nothing
    Set GeneralInfo = Nothing
    Set MInfo = Nothing
    
    Exit Function

ErrHandling:
FFmpegAudioTracksMapping = ""

End Function


' Adjust DirectShow Audio Output Mixer
Public Sub AudioMixerChange(Optional InputChannels As Integer = 2, Optional OutputChannels As Integer = 2, Optional bLog As Boolean = False, Optional PathnameLog As String)

    Dim ffdshowChannelsConfig As Integer
    Dim LAVFiltersChannelsConfig As Integer
    Dim sLog As String
    
    Select Case InputChannels
    Case 1
        ffdshowChannelsConfig = 0      '"1/0/0"
    Case 5
        ffdshowChannelsConfig = 6      '"3/0/2"
    Case 6
        ffdshowChannelsConfig = 13     '"3/0/2 + LFE"
    Case Else 'default
        ffdshowChannelsConfig = 1      '"2/0/0"
    End Select
    'Select Case OutputChannels
    'Case 1
    '    LAVFiltersChannelsConfig = 4   '"Mono"
    'Case 5
    '    LAVFiltersChannelsConfig = 9   '"5.0" guessed for future support
    'Case 6
    '    LAVFiltersChannelsConfig = 63  '"5.1"
    'Case Else 'default
    '    LAVFiltersChannelsConfig = 3   '"Stereo"
    'End Select
    ' Adjust ffdshow mixer
    With ffdshow
        If .PathName <> "" Then
            .MixerEnabled = CBool(modReg.EmiLeggiChiaveNumero(.RegKey & "_audio\default", "isMixer", 0))
            .MixerBackup = modReg.EmiLeggiChiaveNumero(.RegKey & "_audio\default", "mixerOut", 1)
            If .MixerEnabled = False Then
                modReg.ScriviChiaveNumero .RegKey & "_audio\default", "isMixer", 1
                sLog = "ffdshow mixer ON/OFF changed from '0' to '1' at runtime" & vbCrLf
            Else
                sLog = sLog & "No ffdshow mixer ON/OFF adjustment required at runtime" & vbCrLf
            End If
            If .MixerBackup <> ffdshowChannelsConfig Then
                modReg.ScriviChiaveNumero .RegKey & "_audio\default", "mixerOut", ffdshowChannelsConfig
                sLog = sLog & "ffdshow mixer SETTING changed from '" & .MixerBackup & "' to '" & ffdshowChannelsConfig & "' at runtime" & vbCrLf
            Else
                sLog = sLog & "No ffdshow mixer SETTING adjustment required at runtime" & vbCrLf
            End If
        End If
    End With
    ' Adjust LAVFilters mixer
    With LAVFilters
        If .PathName <> "" Then
            .MixerEnabled = CBool(modReg.EmiLeggiChiaveNumero(.RegKey & "\Audio", "Mixing", 0))
            .MixerBackup = modReg.EmiLeggiChiaveNumero(.RegKey & "\Audio", "MixingLayout", 3)
            If .MixerEnabled = True Then
                modReg.ScriviChiaveNumero .RegKey & "\Audio", "Mixing", 0
                sLog = sLog & "LAV Filters mixer ON/OFF changed from '1' to '0' at runtime" & vbCrLf
            Else
                sLog = sLog & "No LAV Filters mixer ON/OFF adjustment required at runtime" & vbCrLf
            End If
            'If InputChannels = OutputChannels Then
            '    If .MixerEnabled = True Then
            '        modReg.ScriviChiaveNumero .RegKey & "\Audio", "Mixing", 0
            '        sLog = sLog & "LAV Filters mixer ON/OFF changed from '1' to '0' at runtime" & vbCrLf
            '    Else
            '        sLog = sLog & "No LAV Filters mixer ON/OFF adjustment required at runtime" & vbCrLf
            '    End If
            'Else
            '    If .MixerEnabled = False Then
            '        modReg.ScriviChiaveNumero .RegKey & "\Audio", "Mixing", 1
            '        sLog = sLog & "LAV Filters mixer ON/OFF changed from '0' to '1' at runtime" & vbCrLf
            '    Else
            '        sLog = sLog & "No LAV Filters mixer ON/OFF adjustment required at runtime" & vbCrLf
            '    End If
            '    If .MixerBackup <> LAVFiltersChannelsConfig Then
            '        modReg.ScriviChiaveNumero .RegKey & "\Audio", "MixingLayout", LAVFiltersChannelsConfig
            '        sLog = sLog & "LAV Filters mixer SETTING changed from '" & .MixerBackup & "' to '" & LAVFiltersChannelsConfig & "' at runtime" & vbCrLf
            '    Else
            '        sLog = sLog & "No LAV Filters mixer SETTING adjustment required at runtime" & vbCrLf
            '    End If
            'End If
        End If
    End With
    ' Log activities
    If bLog = True And sLog <> "" Then
        If Right(sLog, 2) = vbCrLf Then sLog = Left(sLog, Len(sLog) - 2)
        modMain.Save_Log PathnameLog, "DIRECTSHOW AUDIO MIXER OPERATIONS:" & vbCrLf & sLog, True
    End If

End Sub


' Restore DirectShow Audio Output Mixer to original value
Public Sub AudioMixerRestore(Optional bLog As Boolean = False, Optional PathnameLog As String)

    Dim sLog As String
    
    ' Restore ffdshow mixer
    With ffdshow
        If .PathName <> "" Then
            If .MixerEnabled = False Then
                modReg.ScriviChiaveNumero .RegKey & "_audio\default", "isMixer", 0
                sLog = "ffdshow mixer ON/OFF restored to '0'" & vbCrLf
            End If
            If modReg.EmiLeggiChiaveNumero(.RegKey & "_audio\default", "mixerOut", 1) <> .MixerBackup Then
                modReg.ScriviChiaveNumero .RegKey & "_audio\default", "mixerOut", .MixerBackup
                sLog = sLog & "ffdshow mixer SETTING restored to '" & .MixerBackup & "'" & vbCrLf
            End If
        End If
    End With
    ' Restore LAVFilters mixer
    With LAVFilters
        If .PathName <> "" Then
            If modReg.EmiLeggiChiaveNumero(.RegKey & "\Audio", "Mixing", 0) = 1 Then
                If .MixerEnabled = False Then
                    modReg.ScriviChiaveNumero .RegKey & "\Audio", "Mixing", 0
                    sLog = sLog & "LAV Filters mixer ON/OFF restored to '0'" & vbCrLf
                End If
                'If modReg.EmiLeggiChiaveNumero(.RegKey & "\Audio", "MixingLayout", 3) <> .MixerBackup Then
                '    modReg.ScriviChiaveNumero .RegKey & "\Audio", "MixingLayout", .MixerBackup
                '    sLog = sLog & "LAV Filters mixer SETTING restored to '" & .MixerBackup & "'" & vbCrLf
                'End If
            Else
                If .MixerEnabled = True Then
                    modReg.ScriviChiaveNumero .RegKey & "\Audio", "Mixing", 1
                    sLog = sLog & "LAV Filters mixer ON/OFF restored to '1'" & vbCrLf
                End If
            End If
        End If
    End With
    ' Log activities
    If bLog = True And sLog <> "" Then
        If Right(sLog, 2) = vbCrLf Then sLog = Left(sLog, Len(sLog) - 2)
        modMain.Save_Log PathnameLog, "DIRECTSHOW AUDIO MIXER OPERATIONS:" & vbCrLf & sLog, True
    End If

End Sub


Public Function AviSynth_FrameServing_Check(AVSScript As String, Optional MessageStr As String, Optional DeleteTempFiles As Boolean = True, Optional TrialsNum As Integer = 3) As Boolean

    Dim Str As String
    Dim sCL As String
    Dim AVIInfo As New clsMediaInfo
    Dim jj As Integer
    Dim TimeStart As Single
    Dim TimeOut As Single
    Dim AppPathName As String
    
    On Error GoTo Err_Handling
    
    Screen.MousePointer = vbHourglass
    
    If MessageStr = "" Then MessageStr = "Check in progress"
    TimeOut = 5 * 60  '5 min
    AppPathName = App.Path & "\FFmpeg\ffmpeg.exe"
    Str = modStr.RemoveStr(AVSScript, ".Normalize()")
    Str = Str & IIf(InStr(1, Str, "Return Video") <> 0, ".", vbCrLf) & "Trim(0,1)"
    modStr.STRtoANSIFile Str, Preferences.TempPath & "\AviSynthV.avs"
    
    Do
        AviSynth_FrameServing_Check = False
        jj = jj + 1
        TimeStart = Timer
        Load frmMessage
        With frmMessage
            .Initialize "AVStoDVD - FrameServing Check", MessageStr & " (Trial " & jj & "/" & TrialsNum & ")" & vbCrLf & vbCrLf & "Please wait ...", False, False, False
            .Show 0, frmMain
            sCL = "-i " & """" & Preferences.TempPath & "\AviSynthV.avs""" & " -y -an -r 25 -b 200000 -s qvga """ & Preferences.TempPath & "\AviSynthV.avi"""
            modShellEx.Execute AppPathName, sCL, SW_HIDE, False
            Do
                DoEvents
                modUtil.Sleep 500
            Loop Until modUtil.FindRunningProcess(AppPathName) = 0 Or Timer - TimeStart > TimeOut
            'DoEvents
            modUtil.Sleep 1000
            Str = MessageStr & " (Trial " & jj & "/" & TrialsNum & ")" & vbCrLf & vbCrLf & "Failed!"
            If Timer - TimeStart > TimeOut Then
                modUtil.KillRunningProcess AppPathName
                Str = Str & " TimeOut reached!"
            Else
                If AVIInfo.ReadMediaInfo(Preferences.TempPath & "\AviSynthV.avi", , False, True, False, False) = True Then
                    If Val(AVIInfo.VideoFrameCount) = 2 Then
                        AviSynth_FrameServing_Check = True
                        Str = vbCrLf & "Check completed successfully!"
                    End If
                End If
                Set AVIInfo = Nothing
            End If
            .Update Str
            modUtil.Sleep 1000
        End With
        Unload frmMessage
        modFS.DeleteIfExist Preferences.TempPath & "\AviSynthV.avi"
        modFS.DeleteIfExist Preferences.TempPath & "\A2DVideoInfo.cache"
        modFS.DeleteIfExist Preferences.TempPath & "\A2DAudioInfo.cache"
        modUtil.KillRunningProcess AppPathName
    Loop Until jj = TrialsNum Or AviSynth_FrameServing_Check = True
    
    If DeleteTempFiles = True Then
        modFS.DeleteIfExist Preferences.TempPath & "\AviSynthV.avs"
    End If
    
    Screen.MousePointer = Default

    Exit Function
    
Err_Handling:
If modUtil.FormIsLoad("frmMessage") = True Then Unload frmMessage
modUtil.KillRunningProcess AppPathName
AviSynth_FrameServing_Check = False
Screen.MousePointer = Default

End Function


' Build xml profile file for SubtitleCreator
Public Function Build_SC_Profile_xml(Title As TitleSettings, SubsFont As MyFont, SubsPos As SubPosOptions, Optional UseLocalAppDataFolder As Boolean = True) As Boolean

    Dim FontStr As String
    Dim XmlStr As String
    Dim LocalAppDataFolder As String
    Dim PathName As String
    Dim bFlag As Boolean
    Dim iWidth As Integer
    Dim iLeft As Integer
    Dim iTopPAL As Integer
    Dim iTopNTSC As Integer
    Dim iStHor As Integer
    Dim iStVerPAL As Integer
    Dim iStVerNTSC As Integer
    
    On Error GoTo Err_Handling
    
    ' Define factors
    With SubsFont
        FontStr = "<Font Name=""" & .Name & """ Size=""" & .Height & """ Style="""
        If .Italic = True Then
            If .Bold = True Then
                FontStr = FontStr & "Bold, Italic"
            Else
                FontStr = FontStr & "Italic"
            End If
        Else
            If .Bold = True Then
                FontStr = FontStr & "Bold"
            Else
                FontStr = FontStr & "Regular"
            End If
        End If
        FontStr = FontStr & """ Outline=""5"" />"
    End With
    With SubsPos
        iLeft = .Left
        iWidth = .Width
        iTopPAL = 576 - Int(576 / 540 * .Bottom)
        iTopNTSC = 480 - Int(480 / 540 * .Bottom)
        iStHor = 100
        iStVerPAL = 95
        iStVerNTSC = 80
        Select Case Title.VideoResolution
        Case Half_D1
            iLeft = Round(iLeft / 2)
            iWidth = Round(iWidth / 2)
            iStHor = 50
        Case VCD
            iLeft = Round(iLeft / 2)
            iWidth = Round(iWidth / 2)
            iTopPAL = 288 - Int(288 / 264 * .Bottom * 0.66)
            iTopNTSC = 240 - Int(240 / 264 * .Bottom * 0.66)
            iStHor = 50
            iStVerPAL = 45
            iStVerNTSC = 40
        End Select
    End With
    
    ' Build string
    XmlStr = "<?xml version=""1.0"" encoding=""utf-16""?>" & vbCrLf & vbCrLf & _
          "<Profiles>" & vbCrLf & _
          "<Profile Name=""AVStoDVD PAL 4:3"">" & vbCrLf & _
          FontStr & vbCrLf & _
          "<Window DistanceToLeftBorder=""" & iLeft & """ DistanceToTopBorder=""" & iTopPAL & """ Width=""" & iWidth & """ />" & vbCrLf & _
          "<Stretch Horizontal=""" & iStHor & """ Vertical=""" & iStVerPAL & """ />" & vbCrLf & _
          "<LineHeight Value=""100"" />" & vbCrLf & _
          "<Formatting Lines=""2"" Wrap=""True"" VerticalAlignment=""3"" VerticalFont=""False"" />" & vbCrLf & _
          "</Profile>" & vbCrLf & _
          "<Profile Name=""AVStoDVD PAL 16:9"">" & vbCrLf & _
          FontStr & vbCrLf & _
          "<Window DistanceToLeftBorder=""" & iLeft & """ DistanceToTopBorder=""" & iTopPAL - 10 & """ Width=""" & iWidth & """ />" & vbCrLf & _
          "<Stretch Horizontal=""" & iStHor & """ Vertical=""" & iStVerPAL + 30 & """ />" & vbCrLf & _
          "<LineHeight Value=""100"" />" & vbCrLf & _
          "<Formatting Lines=""3"" Wrap=""True"" VerticalAlignment=""3"" VerticalFont=""False"" />" & vbCrLf & _
          "</Profile>" & vbCrLf
    XmlStr = XmlStr & _
          "<Profile Name=""AVStoDVD NTSC 4:3"">" & vbCrLf & _
          FontStr & vbCrLf & _
          "<Window DistanceToLeftBorder=""" & iLeft & """ DistanceToTopBorder=""" & iTopNTSC & """ Width=""" & iWidth & """ />" & vbCrLf & _
          "<Stretch Horizontal=""" & iStHor & """ Vertical=""" & iStVerNTSC & """ />" & vbCrLf & _
          "<LineHeight Value=""100"" />" & vbCrLf & _
          "<Formatting Lines=""2"" Wrap=""True"" VerticalAlignment=""3"" VerticalFont=""False"" />" & vbCrLf & _
          "</Profile>" & vbCrLf & _
          "<Profile Name=""AVStoDVD NTSC 16:9"">" & vbCrLf & _
          FontStr & vbCrLf & _
          "<Window DistanceToLeftBorder=""" & iLeft & """ DistanceToTopBorder=""" & iTopNTSC - 20 & """ Width=""" & iWidth & """ />" & vbCrLf & _
          "<Stretch Horizontal=""" & iStHor & """ Vertical=""" & iStVerNTSC + 30 & """ />" & vbCrLf & _
          "<LineHeight Value=""100"" />" & vbCrLf & _
          "<Formatting Lines=""3"" Wrap=""True"" VerticalAlignment=""3"" VerticalFont=""False"" />" & vbCrLf & _
          "</Profile>" & vbCrLf & _
          "</Profiles>"
    
    If UseLocalAppDataFolder = True Then
        LocalAppDataFolder = SysInfo.PathLocalAppData
        If modFS.EsisteDir(LocalAppDataFolder) = True Or modFS.EsisteDir(LocalAppDataFolder, , vbHidden) = True Then
            If modFS.EsisteDir(LocalAppDataFolder & "\SubtitleCreator") = False Then
                bFlag = modFS.CreateDir(LocalAppDataFolder & "\SubtitleCreator")
            Else
                bFlag = True
            End If
        End If
    End If
    
    If bFlag = True Then
        PathName = LocalAppDataFolder & "\SubtitleCreator\Profiles.xml"
    Else
        PathName = App.Path & "\SubtitleCreator\Data\Profiles.xml"
    End If
    
    ' Save xml file
    Call modStr.sANSItoUTF8File(XmlStr, PathName)
    
    Build_SC_Profile_xml = modFS.EsisteFile(PathName)

    Exit Function
    
Err_Handling:
Build_SC_Profile_xml = False

End Function


' Build .style text file to be used with TextSub() AviSynth filter for hard encoded SubRip (SRT) and MicroDVD (SUB, TXT) subtitles
Public Function Build_TextSub_Style(Title As TitleSettings, Optional SubsNum As Integer = 1, Optional OutputPath As String) As String

    Dim bFlag As Boolean
    Dim sStyle As String
    Dim sColor As String
    Dim iScaleX As Integer
    Dim iScaleY As Integer
    Dim iShadow As Integer
    Dim iMarginV As Integer
    Dim TempPathName As String
    Dim sExt As String
    
    On Error GoTo Err_Handling
    
    If OutputPath = "" Then OutputPath = Preferences.TempPath
    
    With Title
        Select Case .InputSubsInfo(SubsNum).Format
        Case "SubRip"
            sExt = "srt"
        Case "MicroDVD"
            sExt = "txt"
        End Select
        If sExt <> "" Then
            TempPathName = OutputPath & "\" & modFS.NameOf(.InputSubsPathName(SubsNum)) & ".a2d." & sExt
            If .SubsHardEncode(SubsNum) = True Then
                modFS.DeleteIfExist TempPathName
                FileCopy .InputSubsPathName(SubsNum), TempPathName
                If modFS.EsisteFile(TempPathName) = True Then
                    bFlag = False
                    If Preferences.SubsFont.Name <> PreferencesDefault.SubsFont.Name Then
                        bFlag = True
                    ElseIf Preferences.SubsFont.Height <> PreferencesDefault.SubsFont.Height Then
                        bFlag = True
                    ElseIf Preferences.SubsFont.Color <> PreferencesDefault.SubsFont.Color Then
                        bFlag = True
                    ElseIf Preferences.SubsFont.Bold <> PreferencesDefault.SubsFont.Bold Then
                        bFlag = True
                    ElseIf Preferences.SubsFont.Italic <> PreferencesDefault.SubsFont.Italic Then
                        bFlag = True
                    ElseIf Preferences.SubsFont.Underline <> PreferencesDefault.SubsFont.Underline Then
                        bFlag = True
                    End If
                    If bFlag = True Then
                        sStyle = "[Script Info]" & vbCrLf & _
                                 "Title: " & TempPathName & ".style" & vbCrLf & _
                                 "Original Script: AVStoDVD" & vbCrLf & _
                                 "ScriptType: v4.00+" & vbCrLf & _
                                 "WrapStyle: 0" & vbCrLf & _
                                 "PlayResX: 720" & vbCrLf & vbCrLf & _
                                 "[V4+ Styles]" & vbCrLf & _
                                 "Format: Name, Fontname, Fontsize, PrimaryColour, SecondaryColour, OutlineColour, BackColour, Bold, Italic, Underline, StrikeOut, ScaleX, ScaleY, Spacing, Angle, BorderStyle, Outline, Shadow, Alignment, MarginL, MarginR, MarginV, Encoding" & vbCrLf & _
                                 "Style: Default,"
                        sColor = modStr.CHex(Preferences.SubsFont.Color)
                        sColor = Mid(sColor, 5, 2) & Mid(sColor, 3, 2) & Mid(sColor, 1, 2)
                        sStyle = sStyle & Preferences.SubsFont.Name & "," & Preferences.SubsFont.Height & ",&H00" & sColor & ",&H00000000,&H00000000,&H00000000," & -CInt(Preferences.SubsFont.Bold) & "," & -CInt(Preferences.SubsFont.Italic) & "," & -CInt(Preferences.SubsFont.Underline) & ",0,"
                        iScaleX = 130
                        If VideoStandard = NTSC Then iScaleX = 150
                        iScaleY = 130
                        iMarginV = 40
                        If .VideoAspectRatio = Widescreen Then
                            iScaleY = 160
                            iMarginV = 30
                        End If
                        Select Case .VideoResolution
                        Case Full_D1
                            iShadow = 2
                        Case Half_D1
                            iScaleX = Int(iScaleX / 2)
                            iShadow = 1
                        Case VCD
                            iShadow = 0
                        End Select
                        sStyle = sStyle & iScaleX & "," & iScaleY & ",0,0,1,2," & iShadow & ",2,10,10," & iMarginV & ",1"
                        Call modStr.sANSItoUTF8File(sStyle, TempPathName & ".style")
                    End If
                End If
            End If
        End If
    End With
    
    If modFS.EsisteFile(TempPathName & ".style") = True Then
        Build_TextSub_Style = TempPathName & ".style"
    End If
    
    Exit Function
    
Err_Handling:
Build_TextSub_Style = ""

End Function


' Obsolete
Public Function CQ_Factor_HCenc(AVS_PathName As String, Encoder_PathName As String, Target_FileSize_MB As String, Optional Start_CQ As String, Optional Perc_Analysis As String, Optional Num_Segments As Integer, Optional TempPath As String, Optional MaxBitRate As String, Optional WideScreen_Flag As Boolean, Optional Interlaced_Flag As Boolean, Optional DC_Prec As String, Optional Close_GOP As Boolean, Optional Matrix As String, Optional MaxTrials As Integer, Optional DeleteTemp As Boolean) As String
 
    Dim AVS_Script_Prediction As String
    Dim NumFile As Integer
    Dim sCL As String
    Dim HCenc_ini As String
    Dim Result_FileSize_MB As Single
    Dim Corr_CQ As Single
    Dim CQ As Single
    Dim Trials As Integer
    Dim Error As Single
    Dim Flag As Boolean
    
    On Error GoTo Err_Handling
    
    If Start_CQ = "" Then
        CQ = 2.5
    Else
        CQ = Val(Start_CQ)
    End If
    If Perc_Analysis = "" Then Perc_Analysis = "0.05"
    If Num_Segments = 0 Then Num_Segments = 5
    If TempPath = "" Then TempPath = Environ("TEMP")
    If MaxBitRate = "" Then MaxBitRate = "9000"
    If DC_Prec = "" Then DC_Prec = "8"
    If Matrix = "" Then Matrix = "MPEG"
    If MaxTrials = 0 Then MaxTrials = 5
    AVS_Script_Prediction = "AudioVideo = Import(""" & AVS_PathName & """)" & vbCrLf & _
                            "AudioVideoTrim = Trim(AudioVideo, Int(0.00*AudioVideo.FrameCount), Int(1.00*AudioVideo.FrameCount))" & vbCrLf & _
                            "VideoPrediction = SelectRangeEvery(AudioVideoTrim, Int(AudioVideoTrim.FrameCount/" & Num_Segments & "), Int(" & Perc_Analysis & "*AudioVideoTrim.FrameCount/" & Num_Segments & "), audio=false)" & vbCrLf & _
                            "Return VideoPrediction"
    NumFile = FreeFile
    Open TempPath & "\AviSynthCQP.avs" For Output As #NumFile
        Print #NumFile, AVS_Script_Prediction
    Close #NumFile
    
    Do
        HCenc_ini = "*INFILE " & TempPath & "\AviSynthCQP.avs" & vbCrLf & _
                    "*OUTFILE " & TempPath & "\VideoCQP.m2v" & vbCrLf & _
                    "*CQ_MAXBITRATE " & Replace(CStr(CQ), ",", ".") & vbCrLf & _
                    "*MAXBITRATE " & MaxBitRate & vbCrLf & _
                    "*ASPECT " & IIf(WideScreen_Flag = True, "16:9 ", "4:3 ") & vbCrLf & _
                    IIf(Interlaced_Flag = True, "*INTERLACED", "*PROGRESSIVE") & vbCrLf & _
                    "*DC_PREC " & DC_Prec & vbCrLf & _
                    IIf(Close_GOP = True, "*CLOSEDGOPS" & vbCrLf, "") & _
                    "*MATRIX " & Matrix & vbCrLf & _
                    "*SMP" & vbCrLf
        Select Case Preferences.EncodingPriority
        Case 0
            HCenc_ini = HCenc_ini & _
                    "*PRIORITY IDLE" & vbCrLf
        Case 1
            HCenc_ini = HCenc_ini & _
                    "*PRIORITY LOW" & vbCrLf
        Case 2, 3
            HCenc_ini = HCenc_ini & _
                    "*PRIORITY NORMAL" & vbCrLf
        Case 4, 5
            HCenc_ini = HCenc_ini & _
                    "*PRIORITY HIGH" & vbCrLf
        End Select
        HCenc_ini = HCenc_ini & _
                    "*WAIT 2"
        NumFile = FreeFile
        Open TempPath & "\HCencCQP.ini" For Output As #NumFile
        Print #NumFile, HCenc_ini
        Close #NumFile
        sCL = "-ini """ & TempPath & "\HCencCQP.ini"""
        modShellEx.Execute Encoder_PathName, sCL, SW_DEFAULT, True
        Result_FileSize_MB = Round(Val(modUtil.GetFileSize(TempPath & "\VideoCQP.m2v")) / 1024 / 1024 / Val(Perc_Analysis), 1)
        Corr_CQ = ((CQ / Val(Target_FileSize_MB) * Result_FileSize_MB) - CQ)
        Trials = Trials + 1
        CQ = CQ + Corr_CQ
        Error = (Result_FileSize_MB - Val(Target_FileSize_MB)) / Val(Target_FileSize_MB)
        If DeleteTemp = False Then
            NumFile = FreeFile
            Open TempPath & "\AVStoDVD_CQP_Debug.log" For Append As #NumFile
                Print #NumFile, Now() & ": Trial " & Trials & vbCrLf & _
                                Now() & ": CQ " & Round(CQ - Corr_CQ, 3) & vbCrLf & _
                                Now() & ": Target FileSize " & Val(Target_FileSize_MB) & " MB" & vbCrLf & _
                                Now() & ": Extimated FileSize " & Result_FileSize_MB & " MB" & vbCrLf & _
                                Now() & ": Error " & Format(Error, "0.00%") & vbCrLf
            Close #NumFile
        End If
        If Error < 0.01 And Error > -0.05 Then
            Flag = True
        ElseIf Trials >= MaxTrials Then
            Flag = True
        ElseIf CQ < 1 Then
            Flag = True
        End If
    Loop Until Flag = True
    
    CQ_Factor_HCenc = Replace(CStr(Round(CQ - Corr_CQ, 3)), ",", ".")
    
Err_Handling:
If CQ < 1 Then CQ_Factor_HCenc = 1
If DeleteTemp = True Then
    modFS.DeleteIfExist TempPath & "\HCencCQP.ini"
    modFS.DeleteIfExist TempPath & "\VideoCQP.m2v"
    modFS.DeleteIfExist TempPath & "\AviSynthCQP.m2v"
    modFS.DeleteIfExist TempPath & "\AviSynthCQP.avs"
Else
    NumFile = FreeFile
    Open TempPath & "\AVStoDVD_CQP_Debug.log" For Append As #NumFile
        Print #NumFile, Now() & ": CQ Factor " & CQ_Factor_HCenc & vbCrLf & _
                        Now() & ": End of CQ Prediction routine" & vbCrLf & vbCrLf & _
                        String(10, "-") & vbCrLf & vbCrLf
    Close #NumFile
End If
 
End Function


