This application lets you create an audio book using Google TTS API. The application will generate mp3 file for each paragraph and then merge them together.
Introduction
This application lets you create an audio book using Google Text-to-Speech AI API. The application will generate mp3 file for each paragraph and then merge them together. The Google Text-to-Speech AI is $16 per 1 million characters. First 1 million characters FREE. An average 200 page audiobook is about 0.2 million characters. Which means that you can create 5 audiobooks a month for free.
In contrast, OpenAI Text-to-Speech API is $30.00 per million characters. And Eleven Labs is $99 per half a million characters.
In addition Google Text-to-Speech lets you specify the language and the speech in non-English language is without accent. In contrast, OpenAI and Eleven Labs have bad foreign accent for non-English languages.
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. The Application has AI Proofreading section so this work can be automated by using OpenAI or Anthropic.
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.
Background
This article is a sequel to two my other articles I wrote about creating AI audiobooks using Eleven Labs and OpenAI TTS.
How to Create an Audiobook
- First get API Key from Google
- Select Language and Voice.
- “Say it” will generate mp3 file based on any text and place the file into Temp folder in the same folder as 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. 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.
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 oAppSetting As New AppSetting()
Dim bStop As Boolean = False
Dim oImageList As New Hashtable
Dim oLineImages As New Hashtable()
Dim sOpenAiApiKey As String = ""
Dim sAnthropicKey As String = ""
Dim sAiProcessFileName As String = "Validate.txt"
Dim sAIService As String = "gpt-4o-mini"
Dim sAIInstructions As String = ""
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")
sOpenAiApiKey = oAppSetting.GetValue("OpenAiApiKey", sOpenAiApiKey)
sAnthropicKey = oAppSetting.GetValue("AnthropicKey", sAnthropicKey)
sAIService = oAppSetting.GetValue("AIService", sAIService)
sAIInstructions = oAppSetting.GetValue("AIInstructions", sAIInstructions)
txtFirstChapterName.Text = oAppSetting.GetValue("FirstChapterName", txtFirstChapterName.Text)
sLanguageCode = oAppSetting.GetValue("LanguageCode", sLanguageCode)
Dim sLanguageCodes As String = oAppSetting.GetValue("LanguageCodes", "")
SetComboBoxList(cbLanguage, sLanguageCodes)
SetComboBox(cbLanguage, sLanguageCode)
sVoiceId = oAppSetting.GetValue("Voice", sVoiceId)
Dim sVoiceList As String = oAppSetting.GetValue("Voices", "")
SetComboBoxList(selVoice, sVoiceList)
SetComboBox(selVoice, sVoiceId)
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")
txtFontSize.Text = oAppSetting.GetValue("FontSize", txtFontSize.Text)
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
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 &
"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 Google"
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.")
ToolTip1.SetToolTip(txtFirstChapterName, "First Chapter Name. Useful for chapter file name " &
" because first chapter is usually preceded by Book title an Author Name.")
ToolTip1.SetToolTip(btnAiSettings, "OCRed text can have typos. This module uses AI (Anthropic or OpenAI) to correct them.")
ToolTip1.SetToolTip(btnValidate, "Create a text file by running a prompt and each line of text against an AI bot. " &
"The output text file will line number tab and AI bot output. Like '001 OK'")
ToolTip1.SetToolTip(btnReviewAI, "Review changes proposed by the AI bot. Select and apply changes.")
ToolTip1.SetToolTip(btnDeleteValid, "Delete mp3 files for the lines the AI bot think need to be changed.")
ToolTip1.SetToolTip(btnUpdateFileGrid, "Update File Grid")
End Sub
Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
oAppSetting.SetValue("Voice", cbLanguage.Text)
sLanguageCode = GetComboBoxVal(cbLanguage, sLanguageCode)
oAppSetting.SetValue("LanguageCode", sLanguageCode)
sVoiceId = GetComboBoxVal(selVoice, sVoiceId)
oAppSetting.SetValue("Voice", sVoiceId)
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.SetValue("FontSize", txtFontSize.Text)
oAppSetting.SetValue("OpenAiApiKey", sOpenAiApiKey)
oAppSetting.SetValue("AnthropicKey", sAnthropicKey)
oAppSetting.SetValue("AIService", sAIService)
oAppSetting.SetValue("AIInstructions", sAIInstructions)
oAppSetting.SetValue("FirstChapterName", txtFirstChapterName.Text)
oAppSetting.SetValue("LanguageCodes", GetComboBoxList(cbLanguage))
oAppSetting.SetValue("Voices", GetComboBoxList(selVoice))
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 DataGridView1.RowCount = 0 Then
Exit Sub
End If
If MsgBox("Are you sure you want to process the text file?", vbYesNo) <> vbYes Then
Exit Sub
End If
For iRow = 0 To DataGridView1.RowCount - 1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim sText As String = DataGridView1.Rows(iRow).Cells("Text").Value & ""
If Len(sText) > 2500 Then
MsgBox("Row " & (iRow + 1) & " is exceeds the max charachter size of 2500 (" & Len(sText) & "), Text:" & sText)
Exit Sub
End If
End If
Next
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
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"))
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
sLanguageCode = GetComboBoxVal(cbLanguage, sLanguageCode)
sVoiceId = GetComboBoxVal(selVoice, sVoiceId)
If sLanguageCode = "" Or sVoiceId = "" Then
Return False
End If
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 Sub btnLoadLanguages_Click(sender As Object, e As EventArgs) Handles btnLoadLanguages.Click
LoadVoices("")
End Sub
Private Sub btnLoadVoices_Click(sender As Object, e As EventArgs) Handles btnLoadVoices.Click
If cbLanguage.SelectedIndex <> -1 And cbLanguage.Items.Count > 0 Then
sLanguageCode = cbLanguage.Items(cbLanguage.SelectedIndex)
End If
LoadVoices(sLanguageCode)
End Sub
Dim sLanguageCode As String = "ru-RU"
Dim sVoiceId As String = "ru-RU-Standard-B"
Sub LoadVoices(ByVal sLangCode As String)
Dim apiEndpoint As String = "https://texttospeech.googleapis.com/v1/voices?languageCode=" & sLangCode
Dim request As HttpWebRequest = WebRequest.Create(apiEndpoint)
request.Method = "GET"
request.ContentType = "application/json"
request.Headers.Add("X-Goog-Api-Key", txtApiKey.Text)
Dim response As HttpWebResponse = request.GetResponse()
If response.StatusCode <> 200 Then
Exit Sub
End If
Dim oLanguageList As New Hashtable
Dim sSelectedVoice As String = GetComboBoxVal(selVoice, sVoiceId)
Dim sSelectedLanguage As String = GetComboBoxVal(cbLanguage, sLanguageCode)
If sLangCode <> "" Then
selVoice.Items.Clear()
End If
Dim streamReader As New StreamReader(response.GetResponseStream())
Dim sJson As String = streamReader.ReadToEnd()
Dim oJavaScriptSerializer As New System.Web.Script.Serialization.JavaScriptSerializer
Dim oJson As Hashtable = oJavaScriptSerializer.Deserialize(Of Hashtable)(sJson)
Dim oVoices As Object = oJson("voices")
For i As Integer = 0 To oVoices.Length - 1
If sLangCode = "" Then
Dim sLanguageCode2 As String = oVoices(i)("languageCodes")(0)
oLanguageList(sLanguageCode2) = ""
Else
Dim sName As String = oVoices(i)("name")
selVoice.Items.Add(sName)
End If
Next
If sLangCode = "" Then
cbLanguage.Items.Clear()
Dim oSortedList As New SortedList
For Each oKey As DictionaryEntry In oLanguageList
oSortedList.Add(oKey.Key, oKey.Key)
Next
For Each oKey As DictionaryEntry In oSortedList
cbLanguage.Items.Add(oKey.Key)
Next
End If
SetComboBox(cbLanguage, sSelectedLanguage)
SetComboBox(selVoice, sSelectedVoice)
End Sub
Private Function GetComboBoxVal(ByRef oComboBox As ComboBox, sDefaultValue As String) As String
If oComboBox.SelectedIndex = -1 Then
Return sDefaultValue
End If
Return oComboBox.Items(oComboBox.SelectedIndex)
End Function
Private Sub SetComboBox(ByRef oComboBox As ComboBox, sValue As String)
For i As Integer = 0 To oComboBox.Items.Count - 1
If oComboBox.Items(i) = sValue Then
oComboBox.SelectedIndex = i
Exit Sub
End If
Next
End Sub
Private Function GetComboBoxList(ByRef oComboBox As ComboBox) As String
Dim sRet As String = ""
For i As Integer = 0 To oComboBox.Items.Count - 1
If sRet <> "" Then sRet += ","
sRet += oComboBox.Items(i)
Next
Return sRet
End Function
Private Sub SetComboBoxList(ByRef oComboBox As ComboBox, sValue As String)
If sValue = "" Then
Exit Sub
End If
oComboBox.Items.Clear()
Dim oList As String() = sValue.Split(",")
For Each sItem In oList
oComboBox.Items.Add(sItem)
Next
End Sub
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://texttospeech.googleapis.com/v1beta1/text:synthesize"
Dim request As HttpWebRequest = WebRequest.Create(apiEndpoint)
request.Method = "POST"
request.ContentType = "application/json"
request.Accept = "audio/mpeg"
request.Headers.Add("X-Goog-Api-Key", txtApiKey.Text)
Dim data As String = "{"
data += " ""audioConfig"":{"
data += " ""audioEncoding"":""MP3"","
data += " ""effectsProfileId"": [""small-bluetooth-speaker-class-device""],"
data += " ""pitch"":0,"
data += " ""speakingRate"":1"
data += "},"
data += " ""input"": {""text"": """ & PadQuotes(sText) & """},"
data += " ""voice"": {""languageCode"": """ & sLanguageCode & """, ""name"":""" & 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
If ex.Message.IndexOf("The remote server returned an error: (400) Bad Request.") <> -1 Then
If MsgBox("(400) Bad Request. Open request in Notepad?", vbYesNo) = vbYes Then
OpenNotepad(data)
End If
End If
Return ex.Message
End Try
If response.StatusCode = 200 Then
Try
Dim streamReader As New StreamReader(response.GetResponseStream())
Dim sJson As String = streamReader.ReadToEnd()
Dim oJavaScriptSerializer As New System.Web.Script.Serialization.JavaScriptSerializer
Dim oJson As Hashtable = oJavaScriptSerializer.Deserialize(Of Hashtable)(sJson)
Dim sAudioContent As String = oJson("audioContent")
Dim mp3Bytes As Byte() = Convert.FromBase64String(sAudioContent)
File.WriteAllBytes(sFilePath, mp3Bytes)
Return ""
Catch ex As Exception
Return "Error: TextToSpeach2 - audioContent: " & ex.Message
End Try
Else
Return "StatusCode: " & response.StatusCode
End If
End Function
Sub OpenNotepad(ByVal s As String)
Dim sGuid As String = Guid.NewGuid().ToString("N")
Dim tempFolderPath As String = Path.GetTempPath()
Dim sFilePath As String = Path.Combine(tempFolderPath, sGuid & ".txt")
File.WriteAllText(sFilePath, s)
Process.Start("notepad.exe", sFilePath)
End Sub
Private Sub SetVoiceSelect(sVoice As String)
For i As Integer = 0 To cbLanguage.Items.Count - 1
If cbLanguage.Items(i) = sVoice Then
cbLanguage.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;*.webp"
OpenFileDialog1.ShowDialog()
If OpenFileDialog1.FileName <> "" Then
txtImageFile.Text = OpenFileDialog1.FileName
End If
End Sub
Private Sub UpdateFileGrid(Optional ByVal iProcessRow As Integer = 0)
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 sFolderImageSeparator As String = ". "
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()
If iProcessRow = 0 Then
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 & sFolderImageSeparator & sImgFileName
Next
Next
End If
If oImageList.Count > 0 Then
gbFigures.Visible = True
End If
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 = txtFirstChapterName.Text
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")))
oTable.Columns.Add(New Data.DataColumn("TextSize", 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
oDataRow("TextSize") = Len(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(iSelectedRowIndex + 1)
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 = txtFirstChapterName.Text
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 sImageFilePath As String = txtImageFile.Text
If sImageFilePath = "" Then
MsgBox("No image is selected!")
Exit Sub
End If
Dim iMaxSize As Integer = iRows.ToString().Length
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
If chkImageText.Checked Then
If btnBgColor.BackColor = btnTextColor.BackColor Then
MsgBox("Background and text colrs are the same!")
Exit Sub
End If
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 = txtFirstChapterName.Text
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)))
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)
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 fontSize As Single = txtFontSize.Text
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 font As New Font("Arial", fontSize)
Dim iLeftMargin As Integer = 0
If txtLeftMargin.Text <> "" Then
iLeftMargin = txtLeftMargin.Text
End If
Dim layoutRect As New RectangleF(iLeftMargin, 0, img.Width - (iLeftMargin * 2), img.Height)
Dim stringFormat As New StringFormat()
stringFormat.Alignment = StringAlignment.Near
stringFormat.LineAlignment = StringAlignment.Near
stringFormat.FormatFlags = StringFormatFlags.LineLimit
stringFormat.Trimming = StringTrimming.Word
Dim textSize As SizeF = graphics.MeasureString(text, font, layoutRect.Size, stringFormat)
If bottomMargin + textSize.Height > img.Height Then
bottomMargin = img.Height - textSize.Height - 10
End If
Dim textRect As New RectangleF(iLeftMargin, img.Height - textSize.Height - bottomMargin, textSize.Width, textSize.Height)
Dim bgColorBrush As New SolidBrush(btnBgColor.BackColor)
graphics.FillRectangle(bgColorBrush, textRect)
graphics.DrawString(text, font, brush, textRect, stringFormat)
img.Save(savePath, System.Drawing.Imaging.ImageFormat.Png)
brush.Dispose()
bgColorBrush.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
oRow.Cells("TextSize").Value = Len(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://console.cloud.google.com/apis/credentials?project=_"))
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",
"003 Глава 2. Дело против чувства вины - Руководство для родителей по поведенческой генетике."}
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 btnProcessChapter_Click(sender As Object, e As EventArgs) Handles btnProcessChapter.Click
If MsgBox("Are you sure you want to process lines from selected down until a 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()
Dim oFolderList As String() = IO.Directory.GetDirectories(sSrcFolderPath)
Dim iFolderCount As Integer = 0
ProgressBar1.Visible = True
ProgressBar1.Maximum = oFolderList.Length
lbCount.Visible = True
For Each sSubFolder As String In oFolderList
iFolderCount += iFolderCount
ProgressBar1.Value = iFolderCount
lbCount.Text = iFolderCount & "/" & oFolderList.Length
My.Application.DoEvents()
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)
oFolderList = IO.Directory.GetDirectories(sDstFolderPath)
iFolderCount = 0
ProgressBar1.Maximum = oFolderList.Length
For Each sSubFolder As String In IO.Directory.GetDirectories(sDstFolderPath)
iFolderCount += iFolderCount
ProgressBar1.Value = iFolderCount
lbCount.Text = iFolderCount & "/" & oFolderList.Length
My.Application.DoEvents()
Dim sDestFilePath As String = sSubFolder & ".mp4"
MergeTsFiles(sSubFolder, sDestFilePath, sFfmpegFile)
Next
ProgressBar1.Visible = False
lbCount.Visible = False
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 Function GetHashFromFile(ByVal sFilePath As String) As Hashtable
Dim oHash As New Hashtable
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
If sLine.IndexOf(vbTab) <> -1 Then
Dim sName As String = Split(sLine, vbTab)(0)
Dim sText As String = Split(sLine, vbTab)(1)
oHash(sName) = sText
End If
sLine = oStreamReader.ReadLine()
Loop
oStreamReader.Close()
Return oHash
End Function
Private Sub btnAiSettings_Click(sender As Object, e As EventArgs) Handles btnAiSettings.Click
SetAiSettings()
End Sub
Private Sub SetAiSettings()
frmValidate.sAIService = sAIService
frmValidate.sAnthropicKey = sAnthropicKey
frmValidate.sOpenAiApiKey = sOpenAiApiKey
frmValidate.sAIInstructions = sAIInstructions
frmValidate.ShowDialog()
If frmValidate.bCancel Then
Exit Sub
Else
sAIService = frmValidate.sAIService
sAnthropicKey = frmValidate.sAnthropicKey
sOpenAiApiKey = frmValidate.sOpenAiApiKey
sAIInstructions = frmValidate.sAIInstructions
End If
End Sub
Private Sub btnValidate_Click(sender As Object, e As EventArgs) Handles btnValidate.Click
If MsgBox("Process your text file against AI Service?", vbYesNo) <> vbYes Then
Exit Sub
End If
If sAIInstructions = "" Then
MsgBox("Instructions are not provided")
SetAiSettings()
Exit Sub
End If
If sAIService = "" Then
MsgBox("Service is not provided")
SetAiSettings()
Exit Sub
End If
If Microsoft.VisualBasic.Left(sAIService, 4) <> "gpt-" Then
If sAnthropicKey = "" Then
MsgBox("Anthropic API key is not provided")
SetAiSettings()
Exit Sub
End If
Else
If sOpenAiApiKey = "" Then
MsgBox("OpenAI API key is not provided")
SetAiSettings()
Exit Sub
End If
End If
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" Then
MsgBox("Text file is not selected")
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sOutFilePath As String = Path.Combine(sFolderPath, sAiProcessFileName)
Dim sw As StreamWriter
Dim oHash As New Hashtable
If IO.File.Exists(sOutFilePath) Then
If MsgBox("AI Validate file (" & sAiProcessFileName & ") already exists. " &
"Do you want to resume processing it? " &
"If all lines have been processed no validation request will be sent to the AI service.", vbYesNo) <> vbYes Then
Exit Sub
End If
oHash = GetHashFromFile(sOutFilePath)
sw = New StreamWriter(sOutFilePath, True, System.Text.Encoding.UTF8)
Else
sw = New StreamWriter(sOutFilePath, False, System.Text.Encoding.UTF8)
End If
ProgressBar1.Visible = True
ProgressBar1.Maximum = DataGridView1.RowCount
lbCount.Visible = True
For iRow = 0 To DataGridView1.RowCount - 1
ProgressBar1.Value = iRow
lbCount.Text = iRow & "/" & DataGridView1.RowCount
My.Application.DoEvents()
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim sName As String = DataGridView1.Rows(iRow).Cells("Name").Value & ""
If oHash.ContainsKey(sName) = False Then
Dim sText As String = DataGridView1.Rows(iRow).Cells("Text").Value & ""
Dim sRet As String = "OK."
If Trim(sText) <> "" Then
For iTry As Integer = 1 To 100
Try
If Microsoft.VisualBasic.Left(sAIService, 4) <> "gpt-" Then
sRet = SendAnthropicMsg(sAIInstructions & vbCrLf & vbCrLf & sText)
Else
sRet = SendOpenAiMsg(sAIInstructions & vbCrLf & vbCrLf & sText)
End If
Exit For
Catch ex As Exception
If ex.Message.ToLower().IndexOf("too many requests") Then
Threading.Thread.Sleep(1000 * iTry)
If iTry >= 100 Then
MsgBox(ex.Message)
sRet = "Error: " & ex.Message
End If
Else
sRet = "Error: " & ex.Message
Exit For
End If
End Try
Next
If sRet = "OK" Or sRet = "OK." Then
sRet = "OK"
Else
sRet = sRet
End If
End If
sRet = Replace(sRet, vbTab, " ")
sRet = Replace(sRet, vbCrLf, " ")
sRet = Replace(sRet, vbCr, " ")
sRet = Replace(sRet, vbLf, " ")
sw.WriteLine(sName & vbTab & sRet)
End If
End If
Next
sw.Close()
ProgressBar1.Visible = False
lbCount.Visible = False
Process.Start("notepad.exe", """" & sOutFilePath & """")
End Sub
Private Sub btnAiOpenFile_Click(sender As Object, e As EventArgs) Handles btnAiOpenFile.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" Then
MsgBox("Text file is not selected")
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sInFilePath As String = Path.Combine(sFolderPath, sAiProcessFileName)
If IO.File.Exists(sInFilePath) = False Then
Exit Sub
End If
Dim oHash As Hashtable = GetHashFromFile(sInFilePath)
If oHash.Count = 0 Then
Exit Sub
End If
Dim sOutFilePath As String = Path.Combine(sFolderPath, "Plain_" & sAiProcessFileName)
If IO.File.Exists(sOutFilePath) Then
IO.File.Delete(sOutFilePath)
End If
Dim sw As StreamWriter = New StreamWriter(sOutFilePath, True, System.Text.Encoding.UTF8)
Dim iRows As Integer = GetFileRowsCount(sFilePath)
Dim iMaxSize As Integer = iRows.ToString().Length
For iRow = 1 To iRows
Dim sSrcFileBase As String = Microsoft.VisualBasic.Right("000000" & iRow, iMaxSize)
Dim sMsg As String = oHash(sSrcFileBase)
If sMsg = "OK." Then
sw.WriteLine("")
Else
sw.WriteLine(sMsg)
End If
Next
sw.Close()
Process.Start("notepad.exe", """" & sOutFilePath & """")
End Sub
Function SendOpenAiMsg(ByVal sQuestion As String) As String
System.Net.ServicePointManager.SecurityProtocol =
System.Net.SecurityProtocolType.Ssl3 Or
System.Net.SecurityProtocolType.Tls12 Or
System.Net.SecurityProtocolType.Tls11 Or
System.Net.SecurityProtocolType.Tls
Dim sUrl As String = "https://api.openai.com/v1/chat/completions"
Dim request As HttpWebRequest = WebRequest.Create(sUrl)
request.Method = "POST"
request.ContentType = "application/json"
request.Headers.Add("Authorization", "Bearer " & sOpenAiApiKey)
Dim data As String = "{"
data += " ""model"":""" & sAIService & ""","
data += " ""messages"": [{""role"":""user"", ""content"": """ & PadQuotes(sQuestion) & """}]"
data += "}"
Using streamWriter As New StreamWriter(request.GetRequestStream())
streamWriter.Write(data)
streamWriter.Flush()
streamWriter.Close()
End Using
Dim response As HttpWebResponse = request.GetResponse()
Dim streamReader As New StreamReader(response.GetResponseStream())
Dim sJson As String = streamReader.ReadToEnd()
Dim oJavaScriptSerializer As New System.Web.Script.Serialization.JavaScriptSerializer
Dim oJson As Hashtable = oJavaScriptSerializer.Deserialize(Of Hashtable)(sJson)
Return oJson("choices")(0)("message")("content")
End Function
Function SendAnthropicMsg(ByVal sQuestion As String) As String
System.Net.ServicePointManager.SecurityProtocol =
System.Net.SecurityProtocolType.Ssl3 Or
System.Net.SecurityProtocolType.Tls12 Or
System.Net.SecurityProtocolType.Tls11 Or
System.Net.SecurityProtocolType.Tls
Dim sUrl As String = "https://api.anthropic.com/v1/messages"
Dim request As HttpWebRequest = WebRequest.Create(sUrl)
request.Method = "POST"
request.ContentType = "application/json"
request.Headers.Add("x-api-key", sAnthropicKey)
request.Headers.Add("anthropic-version", "2023-06-01")
Dim iMaxTokens As Integer = 1024
Dim dTemperature As Double = 0.7
Dim data As String = "{"
data += """model"": """ & sAIService & ""","
data += """messages"": [{""role"":""user"", ""content"": """ & PadQuotes(sQuestion) & """}],"
data += """system"": ""You are Claude, an AI assistant created by Anthropic to be helpful, harmless, and honest."","
data += """max_tokens"": " & iMaxTokens & ","
data += """temperature"": " & dTemperature
data += "}"
Using streamWriter As New StreamWriter(request.GetRequestStream())
streamWriter.Write(data)
streamWriter.Flush()
streamWriter.Close()
End Using
Dim response As HttpWebResponse = request.GetResponse()
Dim streamReader As New StreamReader(response.GetResponseStream())
Dim sJson As String = streamReader.ReadToEnd()
Dim oJavaScriptSerializer As New System.Web.Script.Serialization.JavaScriptSerializer
Dim oJson As Hashtable = oJavaScriptSerializer.Deserialize(Of Hashtable)(sJson)
Return oJson("content")(0)("text")
End Function
Private Sub btnDeleteValid_Click(sender As Object, e As EventArgs) Handles btnDeleteValid.Click
If MsgBox("Delete mp3 files that have AI correction suggestion? " &
"This will alllow you to regenerate them by clicking 'Process Text File'", vbYesNo) <> vbYes Then
Exit Sub
End If
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" Then
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sInFilePath As String = Path.Combine(sFolderPath, sAiProcessFileName)
If IO.File.Exists(sInFilePath) = False Then
MsgBox("Click AI Validate first.")
Exit Sub
End If
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sDestFolderPath As String = Path.Combine(sFolderPath, sFileName)
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sInFilePath)
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
If sLine.IndexOf(vbTab) <> -1 Then
Dim sName As String = Split(sLine, vbTab)(0)
Dim sNew As String = Split(sLine, vbTab)(1)
If sNew <> "OK" AndAlso sNew <> "OK." AndAlso sNew <> "" Then
Dim sMp3FilePath As String = Path.Combine(sDestFolderPath, sName & ".mp3")
If IO.File.Exists(sMp3FilePath) Then
IO.File.Delete(sMp3FilePath)
End If
End If
End If
sLine = oStreamReader.ReadLine()
Loop
oStreamReader.Close()
End Sub
Private Sub btnReviewAI_Click(sender As Object, e As EventArgs) Handles btnReviewAI.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" Then
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sInFilePath As String = Path.Combine(sFolderPath, sAiProcessFileName)
If IO.File.Exists(sInFilePath) = False Then
MsgBox("Click AI Validate first.")
Exit Sub
End If
Dim oOld As New Hashtable
For iRow = 0 To DataGridView1.RowCount - 1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim sName As String = DataGridView1.Rows(iRow).Cells("Name").Value & ""
Dim sText As String = DataGridView1.Rows(iRow).Cells("Text").Value & ""
oOld(sName) = sText
End If
Next
Dim sOutFilePath As String = Path.Combine(sFolderPath, "Validate.hta")
If IO.File.Exists(sOutFilePath) Then
IO.File.Delete(sOutFilePath)
End If
Dim oNew As New Hashtable
Dim sw As New Text.StringBuilder()
sw.Append("<table border=1 cellspacing=0>")
sw.Append("<thead><tr>" &
"<th>Select</th>" &
"<th>Line</th>" &
"<th nowrap>Change %</th>" &
"<th> </th>" &
"<th>Text</th>" &
"</tr></thead><tbody>")
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sInFilePath)
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
If sLine.IndexOf(vbTab) <> -1 Then
Dim sName As String = Split(sLine, vbTab)(0)
Dim sNew As String = Split(sLine, vbTab)(1)
Dim sOld As String = oOld(sName)
If sNew <> "OK" AndAlso sNew <> "OK." AndAlso sNew <> "" AndAlso sNew <> sOld Then
Dim iPercentLengthChange As Integer = (CDbl(Len(sNew)) / CDbl(Len(sOld))) * 100
oNew(sName) = sNew
Dim sChecked As String = ""
Dim sRedCss As String = ""
If iPercentLengthChange > 90 And iPercentLengthChange < 110 Then
sChecked = " checked "
Else
sRedCss = "background-color: red"
End If
sw.Append("<tr>" &
"<td rowspan=3><input type='checkbox' name='chkBox' " & sChecked & " value='" & sName & "'></td>" &
"<td rowspan=3>" & sName & "</td>" &
"<td rowspan=3><span style='" & sRedCss & "'>" & iPercentLengthChange & "</span></td>" &
"<td>Old:</td><td>" & sOld & "</td></tr>")
sw.Append("<tr><td>New:</td><td>" & sNew & "</td></tr>")
sw.Append("<tr><td>Change:</td><td>" & CompareStrings(sOld, sNew) & "</td></tr>")
sw.Append("<tr><td colspan=5><hr/></td></tr>")
End If
End If
sLine = oStreamReader.ReadLine()
Loop
oStreamReader.Close()
sw.Append("</tbody></table>")
Dim sHtml As String = sw.ToString() &
"<p align=center>" &
"<input type='button' value='Select All' onclick='SelectAll(True)'> " &
"<input type='button' value='Unselect All' onclick='SelectAll(False)'> " &
"<input type='button' value='Update Selected' onclick='Send()'> " &
"<input type='button' value='Close' onclick='self.Close()'></p>"
CreateHtaFile(sOutFilePath, sHtml, "AI Suggested Changes")
File.SetAttributes(sOutFilePath, FileAttributes.Hidden)
OpenHTAAndWait(sOutFilePath)
If File.Exists(sOutFilePath) Then
File.Delete(sOutFilePath)
End If
Dim oRet As Hashtable = ReadXmlFile(sOutFilePath & ".xml", "List", True)
Dim sList As String = Trim(oRet("List") & "")
If sList = "" Then
Exit Sub
End If
Dim oSelected As New Hashtable
For Each sRow As String In Split(sList, ",")
oSelected(sRow) = True
Next
For iRow = 0 To DataGridView1.RowCount - 1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim sName As String = DataGridView1.Rows(iRow).Cells("Name").Value & ""
If oSelected.ContainsKey(sName) AndAlso oNew.ContainsKey(sName) Then
DataGridView1.Rows(iRow).Cells("Text").Value = oNew(sName)
End If
End If
Next
If MsgBox("Updated " & oSelected.Count & " rows with AI suggestions. " &
"Save it now? You can also save these changes later by clicking 'Save Text File'.", MsgBoxStyle.YesNo, " file") = vbYes Then
SaveTextFile()
End If
End Sub
Function ReadXmlFile(sFilePath As String, sFields As String, bDeleteAfterRead As Boolean) As Hashtable
Dim oRet As New Hashtable
If File.Exists(sFilePath) Then
Dim oXml As New Xml.XmlDocument()
oXml.Load(sFilePath)
For Each sField As String In sFields.Split(","c)
Dim oNode As Xml.XmlNode = oXml.SelectSingleNode("/root/" & sField.Trim())
If oNode IsNot Nothing Then
oRet.Add(sField.Trim(), oNode.InnerText)
End If
Next
If bDeleteAfterRead Then
File.Delete(sFilePath)
End If
End If
Return oRet
End Function
Sub CreateHtaFile(sHtaFilePath, sHtml, sTitle)
If IO.File.Exists(sHtaFilePath) Then
IO.File.Delete(sHtaFilePath)
End If
Dim f As StreamWriter = New StreamWriter(sHtaFilePath, False, System.Text.Encoding.UTF8)
f.WriteLine("<html><title>" & sTitle & "</title><head><HTA:APPLICATION ID=oHTA SINGLEINSTANCE=""yes"" SCROLL=""yes""/></head>")
f.WriteLine("<script language=""vbscript"">")
f.WriteLine("Set fso = CreateObject(""Scripting.FileSystemObject"")")
f.WriteLine("")
f.WriteLine("Sub Send()")
f.WriteLine(" Dim sFilePath: sFilePath = Replace(location.href,""file:///"","""")")
f.WriteLine(" sFilePath = Replace(sFilePath,""/"",""\"")")
f.WriteLine(" sFilePath = Replace(sFilePath,""%20"","" "")")
f.WriteLine(" Set oXml = CreateObject(""Microsoft.XMLDOM"")")
f.WriteLine(" Set oRoot = oXml.createElement(""root"")")
f.WriteLine(" oXml.appendChild oRoot")
f.WriteLine("sList = """"")
f.WriteLine("For Each checkbox In document.getElementsByName(""chkBox"")")
f.WriteLine(" If checkbox.checked Then")
f.WriteLine(" If sList <> """" Then sList = sList & "",""")
f.WriteLine(" sList = sList & checkbox.value")
f.WriteLine(" End If")
f.WriteLine("Next")
f.WriteLine("AddXmlVal oXml, oRoot, ""List"", sList")
f.WriteLine(" oXml.Save sFilePath & "".xml""")
f.WriteLine(" self.Close()")
f.WriteLine("End Sub")
f.WriteLine("")
f.WriteLine("Sub AddXmlVal(oXml, oRoot, sName, sVal)")
f.WriteLine(" Set oNode = oXml.createElement(sName)")
f.WriteLine(" oNode.Text = sVal")
f.WriteLine(" oRoot.appendChild oNode")
f.WriteLine("End Sub")
f.WriteLine("")
f.WriteLine("Sub SelectAll(b)")
f.WriteLine("For Each checkbox In document.getElementsByName(""chkBox"")")
f.WriteLine(" checkbox.checked = b")
f.WriteLine("Next")
f.WriteLine("End Sub")
f.WriteLine("")
f.WriteLine("</script>")
f.WriteLine("<body>")
f.WriteLine(sHtml)
f.WriteLine("</body></html>")
f.Close()
End Sub
Public Function CompareStrings(oldString As String, newString As String) As String
Dim result As New System.Text.StringBuilder()
Dim oldChars() As Char = oldString.ToCharArray()
Dim newChars() As Char = newString.ToCharArray()
Dim lcs As String = LongestCommonSubsequence(oldString, newString)
Dim i As Integer = 0
Dim j As Integer = 0
Dim k As Integer = 0
While i < oldChars.Length Or j < newChars.Length
If k < lcs.Length AndAlso i < oldChars.Length AndAlso oldChars(i) = lcs(k) Then
result.Append(oldChars(i))
i += 1
j += 1
k += 1
ElseIf i < oldChars.Length Then
If result.Length = 0 OrElse result(result.Length - 1) <> ">"c Then
result.Append("<span style='color: red;'>")
End If
result.Append(oldChars(i))
i += 1
Else
If result.Length = 0 OrElse result(result.Length - 1) <> ">"c Then
result.Append("<span style='color: green;'>")
End If
result.Append(newChars(j))
j += 1
End If
If (k < lcs.Length AndAlso ((i < oldChars.Length AndAlso oldChars(i) = lcs(k)) OrElse
(j < newChars.Length AndAlso newChars(j) = lcs(k)))) AndAlso
result.Length > 0 AndAlso result(result.Length - 1) <> ">"c Then
result.Append("</span>")
End If
End While
If result.Length > 0 AndAlso result(result.Length - 1) <> ">"c Then
result.Append("</span>")
End If
Return result.ToString()
End Function
Private Function LongestCommonSubsequence(s1 As String, s2 As String) As String
Dim m As Integer = s1.Length
Dim n As Integer = s2.Length
Dim L(m, n) As Integer
For i As Integer = 0 To m
For j As Integer = 0 To n
If i = 0 OrElse j = 0 Then
L(i, j) = 0
ElseIf s1(i - 1) = s2(j - 1) Then
L(i, j) = L(i - 1, j - 1) + 1
Else
L(i, j) = Math.Max(L(i - 1, j), L(i, j - 1))
End If
Next
Next
Dim index As Integer = L(m, n)
Dim lcs(index - 1) As Char
Dim x As Integer = m
Dim y As Integer = n
While x > 0 AndAlso y > 0
If s1(x - 1) = s2(y - 1) Then
lcs(index - 1) = s1(x - 1)
x -= 1
y -= 1
index -= 1
ElseIf L(x - 1, y) > L(x, y - 1) Then
x -= 1
Else
y -= 1
End If
End While
Return New String(lcs)
End Function
Sub OpenHTAAndWait(htaFilePath As String)
Dim process As New Process()
process.StartInfo.FileName = "mshta.exe"
process.StartInfo.Arguments = """" & htaFilePath & """"
process.StartInfo.UseShellExecute = False
process.Start()
process.WaitForExit()
End Sub
Private Sub btnUpdateFileGrid_Click(sender As Object, e As EventArgs) Handles btnUpdateFileGrid.Click
UpdateFileGrid()
End Sub
End Class
Points of Interest
Creating a Text document out of PDF can be vary time consuming. I am planning to create another project that would do so by using OpenAI Vision API. For now the best way is to upload your PDF file to Google Drive. Google will automatically OCR it for you. Next use AutoHotkey convert the PDF to text so that each paragraph is a line of text. For example, by using this AutoHotkey code below you can highlight a paragraph in PDF file and press Windows Key. AutoHotkey will append the text to your Text file.
#Persistent
#SingleInstance Force
; Define the hotkey Ctrl + Shift + C
~LWin::
Clipboard := ""
Send, ^c
ClipWait, 4
selectedText := Clipboard
StringReplace, selectedText, selectedText, `r`n, %A_Space%, All
StringReplace, selectedText, selectedText, `n, %A_Space%, All
StringReplace, selectedText, selectedText, `t, %A_Space%, All
filePath := "C:\Audio\Test.txt"
FileAppend, %selectedText%`r`n, %filePath%, UTF-8
return
History
Version 1 was created on July 26, 2024
