This Windows Desktop application will create an mp3/mp4 files from a text file. These files can then be uploaded to YouTube or Audible.
Introduction
This application lets you create an audio book using OpenAI API . The application will generate mp3 file for each paragraph and then merge them together.
To create an audio book (from 0.5 MB of text) using OpenAI's text-to-speech service costs only about $7.50 . Doing this with ElevenLabs would cost $99 .
If you have a pdf file, the text file needs to be generated by opening the pdf file in Word and copied and pasted to a text file. Open the text file in a text editor that has line numbers such as Notepad2 . Open the file in and remove text that would not be read like: table of contents, footnotes, index and references. Each paragraph must be on one line.
There is a 0.3 second pause between paragraphs. One blank line means 1 second pause. Two blank lines means new Chapter.
One blank line means 1 second pause. But you can use the “Silence ” feature to customize the pause duration.
How to Create an Audiobook
First get API Key from OpenAI (https://platform.openai.com ) Select OpenAI “Voice”. A custom voice can be created and used. “Say it” will generate mp3 file based on any text and place the file into Temp folder in the same folder and the EXE. “Highlight text when” option helps you with text file correction and editing before to generate the mp3 files. For example, “Begins with lower case character” and “Begins with a number” option will highlight paragraphs that might be broken during Word PDF conversion. “Contains number” might help identify paragraphs that contain a footnote number. “Save text file” saved the changes in the text file. “Backup text file” option creates a backup to let you undo the changes you made to the text file. The backup text files will be placed in the folder with the same name as the text file name plus “_backup ”. “1. Process Text File ” will generate MP3 file for each line in the text file. This might cost you about $3-20 depending on the size of the file. (The current price is $7 to 15 per 0.5 MB. An average book is about 0.25 MB.) The file will be placed in the folder with the same name as the text file name. Each file will be named after the line number in the text file like 0001.mp3 . This means that you should not add or delete lines to the text file after MP3 files are generated. Select a line in the grid and click Play to play an MP3 file. Click Stop to stop the mp3 file playing. Select a line in the grid and click Delete to delete an MP3 file. You can delete bad mp3 files and click 1. Process Text File again to regenerate the mp3 files that were deleted. You can also select a line in the grid and click Regenerate to re-create the MP3 file. This option will also save the text file if needed. Play on key up option allows you to listen to the entire book by pressing the arrow down key after selecting a line text.Once you are satisfied with the quality of the generated mp3 files, click 2. MP3 Chapters to generate mp3 file for each chapter. Two blank lines in the text file means new Chapter. The files will be placed in the folder with the same name as the text file name plus -Chapters. Merge MP3 Chapter files into one mp3 file. The mp3 file will be placed in the folder as the text file and have the same name but with mp3 extension.
To add figure image file for each paraph:
Create an "images" folder. This will show "Figures" panel on the form. Create "Figure" folder inside of the "images" folder. Place image files like: 1-1.png. If any paragraph text will reference "Figure 1-1", it will include 1-1.png in the video file. Create "Table" folder inside of the "images" folder. Place image files like: 1-1.png. If any paragraph text will reference "Table 1-1", it will include 1-1.png in the video file.
Uploading Audiobook to YouTube
First select Image file to be used for mp4 file generation. 3. Make MP4 Files will generate mp4 file for each chapter. This operation uses mp3 files from -Chapters folder. This operation can take about 8 hours. These files can then be uploaded to YouTube. The files will be placed in the folder with the same name as the text file name plus -Videos Make Video File will generate one mp4 file. These files can then be uploaded to YouTube. The file will be generated by merging MP4 chapter files if they are available. MP4 chapter files are not available. The single mp3 file will be used, but the operation can take about 8 hours. The MP4 file will be placed in the folder as the text file and have the same name but with mp4 extension.Generate YouTube index from Chapters mp3 file duration. The index can be used in the Video description or the comment section. Note that MP4 files night be generated with a different duration so the Index might need to be adjusted.
Here is an audiobook I created using this app.
VIDEO
Using the Code
Code is using ffmpeg.exe to convert mp3 to mp4 and change mp3 bitrate. Here is the VB.NET code for the main form:
Imports System.Net
Imports System.IO
Public Class Form1
Dim sModelId As String = " tts-1-hd"
Dim sVoiceId As String = " alloy"
Dim oAppSetting As New AppSetting()
Dim bStop As Boolean = False
Dim sFirstChapterName As String = " Preface"
Dim oImageList As New Hashtable
Dim oLineImages As New Hashtable()
Private Sub Form1_Load(sender As Object , e As EventArgs) Handles MyBase .Load
selSilence.SelectedIndex = 0
oAppSetting.LoadData()
txtImageFile.Text = oAppSetting.GetValue(" ImageFile" )
txtSrcFile.Text = oAppSetting.GetValue(" SrcFile" )
txtText.Text = oAppSetting.GetValue(" Text" )
txtApiKey.Text = oAppSetting.GetValue(" ApiKey" )
If oAppSetting.GetValue(" TextColor" ) <> " " Then
btnTextColor.BackColor = Color.FromArgb(oAppSetting.GetValue(" TextColor" ))
End If
If oAppSetting.GetValue(" BackColor" ) <> " " Then
btnBgColor.BackColor = Color.FromArgb(oAppSetting.GetValue(" BackColor" ))
End If
If oAppSetting.GetValue(" BottomMargin" ) <> " " Then
txtBottomMargin.Text = oAppSetting.GetValue(" BottomMargin" )
End If
txtLeftMargin.Text = oAppSetting.GetValue(" LeftMargin" )
If txtApiKey.Text <> " " Then
txtApiKey.PasswordChar = " *"
End If
If IO.File.Exists(txtSrcFile.Text) = False Then
txtSrcFile.Text = " "
End If
If IO.File.Exists(txtImageFile.Text) = False Then
txtImageFile.Text = " "
End If
Dim sVoice As String = oAppSetting.GetValue(" Voice" , " alloy" )
If sVoice = " alloy" Then
cbVoice.SelectedIndex = 0
ElseIf sVoice <> " " Then
For i As Integer = 0 To cbVoice.Items.Count - 1
If cbVoice.Items(i) = sVoice Then
cbVoice.SelectedIndex = i
Exit For
End If
Next
End If
UpdateFileGrid()
Dim sSelectedRowIndex As String = oAppSetting.GetValue(" SelectedRowIndex" )
If sSelectedRowIndex <> " " Then
Dim iRowIndex As Integer = sSelectedRowIndex
If iRowIndex <> -1 AndAlso iRowIndex <DataGridView1.RowCount Then
DataGridView1.MultiSelect= False
DataGridView1.Rows(iRowIndex).Cells(0 ).Selected = True
SetupLineText()
End If
End If
Dim sTootip As String = " "
ToolTip1.AutoPopDelay = 32767
ToolTip1.SetToolTip(btnProcessTextFile, " Generate MP3 file for each line in the text file. " & vbCrLf &
" This might cost you about $5 depending on the size of the file." & vbCrLf &
" The file will be placed in the folder with the same name as the text file name. " & vbCrLf &
" Each file will be named after the line number in the text file like 0001.mp3. " & vbCrLf &
" This means that you should not add or deleted lines to the text file after MP3 files are generated." )
ToolTip1.SetToolTip(btnChapters, " Generate MP3 file for each chapter. Two blank lines in the text file means new Chapter." & vbCrLf &
" The files will be placed in the folder with the same name as the text file name plus -Chapters" )
ToolTip1.SetToolTip(btnMakeVideos, " Generate MP4 file for each chapter. This operation uses mp3 files from -Chapters folder." & vbCrLf &
" This operation can take about 8 hours. These files can then be uploaded to YouTube." & vbCrLf &
" The files will be placed in the folder with the same name as the text file name plus -Videos" )
ToolTip1.SetToolTip(btnMerge, " Merge MP3 Chapter files into one MP3 file." & vbCrLf &
" The MP3 file will be placed in the folder as the text file and have the same name but with MP3 extension." )
ToolTip1.SetToolTip(btnMakeVideo, " Generate one MP4 file. These file can then be uploaded to YouTube. " & vbCrLf &
" The file will be generated by merging MP4 chapter files if they are available. " & vbCrLf &
" If MP4 chapter files are not available the single MP3 file will be used but the operation can take about 8 hours." & vbCrLf &
" The MP4 file will be placed in the folder as the text file and have the same name but with MP4 extension." )
ToolTip1.SetToolTip(btnYouTubeIndex, " Generate YouTube index from Chapters MP3 file duration. " & vbCrLf &
" The index can be used in the Video description or the comment section. " & vbCrLf &
" Note that MP4 files night be generated with a different duration so the Index might need to be adjusted." )
ToolTip1.SetToolTip(btnPlay, " Select a line in the grid and click play to MP3 file." )
ToolTip1.SetToolTip(btnStopPlay, " Click to stop the MP3 file playing" )
ToolTip1.SetToolTip(btnDelete, " Select a line in the grid and click delete to MP3 file." )
ToolTip1.SetToolTip(btnReGenerate, " Select a line in the grid and click Generate (to save the text file if needed) and re-create the MP3 file." )
ToolTip1.SetToolTip(btnSave, " Save the changes in the text file" )
ToolTip1.SetToolTip(chkPlayOnKeyUp, " This option allows you to listen to the entire book by pressing the arrow down key after selecting a line text." )
ToolTip1.SetToolTip(selHighlight, " This option helps you with text file correction and editing before to generating the mp3 files." )
sTootip = " For testing generate mp3 file based on any text"
ToolTip1.SetToolTip(txtText, sTootip)
ToolTip1.SetToolTip(btnSayIt, sTootip)
sTootip = " API Key from OPEN AI (https://openai.com/pricing)"
ToolTip1.SetToolTip(txtApiKey, sTootip)
ToolTip1.SetToolTip(btnApiKeyShow, sTootip)
sTootip = " If you have pdf file, the text file can be generated by opening the pdf file in Word and copy and pasting to a text file." & vbCrLf &
" Open the text file in a text editor that has line numbers (such as Notepad2). "
ToolTip1.SetToolTip(txtSrcFile, sTootip)
ToolTip1.SetToolTip(btnSrcFile, sTootip)
sTootip = " Image file to be used for mp4 file generation."
ToolTip1.SetToolTip(txtImageFile, sTootip)
ToolTip1.SetToolTip(btnImageFile, sTootip)
sTootip = " One blank line means 1 second pause. Use this in case you need to customize the pause duration."
ToolTip1.SetToolTip(selSilence, sTootip)
ToolTip1.SetToolTip(btnSilence, sTootip)
ToolTip1.SetToolTip(chkBackupFile, " Use this option if you want to undo the changes you made to the text file. " &
" The backup text files will be placed in the folder with the same name as the text file name plus _backup" )
ToolTip1.SetToolTip(btnCreateLineVideos, " Create MP4 for each line. " &
" Usefull if you have a image folder and each line references images in this folder." )
ToolTip1.SetToolTip(btnCheckImages, " Make sure that images get referenced in the text." )
ToolTip1.SetToolTip(btnProcessChapter, " Process lines from the selected line until a blank line?" &
" This is useful for using different voice for different sections." )
ToolTip1.SetToolTip(urlApiKey, " Profile > API Key" )
ToolTip1.SetToolTip(chkImageText, " Add Chapter file name to the video file image" )
ToolTip1.SetToolTip(btnRenameDown, " Rename file for the selected row and subsequent files by + 1? " & vbCrLf &
" This is useful for inserting a line into the text if mp3 files are already generated." )
End Sub
Private Sub Form1_FormClosing(sender As Object , e As System.Windows.Forms.FormClosingEventArgs) Handles Me .FormClosing
oAppSetting.SetValue(" Voice" , cbVoice.Text)
oAppSetting.SetValue(" SrcFile" , txtSrcFile.Text)
oAppSetting.SetValue(" ImageFile" , txtImageFile.Text)
oAppSetting.SetValue(" Text" , txtText.Text)
oAppSetting.SetValue(" ApiKey" , txtApiKey.Text)
oAppSetting.SetValue(" SelectedRowIndex" , GetSelectedRowIndex())
oAppSetting.SetValue(" TextColor" , btnTextColor.BackColor.ToArgb())
oAppSetting.SetValue(" BackColor" , btnBgColor.BackColor.ToArgb())
oAppSetting.SetValue(" BottomMargin" , txtBottomMargin.Text)
oAppSetting.SetValue(" LeftMargin" , txtLeftMargin.Text)
oAppSetting.SaveData()
End Sub
Private Sub btnStop_Click(sender As Object , e As EventArgs) Handles btnStop.Click
bStop = True
End Sub
Private Sub btnProcessTextFile_Click(sender As Object , e As EventArgs) Handles btnProcessTextFile.Click
If MsgBox(" Are you sure you want to process the text file? This might cost you about $5." , vbYesNo) <> vbYes Then
Exit Sub
End If
btnProcessTextFile.Enabled = False
My.Application.DoEvents()
ProcessTextFile(0 )
UpdateFileGrid()
btnProcessTextFile.Enabled = True
MsgBox(" Done" )
End Sub
Function CheckForSilence(sLine As String ) As String
For i As Integer = 1 To 9
If sLine.IndexOf(" {{" & i.ToString() & " 00ms.mp3}}" ) <> -1 Then
Return i.ToString() & " 00ms.mp3"
End If
Next
Return " "
End Function
Sub ProcessTextFile(ByVal iProcessRow As Integer )
If txtApiKey.Text = " " Then
MsgBox(" API Key is missing" )
Exit Sub
End If
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " OrElse IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = " "
MsgBox(" Text file is blank" )
Exit Sub
End If
Dim sMp3FolderePath As String = GetFolderPath(" mp3" )
If sMp3FolderePath = " " Then
MsgBox(" Could not find mp3 folder" )
Exit Sub
End If
Dim sBlankFilePath As String = sMp3FolderePath & " \1sec.mp3"
If IO.File.Exists(sBlankFilePath) = False Then
MsgBox(" Could not find " & sBlankFilePath)
Exit Sub
End If
Dim sVoice As String = cbVoice.Text
If sVoice <> " " Then
sVoiceId = sVoice
End If
If iProcessRow = 0 Then
lbCount.Visible = True
btnStop.Visible = True
ProgressBar1.Visible = True
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sDestFolderPath As String = Path.Combine(sFolderPath, sFileName)
If Not System.IO.Directory.Exists(sDestFolderPath) Then
System.IO.Directory.CreateDirectory(sDestFolderPath)
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
If iRows = 0 Then
Exit Sub
End If
Dim iMaxSize As Integer = iRows.ToString().Length
If iProcessRow = 0 Then
ProgressBar1.Maximum = iRows
End If
Dim iRow As Integer = 0
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
iRow += 1
If iProcessRow = 0 OrElse iRow = iProcessRow Then
If iProcessRow = 0 Then
lbCount.Text = iRow & " /" & iRows
End If
Dim sDestFileBase As String = Microsoft.VisualBasic.Right(" 000000" & iRow, iMaxSize)
Dim sDestFileName As String = sDestFileBase & " .mp3"
Dim sDestFilePath As String = Path.Combine(sDestFolderPath, sDestFileName)
sLine = Trim(sLine) & " "
If IO.File.Exists(sDestFilePath) = False Then
Dim sSilenceFile As String = CheckForSilence(sLine)
If sSilenceFile <> " " Then
IO.File.Copy(sMp3FolderePath & " \" & sSilenceFile, sDestFilePath)
ElseIf Trim(sLine) = " " Or Trim(sLine) = " {{1sec.mp3}}" Then
IO.File.Copy(sBlankFilePath, sDestFilePath)
Else
If TextToSpeach(sLine, sDestFilePath) Then
Else
If iProcessRow = 0 Then
If MsgBox(" Could not generate file for line: " & iRow & " , Stop Processing?" , vbYesNo) = vbYes Then
ResetProgressBar()
oStreamReader.Close()
Exit Sub
End If
Else
MsgBox(" Could not generate file for line: " & iRow & " , Text: " & sLine)
End If
End If
End If
End If
End If
sLine = oStreamReader.ReadLine()
If iProcessRow = 0 Then
ProgressBar1.Value = iRow
My.Application.DoEvents()
If bStop Then
bStop = False
MsgBox(" Stopped Processing at row " & iRow & " . There are " & iRows & " rows." )
Exit Do
End If
End If
Loop
oStreamReader.Close()
If iProcessRow = 0 Then
ResetProgressBar()
End If
End Sub
Private Sub ResetProgressBar()
lbCount.Visible = False
btnStop.Visible = False
ProgressBar1.Value = 1
ProgressBar1.Visible = False
End Sub
Private Function GetFileRowsCount(ByVal sFilePath As String ) As Integer
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim sLine As String = oStreamReader.ReadLine()
Dim iRow As Integer = 0
Do Until sLine Is Nothing
iRow += 1
sLine = oStreamReader.ReadLine()
Loop
oStreamReader.Close()
Return iRow
End Function
Private Function GetAssFolderPath() As String
Dim sAssPath As String = System.Reflection.Assembly.GetExecutingAssembly().Location
Return System.IO.Path.GetDirectoryName(sAssPath)
End Function
Private Function GetFfmpegFile() As String
Dim sFolderPath As String = GetAssFolderPath()
Dim sExePath As String = IO.Path.Combine(sFolderPath, " ffmpeg.exe" )
If IO.File.Exists(sExePath) Then
Return sExePath
End If
Dim sFfmpegFolder As String = GetFolderPath(" ffmpeg" )
Return sFfmpegFolder & " \bin\ffmpeg.exe"
End Function
Private Function GetFolderPath(ByVal sFolderName As String ) As String
Dim sPath As String = GetAssFolderPath()
For i As Integer = 0 To 3
Dim sRetPath As String = IO.Path.Combine(sPath, sFolderName)
If IO.Directory.Exists(sRetPath) Then
Return sRetPath
End If
Try
sPath = IO.Directory.GetParent(sPath).FullName
Catch ex As Exception
Return " "
End Try
Next
Return " "
End Function
Private Function GetTempFolder() As String
Dim sTempFolder As String = GetFolderPath(" Temp" )
If IO.Directory.Exists(sTempFolder) = False Then
sTempFolder = IO.Path.Combine(GetAssFolderPath(), " Temp" )
If IO.Directory.Exists(sTempFolder) = False Then
IO.Directory.CreateDirectory(sTempFolder)
End If
End If
Return sTempFolder
End Function
Private Sub btnSayIt_Click(sender As Object , e As EventArgs) Handles btnSayIt.Click
If txtApiKey.Text = " " Then
MsgBox(" API Key is missing" )
Exit Sub
End If
Dim sTempFolder As String = GetTempFolder()
Dim sFilePath As String = IO.Path.Combine(sTempFolder, GetGuidFileName(" mp3" ))
Dim sVoice As String = cbVoice.Text
If sVoice <> " " Then
sVoiceId = sVoice
End If
If TextToSpeach(txtText.Text, sFilePath) Then
If IO.File.Exists(sFilePath) Then
Dim sDestFilePath As String = IO.Path.Combine(sTempFolder, PadFileName(txtText.Text) & " .mp3" )
Try
If IO.File.Exists(sDestFilePath) Then
PlaySoundStop()
IO.File.Delete(sDestFilePath)
End If
IO.File.Move(sFilePath, sDestFilePath)
sFilePath = sDestFilePath
Catch ex As Exception
End Try
txtTestFile.Visible = True
txtTestFile.Text = sFilePath
PlaySound(sFilePath)
End If
End If
End Sub
Private Function TextToSpeach(sText As String , sFilePath As String ) As Boolean
For i As Integer = 1 To 100
Dim sError As String = TextToSpeach2(sText, sFilePath)
If sError = " " Then
Return True
ElseIf sError.IndexOf(" (429) Too Many Requests" ) <> -1 Then
Threading.Thread.Sleep(1000 * i)
Else
Return False
End If
Next
Return False
End Function
Private Function TextToSpeach2(sText As String , sFilePath As String ) As String
If Trim(sText) = " " Then
Return " No text provided"
End If
If txtApiKey.Text = " " Then
Return " Set API Key"
End If
System.Net.ServicePointManager.SecurityProtocol =
System.Net.SecurityProtocolType.Ssl3 Or
System.Net.SecurityProtocolType.Tls12 Or
System.Net.SecurityProtocolType.Tls11 Or
System.Net.SecurityProtocolType.Tls
Dim apiEndpoint As String = " https://api.openai.com/v1/audio/speech"
Dim request As HttpWebRequest = WebRequest.Create(apiEndpoint)
request.Method = " POST"
request.ContentType = " application/json"
request.Accept = " audio/mpeg"
request.Headers.Add(" Authorization" , " Bearer " & txtApiKey.Text)
Dim data As String = " {"
data += " ""model"":""" & sModelId & " " " ,"
data += " ""input"":""" & PadQuotes(sText) & " " " ,"
data += " ""voice"":""" & sVoiceId & " " " "
data += " }"
Using streamWriter As New StreamWriter(request.GetRequestStream())
streamWriter.Write(data)
streamWriter.Flush()
streamWriter.Close()
End Using
Dim response As HttpWebResponse = Nothing
Try
response = request.GetResponse()
Catch ex As Exception
Return ex.Message
End Try
If response.StatusCode = 200 Then
Try
Dim oFileStream As FileStream = IO.File.Create(sFilePath)
response.GetResponseStream().CopyTo(oFileStream)
oFileStream.Close()
Return " "
Catch ex As Exception
Return " Error: response.GetResponseStream().CopyTo(oFileStream): " & ex.Message
End Try
Else
Return " StatusCode: " & response.StatusCode
End If
End Function
Private Sub SetVoiceSelect(sVoice As String )
For i As Integer = 0 To cbVoice.Items.Count - 1
If cbVoice.Items(i) = sVoice Then
cbVoice.SelectedIndex = i
Exit For
End If
Next
End Sub
Private Function PadQuotes(ByVal s As String ) As String
If s.IndexOf(" \" ) <> -1 Then
s = Replace(s, " \" , " \\" )
End If
If s.IndexOf(vbCrLf) <> -1 Then
s = Replace(s, vbCrLf, " \n" )
End If
If s.IndexOf(vbCr) <> -1 Then
s = Replace(s, vbCr, " \r" )
End If
If s.IndexOf(vbLf) <> -1 Then
s = Replace(s, vbLf, " \f" )
End If
If s.IndexOf(vbTab) <> -1 Then
s = Replace(s, vbTab, " \t" )
End If
If s.IndexOf(" " " " ) = -1 Then
Return s
Else
Return Replace(s, " " " " , " \""" )
End If
End Function
Dim oPlayer As Object = Nothing
Sub PlaySound()
Dim sFilePath As String = GetSelectedFielPath()
If sFilePath <> " " Then
PlaySound(sFilePath)
Else
MsgBox(" MP3 file does not exist " & sFilePath)
End If
End Sub
Sub PlaySound(sSoundFile As String )
If IO.File.Exists(sSoundFile) = False Then
Exit Sub
End If
PlaySoundStop()
btnStopPlay.Enabled = True
oPlayer = CreateObject(" WMPlayer.OCX" )
oPlayer.URL = sSoundFile
oPlayer.controls.play()
End Sub
Sub PlaySoundStop()
If oPlayer IsNot Nothing Then
oPlayer.controls.stop ()
oPlayer.Close()
oPlayer = Nothing
btnStopPlay.Enabled = False
End If
End Sub
Private Sub btnStopPlay_Click(sender As Object , e As EventArgs) Handles btnStopPlay.Click
PlaySoundStop()
End Sub
Public Function GetGuidFileName(ByVal sExt As String ) As String
Return System.Guid.NewGuid().ToString(" N" ) + " ." + sExt
End Function
Private Sub btnSrcFile_Click(sender As Object , e As EventArgs) Handles btnSrcFile.Click
OpenFileDialog1.FileName = txtSrcFile.Text
OpenFileDialog1.Title = " Open Text File"
OpenFileDialog1.Filter = " TXT files|*.txt"
OpenFileDialog1.ShowDialog()
If OpenFileDialog1.FileName <> " " Then
txtSrcFile.Text = OpenFileDialog1.FileName
End If
UpdateFileGrid()
End Sub
Private Sub btnImageFile_Click(sender As Object , e As EventArgs) Handles btnImageFile.Click
OpenFileDialog1.FileName = txtSrcFile.Text
OpenFileDialog1.Title = " Image File"
OpenFileDialog1.Filter = " Image files|*.jpg;*.png"
OpenFileDialog1.ShowDialog()
If OpenFileDialog1.FileName <> " " Then
txtImageFile.Text = OpenFileDialog1.FileName
End If
End Sub
Private Sub UpdateFileGrid()
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " OrElse File.Exists(sFilePath) = False Then
txtSrcFile.Text = " "
DataGridView1.DataSource = Nothing
DataGridView1.Update()
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sDestFolderPath As String = Path.Combine(sFolderPath, sFileName)
Dim iRowIndex As Integer = GetSelectedRowIndex()
oImageList = New Hashtable
Dim sImageFolderPath As String = Path.Combine(sFolderPath, " images" )
If System.IO.Directory.Exists(sImageFolderPath) Then
Dim oFolders As String () = System.IO.Directory.GetDirectories(sImageFolderPath)
For Each sSubFolder As String In oFolders
Dim sSubFolderName As String = (New System.IO.DirectoryInfo(sSubFolder)).Name
Dim oFiles As String () = System.IO.Directory.GetFiles(sSubFolder)
For Each sImgFilePath As String In oFiles
Dim sImgFileName As String = System.IO.Path.GetFileNameWithoutExtension(sImgFilePath)
oImageList(sImgFilePath) = sSubFolderName & " " & sImgFileName
Next
Next
End If
If oImageList.Count > 0 Then
gbFigures.Visible = True
End If
Dim oTable As Data.DataTable = GetDataTableFromFolder(sFilePath, sDestFolderPath)
DataGridView1.DataSource = oTable
DataGridView1.Update()
DataGridView1.Columns(" Size" ).Visible = False
DataGridView1.Columns(" FilePath" ).Visible = False
DataGridColor()
DataGridResize()
If iRowIndex <> -1 And iRowIndex < DataGridView1.RowCount Then
DataGridView1.MultiSelect = False
DataGridView1.Rows(iRowIndex).Cells(0 ).Selected = True
End If
End Sub
Private Function GetNoImageChapters() As Hashtable
Dim oRet As New Hashtable
If oImageList.Count = 0 Then
Return oRet
End If
Dim sChapterName As String = sFirstChapterName
Dim oChapters As New Hashtable
Dim iChapterCount As Integer = 1
For iRow = 0 To DataGridView1.RowCount - 1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
If oRow.Cells(" Text" ).Style.BackColor = Color.GreenYellow Then
sChapterName = DataGridView1.Rows(iRow + 1 ).Cells(" Text" ).Value & " "
Dim sSilenceFile As String = CheckForSilence(sChapterName)
If sSilenceFile <> " " Then
sChapterName = Replace(sChapterName, " {{" & sSilenceFile & " }}" , " " )
End If
sChapterName = PadFileName(Trim(sChapterName))
iChapterCount += 1
End If
Dim sChapterName2 As String = Microsoft.VisualBasic.Right(" 000" & iChapterCount, 3 ) & " " & Microsoft.VisualBasic.Left(sChapterName, 100 )
If oChapters.ContainsKey(sChapterName2) = False Then
oChapters(sChapterName2) = False
End If
Dim sImages As String = oRow.Cells(" Images" ).Value & " "
If sImages <> " " Then
oChapters(sChapterName2) = True
End If
End If
Next
For Each oEntry As DictionaryEntry In oChapters
If oEntry.Value = False Then
oRet(oEntry.Key) = " "
End If
Next
Return oRet
End Function
Private Sub btnCheckImages_Click(sender As Object , e As EventArgs) Handles btnCheckImages.Click
CheckImages()
End Sub
Private Sub CheckImages()
If oImageList.Count = 0 Then
MsgBox(" No images folder with subfolders is found" )
Exit Sub
End If
txtLine.Text = " "
DataGridView1.MultiSelect = False
DataGridView1.Rows(0 ).Cells(0 ).Selected = True
DataGridView1.Rows(0 ).Cells(0 ).Selected = False
For Each oImgEntry As DictionaryEntry In oImageList
Dim sImgName As String = oImgEntry.Value
Dim sImgName2 As String = PadImageName(sImgName)
Dim bFound As Boolean = False
For iRow = 0 To DataGridView1.RowCount - 1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim sText As String = oRow.Cells(" Text" ).Value & " "
If sText.ToLower().IndexOf(sImgName.ToLower()) <> -1 Then
bFound = True
ElseIf sText.ToLower().IndexOf(sImgName2.ToLower()) <> -1 Then
bFound = True
End If
End If
Next
If bFound = False Then
txtLine.AppendText(sImgName & vbCrLf)
End If
Next
End Sub
Private Function GetLineImages(ByVal sLine As String ) As String
Dim sRet As String = " "
For Each oImgEntry As DictionaryEntry In oImageList
Dim sImgName As String = oImgEntry.Value
Dim sImgName2 As String = PadImageName(sImgName)
If sLine.ToLower().IndexOf(sImgName.ToLower()) <> -1 Then
If sRet <> " " Then sRet += " , "
sRet += sImgName
ElseIf sLine.ToLower().IndexOf(sImgName2.ToLower()) <> -1 Then
If sRet <> " " Then sRet += " , "
sRet += sImgName
End If
Next
Return sRet
End Function
Private Function GetLineImagePaths(ByVal sLine As String ) As String
Dim sRet As String = " "
For Each oImgEntry As DictionaryEntry In oImageList
Dim sImgPath As String = oImgEntry.Key
Dim sImgName As String = oImgEntry.Value
Dim sImgName2 As String = PadImageName(sImgName)
If sLine.ToLower().IndexOf(sImgName.ToLower()) <> -1 Then
If sRet <> " " Then sRet += " ,"
sRet += sImgPath
ElseIf sLine.ToLower().IndexOf(sImgName2.ToLower()) <> -1 Then
If sRet <> " " Then sRet += " ,"
sRet += sImgPath
End If
Next
Return sRet
End Function
Private Function PadImageName(s As String ) As String
If IsNumeric(Microsoft.VisualBasic.Right(s, 1 )) Then
Return s
Else
Return s.Substring(0 , s.Length - 1 )
End If
End Function
Private Sub DataGridColor()
Dim sHighlight As String = selHighlight.Text
Dim iBlankRowCount As Integer = 0
For iRow = 0 To DataGridView1.RowCount - 1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim iSize As Integer = oRow.Cells(" Size" ).Value
If iSize = 5856 Then
For Each oCell As DataGridViewCell In oRow.Cells
oCell.Style.BackColor = Color.LightBlue
Next
ElseIf iSize = 0 Then
For Each oCell As DataGridViewCell In oRow.Cells
oCell.Style.BackColor = Color.LightCoral
Next
Else
For Each oCell As DataGridViewCell In oRow.Cells
oCell.Style.BackColor = Color.White
Next
End If
Dim sText As String = oRow.Cells(" Text" ).Value & " "
If Trim(sText) = " " Then
iBlankRowCount += 1
Else
iBlankRowCount = 0
End If
If iBlankRowCount > 1 Then
For Each oCell As DataGridViewCell In oRow.Cells
oCell.Style.BackColor = Color.GreenYellow
Next
If iRow < DataGridView1.Rows.Count Then
Dim sName1 As String = DataGridView1.Rows(iRow + 1 ).Cells(" Name" ).Value & " "
Dim sText1 As String = DataGridView1.Rows(iRow + 1 ).Cells(" Text" ).Value & " "
Dim sSilenceFile As String = CheckForSilence(sText1)
If sSilenceFile <> " " Then
sText1 = Replace(sText1, " {{" & sSilenceFile & " }}" , " " )
End If
End If
End If
If Len(sText) > 4996 Then
oRow.Cells(" Size" ).Style.BackColor = Color.Red
End If
If sHighlight <> " " Then
Dim sFirstChar As String = Microsoft.VisualBasic.Left(sText, 1 )
Select Case sHighlight
Case " Begins with number"
If IsNumeric(sFirstChar) Then
oRow.Cells(" Text" ).Style.BackColor = Color.Yellow
End If
Case " Contains number"
If System.Text.RegularExpressions.Regex.IsMatch(sText, " \b\w+\s*\d+\b" ) Then
oRow.Cells(" Text" ).Style.BackColor = Color.Yellow
End If
Case " Begins with lower case character"
If sFirstChar <> UCase(sFirstChar) Then
oRow.Cells(" Text" ).Style.BackColor = Color.Yellow
End If
Case " Contains two or more uppercase characters in the row"
If System.Text.RegularExpressions.Regex.IsMatch(sText, " [A-Z][A-Z]" ) Then
oRow.Cells(" Text" ).Style.BackColor = Color.Yellow
End If
End Select
End If
End If
Next
End Sub
Private Sub DataGridResize()
If DataGridView1.Columns.Count > 3 Then
Dim w As Integer = DataGridView1.Width - 85
w = w - DataGridView1.Columns(" Name" ).Width
w = w - DataGridView1.Columns(" Length" ).Width
DataGridView1.Columns(" Text" ).Width = Math.Max(w, 200 )
End If
End Sub
Private Sub DataGridView1_Resize(sender As Object , e As EventArgs) Handles DataGridView1.Resize
DataGridResize()
End Sub
Private Sub DataGridView1_Sorted(sender As Object , e As EventArgs) Handles DataGridView1.Sorted
DataGridColor()
End Sub
Function GetStreamReader(ByVal sFilePath As String ) As IO.StreamReader
Return New System.IO.StreamReader(sFilePath, System.Text.Encoding.Default )
End Function
Private Function GetDataTableFromFolder(ByVal sFilePath As String , ByVal sFolderPath As String ) As Data.DataTable
Dim iSingleMp3FileSize As Integer = 0
Dim iSingleMp3Seconds As Integer = 0
Dim sSingleMp3FilePath As String = Path.Combine(Path.GetDirectoryName(sFilePath), Path.GetFileNameWithoutExtension(sFilePath) & " .mp3" )
If IO.File.Exists(sSingleMp3FilePath) Then
Dim oMP3Info As New Monotic.Multimedia.MP3.MP3Info(sSingleMp3FilePath)
iSingleMp3Seconds = oMP3Info.Length
Dim oFileInfo As New IO.FileInfo(sSingleMp3FilePath)
iSingleMp3FileSize = oFileInfo.Length
End If
Dim bUseSingleMp3 As Boolean = sSingleMp3FilePath <> " " AndAlso iSingleMp3FileSize > 0
Dim iStart As Integer = 0
Dim oTable As New Data.DataTable
oTable.Columns.Add(New Data.DataColumn(" Name" ))
oTable.Columns.Add(New Data.DataColumn(" Length" , System.Type.GetType (" System.Int64" )))
oTable.Columns.Add(New Data.DataColumn(" Start" , System.Type.GetType (" System.Int64" )))
oTable.Columns.Add(New Data.DataColumn(" Start2" ))
oTable.Columns.Add(New Data.DataColumn(" Text" ))
oTable.Columns.Add(New Data.DataColumn(" FilePath" ))
oTable.Columns.Add(New Data.DataColumn(" Size" , System.Type.GetType (" System.Int64" )))
If oImageList.Count > 0 Then
oTable.Columns.Add(New Data.DataColumn(" Images" ))
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
Dim iMaxSize As Integer = iRows.ToString().Length
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim iRow As Integer = 0
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
Dim oDataRow As DataRow = oTable.NewRow()
If bUseSingleMp3 Then
oDataRow(" Start" ) = (iStart / iSingleMp3FileSize) * (iSingleMp3Seconds * 1 .0 )
Else
oDataRow(" Start" ) = iStart + (iRow * 0 .945 )
End If
iRow += 1
Dim sSrcFileBase As String = Microsoft.VisualBasic.Right(" 000000" & iRow, iMaxSize)
Dim sSrcFilePath As String = Path.Combine(sFolderPath, sSrcFileBase & " .mp3" )
If IO.File.Exists(sSrcFilePath) Then
Dim oFileInfo As New IO.FileInfo(sSrcFilePath)
oDataRow(" Size" ) = oFileInfo.Length
oDataRow(" FilePath" ) = sSrcFilePath
If bUseSingleMp3 Then
oDataRow(" Length" ) = (oFileInfo.Length / iSingleMp3FileSize) * (iSingleMp3Seconds * 1 .0 )
iStart += oFileInfo.Length
iStart += 2657
Else
Dim iLength As Integer = 0
Try
Dim oMP3Info As New Monotic.Multimedia.MP3.MP3Info(sSrcFilePath)
iLength = oMP3Info.Length
Catch ex As Exception
End Try
oDataRow(" Length" ) = iLength
iStart += iLength
End If
Else
oDataRow(" Size" ) = 0
oDataRow(" Length" ) = 0
oDataRow(" FilePath" ) = " "
End If
oDataRow(" Start2" ) = TimeSpan.FromSeconds(oDataRow(" Start" )).ToString()
oDataRow(" Name" ) = sSrcFileBase
oDataRow(" Text" ) = sLine
If oImageList.Count > 0 Then
Dim sLineImages As String = GetLineImages(sLine)
If sLineImages <> " " Then
oDataRow(" Images" ) = sLineImages
oLineImages(sSrcFileBase) = GetLineImagePaths(sLine)
End If
End If
oTable.Rows.Add(oDataRow)
sLine = oStreamReader.ReadLine()
Loop
oStreamReader.Close()
Return oTable
End Function
Private Sub btnPlay_Click(sender As Object , e As EventArgs) Handles btnPlay.Click
PlaySound()
End Sub
Private Sub btnDelete_Click(sender As Object , e As EventArgs) Handles btnDelete.Click
Dim sFilePath As String = DeleteFile(" Delete" )
If sFilePath <> " " Then
UpdateFileGrid()
Else
MsgBox(" MP3 file does not exist " & sFilePath)
End If
End Sub
Function DeleteFile(ByVal sAction As String ) As String
Dim sFilePath As String = GetSelectedFielPath()
If IO.File.Exists(sFilePath) = False Then
Return " "
End If
If MsgBox(sAction & " file " & Path.GetFileName(sFilePath) & " ?" , MsgBoxStyle.YesNo, sAction & " file" ) <> vbYes Then
Return " "
End If
PlaySoundStop()
Try
IO.File.Delete(sFilePath)
Catch ex As Exception
MsgBox(" Could Not delete file " & sFilePath & " " & ex.Message)
Return " "
End Try
Return sFilePath
End Function
Private Sub btnRegenerate_Click(sender As Object , e As EventArgs) Handles btnReGenerate.Click
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex = -1 Then
Exit Sub
End If
Dim sFilePath As String = DeleteFile(" Regenerate" )
If sFilePath = " " Then
End If
btnReGenerate.Enabled = False
My.Application.DoEvents()
If btnSave.Visible = True Then
SaveTextFile()
End If
ProcessTextFile(iSelectedRowIndex + 1 )
UpdateFileGrid()
PlaySound()
btnReGenerate.Enabled = True
End Sub
Sub MergeFolder(sFolderPath, sFilePath)
If System.IO.Directory.Exists(sFolderPath) = False Then
MsgBox(" Folder does Not exist " & sFolderPath)
Exit Sub
End If
If IO.File.Exists(sFilePath) Then
IO.File.Delete(sFilePath)
End If
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Hidden
startInfo.FileName = " cmd.exe"
startInfo.Arguments = " /C copy /b """ & sFolderPath & " \*.mp3"" """ & sFilePath & " " " "
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
End Sub
Function GetPauseFilePath() As String
Dim sMp3FolderePath As String = GetFolderPath(" mp3" )
Return sMp3FolderePath & " \300ms.mp3"
End Function
Private Sub btnChapters_Click(sender As Object , e As EventArgs) Handles btnChapters.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " Then
MsgBox(" Text file is blank" )
Exit Sub
End If
If IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = " "
MsgBox(" Text file is blank" )
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sSrcFolderPath As String = Path.Combine(sFolderPath, sFileName)
If System.IO.Directory.Exists(sSrcFolderPath) = False Then
MsgBox(" Source folder Is blank: " & sSrcFolderPath)
Exit Sub
End If
Dim sPauseFilePath As String = GetPauseFilePath()
If IO.File.Exists(sPauseFilePath) = False Then
MsgBox(" Could not find " & sPauseFilePath)
Exit Sub
End If
Dim sDstFolderPath As String = Path.Combine(sFolderPath, sFileName & " -Chapters" )
If System.IO.Directory.Exists(sDstFolderPath) Then
Try
EmptyFolder(sDstFolderPath)
Catch ex As Exception
MsgBox(" Could not empty folder " & sDstFolderPath)
Exit Sub
End Try
System.Threading.Thread.Sleep(1000 )
End If
If System.IO.Directory.Exists(sDstFolderPath) = False Then
System.IO.Directory.CreateDirectory(sDstFolderPath)
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
If iRows = 0 Then
Exit Sub
End If
Dim iMaxSize As Integer = iRows.ToString().Length
btnChapters.Enabled = False
My.Application.DoEvents()
Dim iRow As Integer = 0
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim iBlankCount As Integer = 0
Dim iChapterCount As Integer = 1
Dim sChapterName As String = sFirstChapterName
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
iRow += 1
If iBlankCount = 2 AndAlso Trim(sLine) <> " " Then
Dim sSilenceFile As String = CheckForSilence(sLine)
If sSilenceFile <> " " Then
sLine = Replace(sLine, " {{" & sSilenceFile & " }}" , " " )
End If
sChapterName = PadFileName(Trim(sLine))
iChapterCount += 1
End If
Dim sChapterName2 As String = Microsoft.VisualBasic.Right(" 000" & iChapterCount, 3 ) & " " & Microsoft.VisualBasic.Left(sChapterName, 100 )
Dim sChapterFolderPath As String = Path.Combine(sDstFolderPath, sChapterName2)
If System.IO.Directory.Exists(sChapterFolderPath) = False Then
Try
System.IO.Directory.CreateDirectory(sChapterFolderPath)
Catch ex As Exception
MsgBox(" Could not create Chapters folder Line: " & iRow & vbCrLf & sChapterName & vbCrLf & ex.Message)
Exit Sub
End Try
End If
Dim sSrcFileBase As String = Microsoft.VisualBasic.Right(" 000000" & iRow, iMaxSize)
Dim sSrcFilePath As String = Path.Combine(sSrcFolderPath, sSrcFileBase & " .mp3" )
If IO.File.Exists(sSrcFilePath) Then
Dim sDestFilePath As String = Path.Combine(sChapterFolderPath, sSrcFileBase & " 0.mp3" )
IO.File.Copy(sSrcFilePath, sDestFilePath)
sDestFilePath = Path.Combine(sChapterFolderPath, sSrcFileBase & " 1.mp3" )
If IO.File.Exists(sDestFilePath) = False Then
IO.File.Copy(sPauseFilePath, sDestFilePath)
End If
End If
If Trim(sLine) = " " Then
iBlankCount += 1
Else
iBlankCount = 0
End If
sLine = oStreamReader.ReadLine()
Loop
oStreamReader.Close()
System.Threading.Thread.Sleep(100 )
For Each sSubFolder As String In IO.Directory.GetDirectories(sDstFolderPath)
Dim sDestFilePath As String = sSubFolder & " .mp3"
MergeFolder(sSubFolder, sDestFilePath)
Next
For Each sSubFolder As String In IO.Directory.GetDirectories(sDstFolderPath)
System.IO.Directory.Delete(sSubFolder, True )
Next
ChangeFolderBitRate(sDstFolderPath)
SetFileTags(sDstFolderPath, sFileName)
btnChapters.Enabled = True
MsgBox(" Done" )
End Sub
Sub ChangeFolderBitRate(ByVal sDstFolderPath As String )
Dim oFiles As String () = System.IO.Directory.GetFiles(sDstFolderPath)
For Each sFile In oFiles
Dim oFileInfo As New System.IO.FileInfo(sFile)
If oFileInfo.Extension.ToLower() = " .mp3" Then
Dim sChangedFilePath As String = ChangeMp3FileBitRate(sFile)
If IO.File.Exists(sChangedFilePath) Then
oFileInfo.Delete()
IO.File.Move(sChangedFilePath, sFile)
End If
End If
Next
End Sub
Function ChangeMp3FileBitRate(ByVal sFilePath As String ) As String
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sOutputFilePath As String = Path.Combine(sFolderPath, sFileName & " _192.mp3" )
If File.Exists(sOutputFilePath) Then
Return sOutputFilePath
End If
Dim sFfmpegFolder As String = GetFolderPath(" ffmpeg" )
Dim sFfmpegFile As String = sFfmpegFolder & " \bin\ffmpeg.exe"
If IO.File.Exists(sFfmpegFile) = False Then
MsgBox(" ffmpeg.exe file is missing: " & sFfmpegFile)
Return sOutputFilePath
End If
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Hidden
startInfo.FileName = sFfmpegFile
startInfo.Arguments = " -i """ & sFilePath & " " " -b:a ""192k"" """ & sOutputFilePath & " " " "
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
Return sOutputFilePath
End Function
Private Sub SetFileTags(sDstFolderPath As String , sAlbum As String )
Dim oFiles As String () = System.IO.Directory.GetFiles(sDstFolderPath)
For Each sFile In oFiles
Dim oFileInfo As New System.IO.FileInfo(sFile)
If oFileInfo.Extension.ToLower() = " .mp3" Then
Dim oMP3Info As New Monotic.Multimedia.MP3.MP3Info(sFile)
oMP3Info.ID3v1Tag.Album = Microsoft.VisualBasic.Left(sAlbum, 30 )
oMP3Info.ID3v1Tag.Artist = " "
oMP3Info.ID3v1Tag.Title = TrimAlbum(oFileInfo.Name)
oMP3Info.Update()
End If
Next
End Sub
Function PadImageText(ByVal s As String )
Dim i As Integer = s.IndexOf(" " )
If i = -1 Then
Return s
End If
If IsNumeric(s.Substring(0 , i)) Then
Return Trim(s.Substring(i))
End If
Return s
End Function
Sub CreateTextFile(sSubFolder As String )
Dim sHtmlFilePath As String = Path.Combine(sSubFolder, " Test.htm" )
If IO.File.Exists(sHtmlFilePath) Then
IO.File.Delete(sHtmlFilePath)
End If
Dim sw As New StreamWriter(sHtmlFilePath, False )
Dim oFiles As String () = System.IO.Directory.GetFiles(sSubFolder)
Dim iFileCount As Integer = 0
sw.WriteLine(" <html>" )
sw.WriteLine(" <body>" )
sw.WriteLine(" <style>" )
sw.WriteLine(" .FileName{font-size: 30px}" )
sw.WriteLine(" </style>" )
sw.WriteLine(" <table border=1>" )
sw.WriteLine(" <tr>" )
For Each sPath As String In IO.Directory.GetFiles(sSubFolder)
If Path.GetExtension(sPath) = " .mp4" Then
iFileCount += 1
Dim sFileName As String = Path.GetFileName(sPath)
Dim oFileInfo As New IO.FileInfo(sPath)
sw.WriteLine(" <td class='FileName'><div>" & sFileName & " </div><div>" & oFileInfo.Length & " </div></td>" &
" <td><video src='" & sFileName & " '></video></td>" )
If iFileCount > 1 AndAlso iFileCount Mod 3 = 0 Then
sw.WriteLine(" </tr><tr>" )
End If
End If
Next
sw.WriteLine(" </tr>" )
sw.WriteLine(" </table>" )
sw.WriteLine(" <script>" )
sw.WriteLine(" document.querySelectorAll('video').forEach(function(video) {" )
sw.WriteLine(" video.addEventListener('dblclick', function() {" )
sw.WriteLine(" this.controls = !this.controls;" )
sw.WriteLine(" });" )
sw.WriteLine(" });" )
sw.WriteLine(" </script>" )
sw.WriteLine(" </body>" )
sw.WriteLine(" </html>" )
sw.Close()
End Sub
Private Sub btnCreateLineVideos_Click(sender As Object , e As EventArgs) Handles btnCreateLineVideos.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " OrElse IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = " "
MsgBox(" Source text file Is blank" )
Exit Sub
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
If iRows = 0 Then
Exit Sub
End If
Dim iMaxSize As Integer = iRows.ToString().Length
Dim sImageFilePath As String = txtImageFile.Text
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sSrcFolderPath As String = Path.Combine(sFolderPath, sFileName)
If System.IO.Directory.Exists(sSrcFolderPath) = False Then
MsgBox(" Source folder Is blank: " & sSrcFolderPath)
Exit Sub
End If
Dim sFfmpegFile As String = GetFfmpegFile()
If IO.File.Exists(sFfmpegFile) = False Then
MsgBox(" ffmpeg.exe file is missing: " & sFfmpegFile)
Exit Sub
End If
If MsgBox(" Creating video files might take hours. " &
" A small video mp4 file will be created for each mp3 line file. " &
" Existing video files will be skipped. " &
" Are you sure you want to do this?" , vbYesNo) <> vbYes Then
Exit Sub
End If
btnCreateLineVideos.Enabled = False
My.Application.DoEvents()
Dim sVideoFolderPath As String = Path.Combine(sFolderPath, sFileName & " -SmallVideos" )
If System.IO.Directory.Exists(sVideoFolderPath) = False Then
System.IO.Directory.CreateDirectory(sVideoFolderPath)
End If
Dim sChapterName As String = sFirstChapterName
Dim oExtraLineImages As New ArrayList()
Dim iFileCount As Integer = 0
Dim iRow As Integer = 0
Dim iBlankCount As Integer = 0
Dim iChapterCount As Integer = 1
ProgressBar1.Visible = True
ProgressBar1.Maximum = iRows
lbCount.Visible = True
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
iRow += 1
If iBlankCount = 2 AndAlso Trim(sLine) <> " " Then
Dim sSilenceFile As String = CheckForSilence(sLine)
If sSilenceFile <> " " Then
sLine = Replace(sLine, " {{" & sSilenceFile & " }}" , " " )
End If
sChapterName = PadFileName(Trim(StrConv(sLine, VbStrConv.ProperCase)))
oExtraLineImages = New ArrayList()
iChapterCount += 1
End If
Dim sChapterName2 As String = Microsoft.VisualBasic.Right(" 000" & iChapterCount, 3 ) & " " & Microsoft.VisualBasic.Left(sChapterName, 100 )
Dim sChapterFolderPath As String = Path.Combine(sVideoFolderPath, sChapterName2)
Dim sSrcFileBase As String = Microsoft.VisualBasic.Right(" 000000" & iRow, iMaxSize)
Dim sSrcFilePath As String = Path.Combine(sSrcFolderPath, sSrcFileBase & " .mp3" )
If IO.File.Exists(sSrcFilePath) Then
iFileCount += 1
ProgressBar1.Value = iFileCount
lbCount.Text = iFileCount & " /" & iRows
My.Application.DoEvents()
If bStop Then
bStop = False
MsgBox(" Stopped Processing at row " & iFileCount)
Exit Do
End If
If System.IO.Directory.Exists(sChapterFolderPath) = False Then
System.IO.Directory.CreateDirectory(sChapterFolderPath)
End If
Dim sOutputFileName As String = Path.GetFileNameWithoutExtension(sSrcFilePath) & " .mp4"
Dim sOutputFilePath As String = Path.Combine(sChapterFolderPath, sOutputFileName)
Dim bottomMargin As Single = txtBottomMargin.Text
Dim oInputFileInfo As New IO.FileInfo(sSrcFilePath)
Dim bSilenceFile As Boolean = oInputFileInfo.Length < 10000
Dim sImageText As String = Path.GetFileNameWithoutExtension(sSrcFilePath)
Dim sLineImageFilePath As String = " "
If oLineImages.ContainsKey(sImageText) Then
sLineImageFilePath = oLineImages(sImageText)
If sLineImageFilePath.IndexOf(" ," ) <> -1 Then
Dim oList As String () = sLineImageFilePath.Split(" ," )
sLineImageFilePath = oList(0 )
For i As Integer = 1 To oList.Length - 1
oExtraLineImages.Add(oList(i))
Next
End If
ElseIf oExtraLineImages.Count > 0 Then
sLineImageFilePath = oExtraLineImages(0 )
If bSilenceFile = False Then
oExtraLineImages.RemoveAt(0 )
End If
End If
If IO.File.Exists(sOutputFilePath) = False Then
Dim sInputFilePath2 As String = " "
Dim sTempImageFilePath As String = " "
If sLineImageFilePath <> " " Then
sInputFilePath2 = sLineImageFilePath
ElseIf chkImageText.Checked And sImageFilePath <> " " Then
Try
sTempImageFilePath = IO.Path.Combine(GetTempFolder(), GetGuidFileName(" png" ))
AddTextToImage(sImageFilePath, sChapterName, sTempImageFilePath, bottomMargin)
sInputFilePath2 = sTempImageFilePath
Catch ex As Exception
sInputFilePath2 = sImageFilePath
End Try
ElseIf sImageFilePath <> " " Then
sInputFilePath2 = sImageFilePath
Else
sTempImageFilePath = IO.Path.Combine(GetTempFolder(), GetGuidFileName(" png" ))
AddTextToImage(sImageFilePath, PadImageText(sChapterName), sTempImageFilePath, bottomMargin)
sInputFilePath2 = sTempImageFilePath
End If
Dim sArguments As String = " -loop 1 -i """ & sInputFilePath2 & " " " -i """ & sSrcFilePath & " " " -c:v libx264 -vf ""pad=ceil(iw/2)*2:ceil(ih/2)*2"" -tune stillimage -c:a aac -b:a 192k -pix_fmt yuv420p -shortest """ & sOutputFilePath & " " " "
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Hidden
startInfo.FileName = sFfmpegFile
startInfo.Arguments = sArguments
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
If IO.File.Exists(sOutputFilePath) = False Then
Clipboard.SetText(sFfmpegFile & " " & sArguments)
MessageBox.Show(" Video file was not created: " & sOutputFilePath & " . Command text is copied to Clipboard." )
Else
Dim oFileInfo As New FileInfo(sOutputFilePath)
If oFileInfo.Length < 10 Then
Clipboard.SetText(sFfmpegFile & " " & sArguments)
MessageBox.Show(" Video file was created but is blank: " & sOutputFilePath & " . Command text is copied to Clipboard." )
End If
End If
If IO.File.Exists(sTempImageFilePath) Then
Try
IO.File.Delete(sTempImageFilePath)
Catch ex As Exception
End Try
End If
End If
End If
If Trim(sLine) = " " Then
iBlankCount += 1
Else
iBlankCount = 0
End If
sLine = oStreamReader.ReadLine()
Loop
oStreamReader.Close()
ResetProgressBar()
btnCreateLineVideos.Enabled = True
Dim oFolders As String () = System.IO.Directory.GetDirectories(sVideoFolderPath)
For Each sSubFolder As String In oFolders
CreateTextFile(sSubFolder)
Next
MsgBox(" Done" )
End Sub
Private Sub btnMakeVideos_Click(sender As Object , e As EventArgs) Handles btnMakeVideos.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " OrElse IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = " "
MsgBox(" Source text file Is blank" )
Exit Sub
End If
Dim sImageFilePath As String = txtImageFile.Text
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sChaptersFolderPath As String = Path.Combine(sFolderPath, sFileName & " -Chapters" )
If System.IO.Directory.Exists(sChaptersFolderPath) = False Then
MsgBox(" Chapters folders is missing: " & sChaptersFolderPath)
Exit Sub
End If
Dim sFfmpegFile As String = GetFfmpegFile()
If IO.File.Exists(sFfmpegFile) = False Then
MsgBox(" ffmpeg.exe file is missing: " & sFfmpegFile)
Exit Sub
End If
If MsgBox(" Creating video files might take hours. " &
" A video mp4 file will be created for each chapter file. " &
" Existing video files will be skipped. " &
" Are you sure you want to do this?" , vbYesNo) <> vbYes Then
Exit Sub
End If
btnMakeVideos.Enabled = False
My.Application.DoEvents()
Dim sVideoFolderPath As String = Path.Combine(sFolderPath, sFileName & " -Videos" )
If System.IO.Directory.Exists(sVideoFolderPath) = False Then
System.IO.Directory.CreateDirectory(sVideoFolderPath)
End If
Dim oFiles As String () = System.IO.Directory.GetFiles(sChaptersFolderPath)
Dim iFileCount As Integer = 0
ProgressBar1.Visible = True
ProgressBar1.Maximum = oFiles.Length
Dim oNoImageChapters As Hashtable = GetNoImageChapters()
For Each sInputFilePath As String In oFiles
iFileCount += 1
ProgressBar1.Value = iFileCount
My.Application.DoEvents()
If bStop Then
bStop = False
MsgBox(" Stopped Processing at row " & iFileCount)
Exit For
End If
Dim bCanInclude As Boolean = True
If oImageList.Count > 0 Then
Dim sChapterFileName As String = Path.GetFileNameWithoutExtension(sInputFilePath)
If oNoImageChapters.Contains(sChapterFileName) = False Then
bCanInclude = False
End If
End If
Dim sOutputFileName As String = Path.GetFileNameWithoutExtension(sInputFilePath) & " .mp4"
Dim sOutputFilePath As String = Path.Combine(sVideoFolderPath, sOutputFileName)
Dim bottomMargin As Single = txtBottomMargin.Text
If IO.File.Exists(sOutputFilePath) = False AndAlso bCanInclude Then
Dim sInputFilePath2 As String = sImageFilePath
Dim sImageText As String = Path.GetFileNameWithoutExtension(sInputFilePath)
Dim sTempImageFilePath As String = " "
If chkImageText.Checked Then
Try
sTempImageFilePath = IO.Path.Combine(GetTempFolder(), GetGuidFileName(" png" ))
sImageText = PadImageText(sImageText)
sImageText = StrConv(sImageText, VbStrConv.ProperCase)
AddTextToImage(sImageFilePath, sImageText, sTempImageFilePath, bottomMargin)
sInputFilePath2 = sTempImageFilePath
Catch ex As Exception
End Try
ElseIf sImageFilePath = " " Then
sTempImageFilePath = IO.Path.Combine(GetTempFolder(), GetGuidFileName(" png" ))
AddTextToImage(sImageFilePath, PadImageText(sImageText), sTempImageFilePath, bottomMargin)
sInputFilePath2 = sTempImageFilePath
End If
Dim sArguments As String = " -loop 1 -i """ & sInputFilePath2 & " " " -i """ & sInputFilePath & " " " -c:v libx264 -vf ""pad=ceil(iw/2)*2:ceil(ih/2)*2"" -tune stillimage -c:a aac -b:a 192k -pix_fmt yuv420p -shortest """ & sOutputFilePath & " " " "
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Minimized
startInfo.FileName = sFfmpegFile
startInfo.Arguments = sArguments
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
If IO.File.Exists(sOutputFilePath) = False Then
Clipboard.SetText(sFfmpegFile & " " & sArguments)
MessageBox.Show(" Video file was not created: " & sOutputFilePath & " . Command text is copied to Clipboard." )
Else
Dim oFileInfo As New FileInfo(sOutputFilePath)
If oFileInfo.Length < 10 Then
Clipboard.SetText(sFfmpegFile & " " & sArguments)
MessageBox.Show(" Video file was created but is blank: " & sOutputFilePath & " . Command text is copied to Clipboard." )
End If
End If
If IO.File.Exists(sTempImageFilePath) Then
Try
IO.File.Delete(sTempImageFilePath)
Catch ex As Exception
End Try
End If
End If
Next
ProgressBar1.Visible = False
btnMakeVideos.Enabled = True
MsgBox(" Done" )
End Sub
Sub AddTextToImage(ByVal imagePath As String , ByVal text As String , ByVal savePath As String , ByVal bottomMargin As Single )
Dim img As Image
If String .IsNullOrEmpty(imagePath) Then
img = New Bitmap(800 , 800 )
Using g As Graphics = System.Drawing.Graphics.FromImage(img)
g.Clear(Color.White)
End Using
Else
img = Image.FromFile(imagePath)
End If
Dim graphics As Graphics = Graphics.FromImage(img)
Dim brush As New SolidBrush(btnTextColor.BackColor)
Dim fontSize As Single = 40
Dim font As New Font(" Arial" , fontSize)
Dim iLeftMargin As Integer = 0
If txtLeftMargin.Text <> " " Then
iLeftMargin = txtLeftMargin.Text
End If
Dim textSize As SizeF = graphics.MeasureString(text, font)
While textSize.Width > (img.Width - (iLeftMargin * 2 ))
fontSize -= 1
font = New Font(" Arial" , fontSize)
textSize = graphics.MeasureString(text, font)
End While
If bottomMargin + 100 > img.Height Then
bottomMargin = 0
End If
Dim rect As New RectangleF(((img.Width - textSize.Width) / 2 ) + iLeftMargin, img.Height - textSize.Height - bottomMargin, textSize.Width, textSize.Height)
Dim bgColorBrush As New SolidBrush(btnBgColor.BackColor)
graphics.FillRectangle(bgColorBrush, rect)
graphics.DrawString(text, font, brush, rect)
img.Save(savePath, System.Drawing.Imaging.ImageFormat.Png)
brush.Dispose()
graphics.Dispose()
img.Dispose()
End Sub
Sub MergeMp4Files(ByVal sVideoFolderPath As String , ByVal sOutputFilePath As String , ByVal sFfmpegFile As String , iFileNameLength As Integer )
Dim sFilePath As String = txtSrcFile.Text
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sTempFolderPath As String = Path.Combine(sFolderPath, sFileName & " _one_video_" & DateTime.Now.ToString(" yyyyMM_ddHHmmss" ))
IO.Directory.CreateDirectory(sTempFolderPath)
ConverMp4toTs(sVideoFolderPath, sTempFolderPath, sFfmpegFile)
System.Threading.Thread.Sleep(100 )
MergeTsFiles(sTempFolderPath, sOutputFilePath, sFfmpegFile)
System.Threading.Thread.Sleep(1000 )
Try
EmptyFolder(sTempFolderPath)
IO.Directory.Delete(sTempFolderPath)
Catch ex As Exception
MsgBox(" Could not empty folder " & sTempFolderPath)
Exit Sub
End Try
End Sub
Private Sub btnMakeVideo_Click(sender As Object , e As EventArgs) Handles btnMakeVideo.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " OrElse IO.File.Exists(sFilePath) = False Then
MsgBox(" Source text file Is blank" )
Exit Sub
End If
Dim sFfmpegFile As String = GetFfmpegFile()
If IO.File.Exists(sFfmpegFile) = False Then
MsgBox(" ffmpeg.exe file is missing: " & sFfmpegFile)
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sOutputFilePath As String = sFolderPath & " \" & sFileName & " .mp4"
If IO.File.Exists(sOutputFilePath) Then
MsgBox(" Single video already exists. If you want to re-create it please delete it manually: " & sOutputFilePath)
Exit Sub
End If
Dim sVideoFolderPath As String = Path.Combine(sFolderPath, sFileName & " -Videos" )
If System.IO.Directory.Exists(sVideoFolderPath) AndAlso System.IO.Directory.GetFiles(sVideoFolderPath).Length > 1 Then
MergeMp4Files(sVideoFolderPath, sOutputFilePath, sFfmpegFile, 3 )
Exit Sub
End If
Dim sImageFilePath As String = txtImageFile.Text
If sImageFilePath = " " Then
MsgBox(" Image file Is blank" )
Exit Sub
End If
Dim sInputFilePath As String = sFolderPath & " \" & sFileName & " .mp3"
If System.IO.File.Exists(sInputFilePath) = False Then
MsgBox(" MP3 file is is missing " & sInputFilePath)
Exit Sub
End If
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Maximized
startInfo.FileName = sFfmpegFile
startInfo.Arguments = " -loop 1 -i """ & sImageFilePath & " " " -i """ & sInputFilePath & " " " -c:v libx264 -tune stillimage -c:a aac -b:a 192k -pix_fmt yuv420p -shortest """ & sOutputFilePath & " " " "
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
MsgBox(" Done" )
End Sub
Private Function TrimAlbum(ByVal s As String )
If s.Length > 30 Then
Return s.Substring(0 , 30 )
Else
Return s
End If
End Function
Private Sub EmptyFolder(ByVal sFolder As String )
For Each sFolderPath As String In IO.Directory.GetDirectories(sFolder)
System.IO.Directory.Delete(sFolderPath, True )
Next
For Each sFilePath As String In IO.Directory.GetFiles(sFolder)
File.Delete(sFilePath)
Next
End Sub
Public Function PadFileName(ByVal s As String ) As String
s = Replace(s, " <" , " " )
s = Replace(s, " >" , " " )
s = Replace(s, " :" , " -" )
s = Replace(s, " " " " , " " )
s = Replace(s, " /" , " " )
s = Replace(s, " \" , " " )
s = Replace(s, " ?" , " " )
s = Replace(s, " '" , " " )
s = Replace(s, ChrW(65533 ), " " )
Return Replace(s, " *" , " " )
End Function
Private Sub DataGridView1_CellClick(sender As Object , e As DataGridViewCellEventArgs) Handles DataGridView1.CellClick
SetupLineText()
End Sub
Private Sub DataGridView1_KeyUp(sender As Object , e As KeyEventArgs) Handles DataGridView1.KeyUp
SetupLineText()
If chkPlayOnKeyUp.Checked Then
Dim sFilePath As String = GetSelectedFielPath()
If sFilePath <> " " Then
PlaySound(sFilePath)
End If
End If
End Sub
Function GetSelectedRowIndex()
If DataGridView1.SelectedRows.Count > 0 Then
Return DataGridView1.SelectedRows(0 ).Index
ElseIf DataGridView1.SelectedCells.Count > 0 Then
Return DataGridView1.SelectedCells(0 ).RowIndex
End If
Return -1
End Function
Sub SetupLineText()
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex <> -1 Then
Dim oRow As DataGridViewRow = DataGridView1.Rows(iSelectedRowIndex)
txtLine.Text = oRow.Cells(" Text" ).Value
Me .Text = " Audio Book Creator - " & oRow.Cells(" Name" ).Value
Else
Me .Text = " Audio Book Creator"
End If
End Sub
Function GetSelectedFielPath() As String
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex <> -1 Then
Dim oRow As DataGridViewRow = DataGridView1.Rows(iSelectedRowIndex)
Return oRow.Cells(" FilePath" ).Value
End If
Return " "
End Function
Private Sub txtLine_TextChanged(sender As Object , e As EventArgs) Handles txtLine.TextChanged
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex <> -1 Then
Dim oRow As DataGridViewRow = DataGridView1.Rows(iSelectedRowIndex)
oRow.Cells(" Text" ).Value = txtLine.Text
btnSave.Visible = True
End If
End Sub
Private Sub btnSave_Click(sender As Object , e As EventArgs) Handles btnSave.Click
SaveTextFile()
End Sub
Sub SaveTextFile()
Dim sFilePath As String = txtSrcFile.Text
Dim oEncoding As System.Text.Encoding = System.Text.Encoding.ASCII
Dim sBackupFilePath As String = " "
If System.IO.File.Exists(sFilePath) Then
oEncoding = DetectEncoding(sFilePath)
Dim sBackupFileName As String = Path.GetFileNameWithoutExtension(sFilePath) & " _" & DateTime.Now.ToString(" yyyyMM_ddHHmmss" ) & Path.GetExtension(sFilePath)
sBackupFilePath = Path.Combine(Path.GetDirectoryName(sFilePath), sBackupFileName)
File.Move(sFilePath, sBackupFilePath)
End If
Dim sw As New StreamWriter(sFilePath, False , oEncoding)
For iRow = 0 To DataGridView1.RowCount - 1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim sText As String = oRow.Cells(" Text" ).Value
Dim sName As String = oRow.Cells(" Name" ).Value
sw.WriteLine(sText)
End If
Next
sw.Close()
If sBackupFilePath <> " " Then
If chkBackupFile.Checked Then
Dim sBackupFolder As String = Path.Combine(Path.GetDirectoryName(sFilePath), Path.GetFileNameWithoutExtension(sFilePath) & " _backup" )
If IO.Directory.Exists(sBackupFolder) = False Then
IO.Directory.CreateDirectory(sBackupFolder)
End If
Dim sNewBackupFilePath = Path.Combine(sBackupFolder, Path.GetFileName(sBackupFilePath))
File.Move(sBackupFilePath, sNewBackupFilePath)
Else
File.Delete(sBackupFilePath)
End If
End If
btnSave.Visible = False
End Sub
Function DetectEncoding(filePath As String ) As System.Text.Encoding
Dim encoding As System.Text.Encoding = System.Text.Encoding.Default
Using fs As New FileStream(filePath, FileMode.Open, FileAccess.Read)
If fs.Length >= 2 Then
Dim bom(3 ) As Byte
fs.Read(bom, 0 , 3 )
If bom(0 ) = &HEF AndAlso bom(1 ) = &HBB AndAlso bom(2 ) = &HBF Then
encoding = System.Text.Encoding.UTF8
ElseIf bom(0 ) = &HFF AndAlso bom(1 ) = &HFE Then
encoding = System.Text.Encoding.Unicode
ElseIf bom(0 ) = &HFE AndAlso bom(1 ) = &HFF Then
encoding = System.Text.Encoding.BigEndianUnicode
ElseIf bom(0 ) = &H0 AndAlso bom(1 ) = &H0 AndAlso bom(2 ) = &HFE AndAlso bom(3 ) = &HFF Then
encoding = System.Text.Encoding.UTF32
End If
End If
End Using
Return encoding
End Function
Private Sub btnSilence_Click(sender As Object , e As EventArgs) Handles btnSilence.Click
txtLine.Text = " {{" & selSilence.SelectedItem.ToString() & " .mp3}}"
btnSave.Visible = True
End Sub
Private Sub txtLine_MouseWheel(sender As Object , e As MouseEventArgs) Handles txtLine.MouseWheel
If Control.ModifierKeys = Keys.Control Then
Dim currentSize As Single = txtLine.Font.Size
Dim newSize As Single
If e.Delta > 0 Then
newSize = currentSize + 1
Else
newSize = Math.Max(currentSize - 1 , 1 )
End If
txtLine.Font = New Font(txtLine.Font.FontFamily, newSize, txtLine.Font.Style)
End If
End Sub
Private Sub btnMerge_Click(sender As Object , e As EventArgs) Handles btnMerge.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " OrElse IO.File.Exists(sFilePath) = False Then
MsgBox(" Text file is blank" )
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sChaptersFolderPath As String = Path.Combine(sFolderPath, sFileName & " -Chapters" )
If IO.Directory.Exists(sChaptersFolderPath) = False Then
MsgBox(" Chapters folder does not exist: " & sChaptersFolderPath)
Exit Sub
End If
Dim sDestFilePath As String = sFolderPath & " \" & sFileName & " .mp3"
If IO.File.Exists(sDestFilePath) Then
IO.File.Delete(sDestFilePath)
End If
MergeFolder(sChaptersFolderPath, sDestFilePath)
Dim oMP3Info As New Monotic.Multimedia.MP3.MP3Info(sDestFilePath)
txtText.Text = " Created Single MP3 File with Length: " & oMP3Info.Length
MsgBox(" Done" )
End Sub
Private Sub DeleteFolder(ByVal sFolderPath As String )
If IO.Directory.Exists(sFolderPath) = False Then
Exit Sub
End If
Dim oFiles As String () = System.IO.Directory.GetFiles(sFolderPath)
For Each sFile In oFiles
IO.File.Delete(sFile)
Next
IO.Directory.Delete(sFolderPath)
End Sub
Private Sub btnYouTubeIndex_Click(sender As Object , e As EventArgs) Handles btnYouTubeIndex.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " Then
MsgBox(" Text file is blank" )
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sChaptersFolderPath As String = Path.Combine(sFolderPath, sFileName & " -Chapters" )
If System.IO.Directory.Exists(sChaptersFolderPath) = False Then
MsgBox(" Chapters folder does not exist: " & sChaptersFolderPath)
Exit Sub
End If
Dim oForm As New frmYouTube
oForm.sChaptersFolderPath = sChaptersFolderPath
oForm.ShowDialog()
End Sub
Private Sub btnApiKeyShow_Click(sender As Object , e As EventArgs) Handles btnApiKeyShow.Click
If txtApiKey.PasswordChar = " *" Then
txtApiKey.PasswordChar = " "
Else
txtApiKey.PasswordChar = " *"
End If
End Sub
Private Sub selHighlight_SelectedIndexChanged(sender As Object , e As EventArgs) Handles selHighlight.SelectedIndexChanged
DataGridColor()
End Sub
Private Sub urlApiKey_LinkClicked(sender As Object , e As LinkLabelLinkClickedEventArgs) Handles urlApiKey.LinkClicked
Process.Start(New ProcessStartInfo(" https://platform.openai.com/api-keys" ))
End Sub
Private Sub btnRenameDown_Click(sender As Object , e As EventArgs) Handles btnRenameDown.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " OrElse IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = " "
MsgBox(" Text file is blank" )
Exit Sub
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
If iRows = 0 Then
Exit Sub
End If
Dim iMaxSize As Integer = iRows.ToString().Length
Dim sFolderPath As String = Path.GetDirectoryName(txtSrcFile.Text)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sDestFolderPath As String = Path.Combine(sFolderPath, sFileName)
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex = -1 Then
Exit Sub
End If
If MsgBox(" Rename file " & (iSelectedRowIndex + 1 ) & " and subsequent files by + 1?" , MsgBoxStyle.YesNo, " file" ) <> vbYes Then
Exit Sub
End If
PlaySoundStop()
For iRow = DataGridView1.RowCount - 1 To iSelectedRowIndex Step -1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim sSrcFilePath As String = oRow.Cells(" FilePath" ).Value
If sSrcFilePath <> " " AndAlso File.Exists(sSrcFilePath) Then
Dim sDestFileBase As String = Microsoft.VisualBasic.Right(" 000000" & (iRow + 2 ), iMaxSize)
Dim sDestFilePath As String = Path.Combine(sDestFolderPath, sDestFileBase & " .mp3" )
Try
IO.File.Move(sSrcFilePath, sDestFilePath)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End If
End If
Next
MsgBox(" Done" )
End Sub
Private Sub btnTextColor_Click(sender As Object , e As EventArgs) Handles btnTextColor.Click
Dim cDialog As New ColorDialog()
If (cDialog.ShowDialog() = DialogResult.OK) Then
btnTextColor.BackColor = cDialog.Color
End If
End Sub
Private Sub btnBgColor_Click(sender As Object , e As EventArgs) Handles btnBgColor.Click
Dim cDialog As New ColorDialog()
If (cDialog.ShowDialog() = DialogResult.OK) Then
btnBgColor.BackColor = cDialog.Color
End If
End Sub
Private Sub chkImageText_CheckedChanged(sender As Object , e As EventArgs) Handles chkImageText.CheckedChanged
txtLeftMargin.Enabled = chkImageText.Checked
txtBottomMargin.Enabled = chkImageText.Checked
btnBgColor.Enabled = chkImageText.Checked
btnTextColor.Enabled = chkImageText.Checked
End Sub
Private Sub btnVideoTest_Click(sender As Object , e As EventArgs) Handles btnVideoTest.Click
Dim bottomMargin As Single = txtBottomMargin.Text
Dim sImageFilePath As String = txtImageFile.Text
Dim oImageTexts As String () = {" Lorem ipsum dolor sit amet, consectetur adipiscing elit." ,
" Lorem ipsum dolor sit amet" ,
" Chapter 1" ,
" Introduction" }
Dim i As Integer = CInt (oImageTexts.Length * Rnd())
If i > oImageTexts.Length - 1 Then i = oImageTexts.Length - 1
Dim sImageText As String = oImageTexts(i)
Dim sTempImageFilePath As String = IO.Path.Combine(GetTempFolder(), GetGuidFileName(" png" ))
AddTextToImage(sImageFilePath, sImageText, sTempImageFilePath, bottomMargin)
System.Diagnostics.Process.Start(sTempImageFilePath)
End Sub
Private Sub txtSrcFile_TextChanged(sender As Object , e As EventArgs) Handles txtSrcFile.TextChanged
UpdateFileGrid()
End Sub
Private Sub btnProcessChapter_Click(sender As Object , e As EventArgs) Handles btnProcessChapter.Click
If MsgBox(" Are you sure you want to process lines untill blank line?" , vbYesNo) <> vbYes Then
Exit Sub
End If
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex = -1 Then
Exit Sub
End If
btnProcessChapter.Enabled = False
My.Application.DoEvents()
Dim i As Integer = iSelectedRowIndex
Do
Dim oRow As DataGridViewRow = DataGridView1.Rows(i)
Dim sText As String = Trim(oRow.Cells(" Text" ).Value & " " )
If sText = " " OrElse i > 100000 Then
Exit Do
Else
ProcessTextFile(i + 1 )
i += 1
End If
Loop
UpdateFileGrid()
btnProcessChapter.Enabled = True
MsgBox(" Done at line: " & (i + 1 ))
End Sub
Sub ConverMp4toTs(sSrcFolder As String , sDestChapterFolderPath As String , sFfmpegFile As String )
For Each sSrcFilePath As String In IO.Directory.GetFiles(sSrcFolder)
Dim sDestFilePath As String = Path.Combine(sDestChapterFolderPath, Path.GetFileNameWithoutExtension(sSrcFilePath) & " .ts" )
If IO.File.Exists(sDestFilePath) = False Then
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Hidden
startInfo.FileName = sFfmpegFile
startInfo.Arguments = " -i """ & sSrcFilePath & " " " -c copy -bsf:v h264_mp4toannexb -f mpegts """ & sDestFilePath & " " " "
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
End If
Next
End Sub
Sub MergeTsFiles(sFolder, sDestFilePath, sFfmpegFile)
If IO.File.Exists(sDestFilePath) Then
Exit Sub
End If
Dim sTextFilePath As String = Path.Combine(sFolder, " Files.txt" )
Dim sw As New StreamWriter(sTextFilePath, False )
For Each sPath As String In IO.Directory.GetFiles(sFolder)
If Path.GetExtension(sPath) = " .ts" Then
sw.WriteLine(" file '" & Path.GetFileName(sPath) & " '" )
End If
Next
sw.Close()
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Hidden
startInfo.FileName = sFfmpegFile
startInfo.Arguments = " -f concat -safe 0 -i """ & sTextFilePath & " " " -c:v libx264 -c:a aac """ & sDestFilePath & " " " "
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
System.Threading.Thread.Sleep(1000 )
End Sub
Private Sub btnMergeToChapters_Click(sender As Object , e As EventArgs) Handles btnMergeToChapters.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = " " Then
MsgBox(" Text file is blank" )
Exit Sub
End If
If IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = " "
MsgBox(" Text file is blank" )
Exit Sub
End If
Dim sFfmpegFile As String = GetFfmpegFile()
If IO.File.Exists(sFfmpegFile) = False Then
MsgBox(" ffmpeg.exe file is missing: " & sFfmpegFile)
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sSrcFolderPath As String = Path.Combine(sFolderPath, sFileName & " -SmallVideos" )
If System.IO.Directory.Exists(sSrcFolderPath) = False Then
MsgBox(" Source folder Is blank: " & sSrcFolderPath)
Exit Sub
End If
Dim sDstFolderPath As String = Path.Combine(sFolderPath, sFileName & " -LineChapters" )
If System.IO.Directory.Exists(sDstFolderPath) = False Then
System.IO.Directory.CreateDirectory(sDstFolderPath)
End If
btnMergeToChapters.Enabled = False
My.Application.DoEvents()
For Each sSubFolder As String In IO.Directory.GetDirectories(sSrcFolderPath)
Dim sChapterName As String = IO.Path.GetFileName(sSubFolder)
Dim sDestChapterFolderPath As String = Path.Combine(sDstFolderPath, sChapterName)
If System.IO.Directory.Exists(sDestChapterFolderPath) = False Then
System.IO.Directory.CreateDirectory(sDestChapterFolderPath)
End If
ConverMp4toTs(sSubFolder, sDestChapterFolderPath, sFfmpegFile)
Next
System.Threading.Thread.Sleep(100 )
For Each sSubFolder As String In IO.Directory.GetDirectories(sDstFolderPath)
Dim sDestFilePath As String = sSubFolder & " .mp4"
MergeTsFiles(sSubFolder, sDestFilePath, sFfmpegFile)
Next
If MsgBox(" Done. Do you want to delete temp (.ts) folders? You can delete them manully later, all or induvidually." , vbYesNo) = vbYes Then
For Each sSubFolder As String In IO.Directory.GetDirectories(sDstFolderPath)
System.IO.Directory.Delete(sSubFolder, True )
Next
End If
btnMergeToChapters.Enabled = True
MsgBox(" Done" )
End Sub
Private Sub txtTest_Click(sender As Object , e As EventArgs)
MsgBox(" Done" )
End Sub
End Class History
10th November, 2023: Version 1 created 15th, December, 2023: Version 2 created (Handles Open AI Request throttling and text background color) 2nd, Jan, 2024: Version 2 created (Video image text color and Test) April 26, 2024: Version 3 created (Figures support, Better Single Video File Merge using .ts)
Igor is a business intelligence consultant working in Tampa, Florida. He has a BS in Finance from University of South Carolina and Masters in Information Management System from University of South Florida. He also has following professional certifications: MCSD, MCDBA, MCAD.
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
