OpenAI有声书创作者
5.00/5 (3投票s)
此应用程序允许您使用OpenAI文本转语音创建有声书
- 下载 OpenAiTTS3.zip - 28.2 MB
引言
此应用程序允许您使用OpenAI API创建有声书。该应用程序将为每个段落生成mp3文件，然后将它们合并在一起。
使用OpenAI的文本转语音服务创建一本有声书（文本量为0.5 MB）仅需约7.50美元。使用ElevenLabs则需要99美元。
如果您有一个pdf文件，需要通过在Word中打开pdf文件，然后复制并粘贴到文本文件中来生成文本文件。使用带有行号的文本编辑器打开文本文件，例如Notepad2。打开文件并删除不会被朗读的文本，如：目录、脚注、索引和参考文献。每个段落必须占一行。
段落之间有0.3秒的停顿。一个空行表示1秒的停顿。两个空行表示新章节。
一个空行表示1秒的停顿。但是您可以使用“静音”功能来自定义停顿的持续时间。
如何创建有声读物
- 首先从OpenAI获取API密钥（https://platform.openai.com）
- 选择OpenAI“语音”。可以创建并使用自定义语音。
- “说出来”将根据任何文本生成mp3文件，并将文件放入EXE所在同一文件夹下的Temp文件夹中。
- “高亮显示文本时”选项有助于您在生成mp3文件之前进行文本文件校正和编辑。例如，“以小写字母开头”和“以数字开头”选项将高亮显示在Word PDF转换过程中可能出错的段落。“包含数字”可能有助于识别包含脚注编号的段落。
- “保存文本文件”会保存对文本文件的更改。“备份文本文件”选项会创建一个备份，让您可以撤消对文本文件所做的更改。备份文本文件将放置在与文本文件名同名的文件夹中，并在后面加上“_backup”。
- “1. 处理文本文件”将为文本文件中的每一行生成MP3文件。这可能花费您约3-20美元，具体取决于文件大小。（当前价格为每0.5MB 7-15美元。一本书平均约0.25 MB。）文件将放置在与文本文件名同名的文件夹中。每个文件将以文本文件中的行号命名，例如0001.mp3。这意味着在生成MP3文件后，您不应该添加或删除文本文件中的行。
- 在网格中选择一行，然后单击播放播放MP3文件。单击停止停止播放mp3文件。在网格中选择一行，然后单击删除删除MP3文件。
- 您可以删除错误的mp3文件，然后再次单击1. 处理文本文件来重新生成已删除的mp3文件。
- 您还可以选择网格中的一行，然后单击重新生成来重新创建MP3文件。此选项也将在需要时保存文本文件。
- 按键弹起时播放选项允许您在选择一行文本后按向下箭头键来收听整本书。
- 一旦您对生成的mp3文件的质量满意，请单击2. MP3章节来为每个章节生成mp3文件。文本文件中的两个空行表示新章节。文件将放置在与文本文件名同名的文件夹中，并在后面加上
-Chapters。 - 将MP3章节文件合并为一个mp3文件。该mp3文件将放置在与文本文件相同的文件夹中，名称相同，但扩展名为mp3。
为每个段落添加图形图像文件
- 创建一个“images”文件夹。这将在表单上显示“图形”面板。
- 在“images”文件夹内创建一个“Figure”文件夹。放置图像文件，例如：1-1.png。
- 如果任何段落文本引用“图1-1”，它将在视频文件中包含1-1.png。
- 在“images”文件夹内创建一个“Table”文件夹。放置图像文件，例如：1-1.png。
- 如果任何段落文本引用“表1-1”，它将在视频文件中包含1-1.png。
将有声读物上传到YouTube
- 首先选择将用于mp4文件生成的图像文件。
- 3. 制作MP4文件将为每个章节生成mp4文件。此操作使用-Chapters文件夹中的mp3文件。此操作可能需要约8小时。这些文件随后可以上传到YouTube。文件将放置在与文本文件名同名的文件夹中，并在后面加上-Videos。
- 制作视频文件将生成一个mp4文件。这些文件随后可以上传到YouTube。该文件将通过合并MP4章节文件（如果可用）来生成。MP4章节文件不可用。将使用单个mp3文件，但此操作可能需要约8小时。MP4文件将放置在与文本文件相同的文件夹中，并具有相同的名称，但扩展名为mp4。
- 根据章节mp3文件的时长生成YouTube索引。该索引可用于视频描述或评论部分。请注意，MP4文件可能会以不同的时长生成，因此可能需要调整索引。
这是我使用此应用程序创建的有声读物。
Using the Code
代码使用ffmpeg.exe将mp3转换为mp4并更改mp3比特率。这是主窗体的VB.NET代码
Imports System.Net
Imports System.IO
Public Class Form1
'Dim API_KEY As String = "" 'https://platform.openai.com/api-keys - Profile
'https://platform.openai.com/docs/guides/text-to-speech?lang=curl
Dim sModelId As String = "tts-1-hd" 'tts-1, tts-1-hd
Dim sVoiceId As String = "alloy" 'alloy, echo, fable, onyx, nova, and shimmer
Dim oAppSetting As New AppSetting()
Dim bStop As Boolean = False
Dim sFirstChapterName As String = "Preface"
Dim oImageList As New Hashtable
Dim oLineImages As New Hashtable()
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
selSilence.SelectedIndex = 0
oAppSetting.LoadData()
txtImageFile.Text = oAppSetting.GetValue("ImageFile")
txtSrcFile.Text = oAppSetting.GetValue("SrcFile")
txtText.Text = oAppSetting.GetValue("Text")
txtApiKey.Text = oAppSetting.GetValue("ApiKey")
If oAppSetting.GetValue("TextColor") <> "" Then
btnTextColor.BackColor = Color.FromArgb(oAppSetting.GetValue("TextColor"))
End If
If oAppSetting.GetValue("BackColor") <> "" Then
btnBgColor.BackColor = Color.FromArgb(oAppSetting.GetValue("BackColor"))
End If
If oAppSetting.GetValue("BottomMargin") <> "" Then
txtBottomMargin.Text = oAppSetting.GetValue("BottomMargin")
End If
txtLeftMargin.Text = oAppSetting.GetValue("LeftMargin")
If txtApiKey.Text <> "" Then
txtApiKey.PasswordChar = "*"
End If
If IO.File.Exists(txtSrcFile.Text) = False Then
txtSrcFile.Text = ""
End If
If IO.File.Exists(txtImageFile.Text) = False Then
txtImageFile.Text = ""
End If
Dim sVoice As String = oAppSetting.GetValue("Voice", "alloy")
If sVoice = "alloy" Then
cbVoice.SelectedIndex = 0
ElseIf sVoice <> "" Then
For i As Integer = 0 To cbVoice.Items.Count - 1
If cbVoice.Items(i) = sVoice Then
cbVoice.SelectedIndex = i
Exit For
End If
Next
End If
UpdateFileGrid()
Dim sSelectedRowIndex As String = oAppSetting.GetValue("SelectedRowIndex")
If sSelectedRowIndex <> "" Then
Dim iRowIndex As Integer = sSelectedRowIndex
If iRowIndex <> -1 AndAlso iRowIndex <DataGridView1.RowCount Then
DataGridView1.MultiSelect= False
DataGridView1.Rows(iRowIndex).Cells(0).Selected = True
SetupLineText()
End If
End If
Dim sTootip As String = ""
ToolTip1.AutoPopDelay = 32767
ToolTip1.SetToolTip(btnProcessTextFile, "Generate MP3 file for each line in the text file. " & vbCrLf &
"This might cost you about $5 depending on the size of the file." & vbCrLf &
"The file will be placed in the folder with the same name as the text file name. " & vbCrLf &
"Each file will be named after the line number in the text file like 0001.mp3. " & vbCrLf &
"This means that you should not add or deleted lines to the text file after MP3 files are generated.")
ToolTip1.SetToolTip(btnChapters, "Generate MP3 file for each chapter. Two blank lines in the text file means new Chapter." & vbCrLf &
"The files will be placed in the folder with the same name as the text file name plus -Chapters")
ToolTip1.SetToolTip(btnMakeVideos, "Generate MP4 file for each chapter. This operation uses mp3 files from -Chapters folder." & vbCrLf &
"This operation can take about 8 hours. These files can then be uploaded to YouTube." & vbCrLf &
"The files will be placed in the folder with the same name as the text file name plus -Videos")
ToolTip1.SetToolTip(btnMerge, "Merge MP3 Chapter files into one MP3 file." & vbCrLf &
"The MP3 file will be placed in the folder as the text file and have the same name but with MP3 extension.")
ToolTip1.SetToolTip(btnMakeVideo, "Generate one MP4 file. These file can then be uploaded to YouTube. " & vbCrLf &
"The file will be generated by merging MP4 chapter files if they are available. " & vbCrLf &
"If MP4 chapter files are not available the single MP3 file will be used but the operation can take about 8 hours." & vbCrLf &
"The MP4 file will be placed in the folder as the text file and have the same name but with MP4 extension.")
ToolTip1.SetToolTip(btnYouTubeIndex, "Generate YouTube index from Chapters MP3 file duration. " & vbCrLf &
"The index can be used in the Video description or the comment section. " & vbCrLf &
"Note that MP4 files night be generated with a different duration so the Index might need to be adjusted.")
ToolTip1.SetToolTip(btnPlay, "Select a line in the grid and click play to MP3 file.")
ToolTip1.SetToolTip(btnStopPlay, "Click to stop the MP3 file playing")
ToolTip1.SetToolTip(btnDelete, "Select a line in the grid and click delete to MP3 file.")
ToolTip1.SetToolTip(btnReGenerate, "Select a line in the grid and click Generate (to save the text file if needed) and re-create the MP3 file.")
ToolTip1.SetToolTip(btnSave, "Save the changes in the text file")
ToolTip1.SetToolTip(chkPlayOnKeyUp, "This option allows you to listen to the entire book by pressing the arrow down key after selecting a line text.")
ToolTip1.SetToolTip(selHighlight, "This option helps you with text file correction and editing before to generating the mp3 files.")
sTootip = "For testing generate mp3 file based on any text"
ToolTip1.SetToolTip(txtText, sTootip)
ToolTip1.SetToolTip(btnSayIt, sTootip)
sTootip = "API Key from OPEN AI (https://openai.com/pricing)"
ToolTip1.SetToolTip(txtApiKey, sTootip)
ToolTip1.SetToolTip(btnApiKeyShow, sTootip)
sTootip = "If you have pdf file, the text file can be generated by opening the pdf file in Word and copy and pasting to a text file." & vbCrLf &
" Open the text file in a text editor that has line numbers (such as Notepad2). "
ToolTip1.SetToolTip(txtSrcFile, sTootip)
ToolTip1.SetToolTip(btnSrcFile, sTootip)
sTootip = "Image file to be used for mp4 file generation."
ToolTip1.SetToolTip(txtImageFile, sTootip)
ToolTip1.SetToolTip(btnImageFile, sTootip)
sTootip = "One blank line means 1 second pause. Use this in case you need to customize the pause duration."
ToolTip1.SetToolTip(selSilence, sTootip)
ToolTip1.SetToolTip(btnSilence, sTootip)
ToolTip1.SetToolTip(chkBackupFile, "Use this option if you want to undo the changes you made to the text file. " &
"The backup text files will be placed in the folder with the same name as the text file name plus _backup")
ToolTip1.SetToolTip(btnCreateLineVideos, "Create MP4 for each line. " &
"Usefull if you have a image folder and each line references images in this folder.")
ToolTip1.SetToolTip(btnCheckImages, "Make sure that images get referenced in the text.")
ToolTip1.SetToolTip(btnProcessChapter, "Process lines from the selected line until a blank line?" &
" This is useful for using different voice for different sections.")
ToolTip1.SetToolTip(urlApiKey, "Profile > API Key")
ToolTip1.SetToolTip(chkImageText, "Add Chapter file name to the video file image")
ToolTip1.SetToolTip(btnRenameDown, "Rename file for the selected row and subsequent files by + 1? " & vbCrLf &
" This is useful for inserting a line into the text if mp3 files are already generated.")
End Sub
Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
oAppSetting.SetValue("Voice", cbVoice.Text)
oAppSetting.SetValue("SrcFile", txtSrcFile.Text)
oAppSetting.SetValue("ImageFile", txtImageFile.Text)
oAppSetting.SetValue("Text", txtText.Text)
oAppSetting.SetValue("ApiKey", txtApiKey.Text)
oAppSetting.SetValue("SelectedRowIndex", GetSelectedRowIndex())
oAppSetting.SetValue("TextColor", btnTextColor.BackColor.ToArgb())
oAppSetting.SetValue("BackColor", btnBgColor.BackColor.ToArgb())
oAppSetting.SetValue("BottomMargin", txtBottomMargin.Text)
oAppSetting.SetValue("LeftMargin", txtLeftMargin.Text)
oAppSetting.SaveData()
End Sub
Private Sub btnStop_Click(sender As Object, e As EventArgs) Handles btnStop.Click
bStop = True
End Sub
Private Sub btnProcessTextFile_Click(sender As Object, e As EventArgs) Handles btnProcessTextFile.Click
If MsgBox("Are you sure you want to process the text file? This might cost you about $5.", vbYesNo) <> vbYes Then
Exit Sub
End If
btnProcessTextFile.Enabled = False
My.Application.DoEvents()
ProcessTextFile(0)
UpdateFileGrid()
btnProcessTextFile.Enabled = True
MsgBox("Done")
End Sub
Function CheckForSilence(sLine As String) As String
For i As Integer = 1 To 9
If sLine.IndexOf("{{" & i.ToString() & "00ms.mp3}}") <> -1 Then
Return i.ToString() & "00ms.mp3"
End If
Next
Return ""
End Function
Sub ProcessTextFile(ByVal iProcessRow As Integer)
If txtApiKey.Text = "" Then
MsgBox("API Key is missing")
Exit Sub
End If
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" OrElse IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = ""
MsgBox("Text file is blank")
Exit Sub
End If
Dim sMp3FolderePath As String = GetFolderPath("mp3")
If sMp3FolderePath = "" Then
MsgBox("Could not find mp3 folder")
Exit Sub
End If
Dim sBlankFilePath As String = sMp3FolderePath & "\1sec.mp3"
If IO.File.Exists(sBlankFilePath) = False Then
MsgBox("Could not find " & sBlankFilePath)
Exit Sub
End If
Dim sVoice As String = cbVoice.Text
If sVoice <> "" Then
sVoiceId = sVoice
End If
If iProcessRow = 0 Then
lbCount.Visible = True
btnStop.Visible = True
ProgressBar1.Visible = True
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sDestFolderPath As String = Path.Combine(sFolderPath, sFileName)
If Not System.IO.Directory.Exists(sDestFolderPath) Then
System.IO.Directory.CreateDirectory(sDestFolderPath)
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
If iRows = 0 Then
Exit Sub
End If
Dim iMaxSize As Integer = iRows.ToString().Length
If iProcessRow = 0 Then
ProgressBar1.Maximum = iRows
End If
Dim iRow As Integer = 0
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
iRow += 1
If iProcessRow = 0 OrElse iRow = iProcessRow Then
If iProcessRow = 0 Then
lbCount.Text = iRow & "/" & iRows
End If
Dim sDestFileBase As String = Microsoft.VisualBasic.Right("000000" & iRow, iMaxSize)
Dim sDestFileName As String = sDestFileBase & ".mp3"
Dim sDestFilePath As String = Path.Combine(sDestFolderPath, sDestFileName)
sLine = Trim(sLine) & ""
If IO.File.Exists(sDestFilePath) = False Then
Dim sSilenceFile As String = CheckForSilence(sLine)
If sSilenceFile <> "" Then
IO.File.Copy(sMp3FolderePath & "\" & sSilenceFile, sDestFilePath)
ElseIf Trim(sLine) = "" Or Trim(sLine) = "{{1sec.mp3}}" Then
'Copy Blank mp3 file
IO.File.Copy(sBlankFilePath, sDestFilePath)
Else
If TextToSpeach(sLine, sDestFilePath) Then
'Success
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 'iProcessRow = 0 OrElse iRow = iProcessRow
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
'https://www.gyan.dev/ffmpeg/builds/
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 ""
'MsgBox("GetFolderPath(), Could not get parent of: " & sPath)
End Try
Next
Return ""
End Function
Private Function GetTempFolder() As String
Dim sTempFolder As String = GetFolderPath("Temp")
If IO.Directory.Exists(sTempFolder) = False Then
sTempFolder = IO.Path.Combine(GetAssFolderPath(), "Temp")
If IO.Directory.Exists(sTempFolder) = False Then
IO.Directory.CreateDirectory(sTempFolder)
End If
End If
Return sTempFolder
End Function
Private Sub btnSayIt_Click(sender As Object, e As EventArgs) Handles btnSayIt.Click
If txtApiKey.Text = "" Then
MsgBox("API Key is missing")
Exit Sub
End If
Dim sTempFolder As String = GetTempFolder()
Dim sFilePath As String = IO.Path.Combine(sTempFolder, GetGuidFileName("mp3"))
Dim sVoice As String = cbVoice.Text
If sVoice <> "" Then
sVoiceId = sVoice
End If
If TextToSpeach(txtText.Text, sFilePath) Then
If IO.File.Exists(sFilePath) Then
Dim sDestFilePath As String = IO.Path.Combine(sTempFolder, PadFileName(txtText.Text) & ".mp3")
Try
If IO.File.Exists(sDestFilePath) Then
PlaySoundStop()
IO.File.Delete(sDestFilePath)
End If
IO.File.Move(sFilePath, sDestFilePath)
sFilePath = sDestFilePath
Catch ex As Exception
'Ignore
End Try
txtTestFile.Visible = True
txtTestFile.Text = sFilePath
PlaySound(sFilePath)
End If
End If
End Sub
Private Function TextToSpeach(sText As String, sFilePath As String) As Boolean
For i As Integer = 1 To 100
Dim sError As String = TextToSpeach2(sText, sFilePath)
If sError = "" Then
Return True
ElseIf sError.IndexOf("(429) Too Many Requests") <> -1 Then
'https://platform.openai.com/docs/guides/rate-limits?context=tier-three
'Rate limits for Tier 3
'tts-1 100 RPM (requests per minute)
Threading.Thread.Sleep(1000 * i)
Else
Return False
End If
Next
Return False
End Function
Private Function TextToSpeach2(sText As String, sFilePath As String) As String
If Trim(sText) = "" Then
Return "No text provided"
End If
If txtApiKey.Text = "" Then
Return "Set API Key"
End If
System.Net.ServicePointManager.SecurityProtocol =
System.Net.SecurityProtocolType.Ssl3 Or
System.Net.SecurityProtocolType.Tls12 Or
System.Net.SecurityProtocolType.Tls11 Or
System.Net.SecurityProtocolType.Tls
'https://platform.openai.com/docs/guides/text-to-speech?lang=curl
Dim apiEndpoint As String = "https://api.openai.com/v1/audio/speech"
Dim request As HttpWebRequest = WebRequest.Create(apiEndpoint)
request.Method = "POST"
request.ContentType = "application/json"
request.Accept = "audio/mpeg"
request.Headers.Add("Authorization", "Bearer " & txtApiKey.Text)
Dim data As String = "{"
data += " ""model"":""" & sModelId & ""","
data += " ""input"":""" & PadQuotes(sText) & ""","
data += " ""voice"":""" & sVoiceId & """"
data += "}"
Using streamWriter As New StreamWriter(request.GetRequestStream())
streamWriter.Write(data)
streamWriter.Flush()
streamWriter.Close()
End Using
Dim response As HttpWebResponse = Nothing
Try
response = request.GetResponse()
Catch ex As Exception
Return ex.Message
End Try
If response.StatusCode = 200 Then
Try
Dim oFileStream As FileStream = IO.File.Create(sFilePath)
response.GetResponseStream().CopyTo(oFileStream)
oFileStream.Close()
Return ""
Catch ex As Exception
Return "Error: response.GetResponseStream().CopyTo(oFileStream): " & ex.Message
End Try
Else
Return "StatusCode: " & response.StatusCode
End If
End Function
Private Sub SetVoiceSelect(sVoice As String)
For i As Integer = 0 To cbVoice.Items.Count - 1
If cbVoice.Items(i) = sVoice Then
cbVoice.SelectedIndex = i
Exit For
End If
Next
End Sub
Private Function PadQuotes(ByVal s As String) As String
If s.IndexOf("\") <> -1 Then
s = Replace(s, "\", "\\")
End If
If s.IndexOf(vbCrLf) <> -1 Then
s = Replace(s, vbCrLf, "\n")
End If
If s.IndexOf(vbCr) <> -1 Then
s = Replace(s, vbCr, "\r")
End If
If s.IndexOf(vbLf) <> -1 Then
s = Replace(s, vbLf, "\f")
End If
If s.IndexOf(vbTab) <> -1 Then
s = Replace(s, vbTab, "\t")
End If
If s.IndexOf("""") = -1 Then
Return s
Else
Return Replace(s, """", "\""")
End If
End Function
Dim oPlayer As Object = Nothing
Sub PlaySound()
Dim sFilePath As String = GetSelectedFielPath()
If sFilePath <> "" Then
PlaySound(sFilePath)
Else
MsgBox("MP3 file does not exist " & sFilePath)
End If
End Sub
Sub PlaySound(sSoundFile As String)
If IO.File.Exists(sSoundFile) = False Then
Exit Sub
End If
PlaySoundStop()
btnStopPlay.Enabled = True
oPlayer = CreateObject("WMPlayer.OCX")
oPlayer.URL = sSoundFile
oPlayer.controls.play()
End Sub
Sub PlaySoundStop()
If oPlayer IsNot Nothing Then
oPlayer.controls.stop()
oPlayer.Close()
oPlayer = Nothing
btnStopPlay.Enabled = False
End If
End Sub
Private Sub btnStopPlay_Click(sender As Object, e As EventArgs) Handles btnStopPlay.Click
PlaySoundStop()
End Sub
Public Function GetGuidFileName(ByVal sExt As String) As String
Return System.Guid.NewGuid().ToString("N") + "." + sExt
End Function
Private Sub btnSrcFile_Click(sender As Object, e As EventArgs) Handles btnSrcFile.Click
OpenFileDialog1.FileName = txtSrcFile.Text
OpenFileDialog1.Title = "Open Text File"
OpenFileDialog1.Filter = "TXT files|*.txt"
OpenFileDialog1.ShowDialog()
If OpenFileDialog1.FileName <> "" Then
txtSrcFile.Text = OpenFileDialog1.FileName
End If
UpdateFileGrid()
End Sub
Private Sub btnImageFile_Click(sender As Object, e As EventArgs) Handles btnImageFile.Click
OpenFileDialog1.FileName = txtSrcFile.Text
OpenFileDialog1.Title = "Image File"
OpenFileDialog1.Filter = "Image files|*.jpg;*.png"
OpenFileDialog1.ShowDialog()
If OpenFileDialog1.FileName <> "" Then
txtImageFile.Text = OpenFileDialog1.FileName
End If
End Sub
Private Sub UpdateFileGrid()
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" OrElse File.Exists(sFilePath) = False Then
txtSrcFile.Text = ""
DataGridView1.DataSource = Nothing
DataGridView1.Update()
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sDestFolderPath As String = Path.Combine(sFolderPath, sFileName)
Dim iRowIndex As Integer = GetSelectedRowIndex()
oImageList = New Hashtable
Dim sImageFolderPath As String = Path.Combine(sFolderPath, "images")
If System.IO.Directory.Exists(sImageFolderPath) Then
Dim oFolders As String() = System.IO.Directory.GetDirectories(sImageFolderPath)
For Each sSubFolder As String In oFolders
Dim sSubFolderName As String = (New System.IO.DirectoryInfo(sSubFolder)).Name
Dim oFiles As String() = System.IO.Directory.GetFiles(sSubFolder)
For Each sImgFilePath As String In oFiles
Dim sImgFileName As String = System.IO.Path.GetFileNameWithoutExtension(sImgFilePath)
oImageList(sImgFilePath) = sSubFolderName & " " & sImgFileName
Next
Next
End If
If oImageList.Count > 0 Then
gbFigures.Visible = True
End If
Dim oTable As Data.DataTable = GetDataTableFromFolder(sFilePath, sDestFolderPath)
DataGridView1.DataSource = oTable
DataGridView1.Update()
DataGridView1.Columns("Size").Visible = False
DataGridView1.Columns("FilePath").Visible = False
'DataGridView1.Columns("Length").DefaultCellStyle.Format = "#,#"
DataGridColor()
DataGridResize()
If iRowIndex <> -1 And iRowIndex < DataGridView1.RowCount Then
DataGridView1.MultiSelect = False
DataGridView1.Rows(iRowIndex).Cells(0).Selected = True
End If
End Sub
Private Function GetNoImageChapters() As Hashtable
Dim oRet As New Hashtable
If oImageList.Count = 0 Then
Return oRet
End If
Dim sChapterName As String = sFirstChapterName
Dim oChapters As New Hashtable
Dim iChapterCount As Integer = 1
For iRow = 0 To DataGridView1.RowCount - 1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
If oRow.Cells("Text").Style.BackColor = Color.GreenYellow Then
sChapterName = DataGridView1.Rows(iRow + 1).Cells("Text").Value & ""
Dim sSilenceFile As String = CheckForSilence(sChapterName)
If sSilenceFile <> "" Then
sChapterName = Replace(sChapterName, "{{" & sSilenceFile & "}}", "")
End If
sChapterName = PadFileName(Trim(sChapterName))
iChapterCount += 1
End If
Dim sChapterName2 As String = Microsoft.VisualBasic.Right("000" & iChapterCount, 3) & " " & Microsoft.VisualBasic.Left(sChapterName, 100)
If oChapters.ContainsKey(sChapterName2) = False Then
oChapters(sChapterName2) = False
End If
Dim sImages As String = oRow.Cells("Images").Value & ""
If sImages <> "" Then
oChapters(sChapterName2) = True
End If
End If
Next
For Each oEntry As DictionaryEntry In oChapters
If oEntry.Value = False Then
oRet(oEntry.Key) = ""
End If
Next
Return oRet
End Function
Private Sub btnCheckImages_Click(sender As Object, e As EventArgs) Handles btnCheckImages.Click
CheckImages()
End Sub
Private Sub CheckImages()
'Make sure that images get referenced in the text
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
'New Chapter
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
'https://community.openai.com/t/text-to-speech-api-limit-speech-generation/558166
oRow.Cells("Size").Style.BackColor = Color.Red
End If
If sHighlight <> "" Then
Dim sFirstChar As String = Microsoft.VisualBasic.Left(sText, 1)
Select Case sHighlight
Case "Begins with number"
If IsNumeric(sFirstChar) Then
oRow.Cells("Text").Style.BackColor = Color.Yellow
End If
Case "Contains number"
If System.Text.RegularExpressions.Regex.IsMatch(sText, "\b\w+\s*\d+\b") Then
oRow.Cells("Text").Style.BackColor = Color.Yellow
End If
Case "Begins with lower case character"
If sFirstChar <> UCase(sFirstChar) Then
oRow.Cells("Text").Style.BackColor = Color.Yellow
End If
Case "Contains two or more uppercase characters in the row"
If System.Text.RegularExpressions.Regex.IsMatch(sText, "[A-Z][A-Z]") Then
oRow.Cells("Text").Style.BackColor = Color.Yellow
End If
End Select
End If
End If
Next
End Sub
Private Sub DataGridResize()
If DataGridView1.Columns.Count > 3 Then
Dim w As Integer = DataGridView1.Width - 85
w = w - DataGridView1.Columns("Name").Width
w = w - DataGridView1.Columns("Length").Width
DataGridView1.Columns("Text").Width = Math.Max(w, 200)
End If
End Sub
Private Sub DataGridView1_Resize(sender As Object, e As EventArgs) Handles DataGridView1.Resize
DataGridResize()
End Sub
Private Sub DataGridView1_Sorted(sender As Object, e As EventArgs) Handles DataGridView1.Sorted
DataGridColor()
End Sub
Function GetStreamReader(ByVal sFilePath As String) As IO.StreamReader
Return New System.IO.StreamReader(sFilePath, System.Text.Encoding.Default)
End Function
Private Function GetDataTableFromFolder(ByVal sFilePath As String, ByVal sFolderPath As String) As Data.DataTable
Dim iSingleMp3FileSize As Integer = 0
Dim iSingleMp3Seconds As Integer = 0
Dim sSingleMp3FilePath As String = Path.Combine(Path.GetDirectoryName(sFilePath), Path.GetFileNameWithoutExtension(sFilePath) & ".mp3")
If IO.File.Exists(sSingleMp3FilePath) Then
Dim oMP3Info As New Monotic.Multimedia.MP3.MP3Info(sSingleMp3FilePath)
iSingleMp3Seconds = oMP3Info.Length
Dim oFileInfo As New IO.FileInfo(sSingleMp3FilePath)
iSingleMp3FileSize = oFileInfo.Length
End If
Dim bUseSingleMp3 As Boolean = sSingleMp3FilePath <> "" AndAlso iSingleMp3FileSize > 0
Dim iStart As Integer = 0
Dim oTable As New Data.DataTable
oTable.Columns.Add(New Data.DataColumn("Name"))
oTable.Columns.Add(New Data.DataColumn("Length", System.Type.GetType("System.Int64")))
oTable.Columns.Add(New Data.DataColumn("Start", System.Type.GetType("System.Int64")))
oTable.Columns.Add(New Data.DataColumn("Start2"))
oTable.Columns.Add(New Data.DataColumn("Text"))
oTable.Columns.Add(New Data.DataColumn("FilePath"))
oTable.Columns.Add(New Data.DataColumn("Size", System.Type.GetType("System.Int64")))
If oImageList.Count > 0 Then
oTable.Columns.Add(New Data.DataColumn("Images"))
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
Dim iMaxSize As Integer = iRows.ToString().Length
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim iRow As Integer = 0
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
Dim oDataRow As DataRow = oTable.NewRow()
If bUseSingleMp3 Then
oDataRow("Start") = (iStart / iSingleMp3FileSize) * (iSingleMp3Seconds * 1.0)
Else
oDataRow("Start") = iStart + (iRow * 0.945) ' 300ms
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 '(2,657 bytes) '300ms.mp3
Else
Dim iLength As Integer = 0
Try
Dim oMP3Info As New Monotic.Multimedia.MP3.MP3Info(sSrcFilePath)
iLength = oMP3Info.Length
Catch ex As Exception
'Ignore any error
End Try
oDataRow("Length") = iLength
iStart += iLength
End If
Else
oDataRow("Size") = 0
oDataRow("Length") = 0
oDataRow("FilePath") = ""
End If
oDataRow("Start2") = TimeSpan.FromSeconds(oDataRow("Start")).ToString()
oDataRow("Name") = sSrcFileBase
oDataRow("Text") = sLine
If oImageList.Count > 0 Then
Dim sLineImages As String = GetLineImages(sLine)
If sLineImages <> "" Then
oDataRow("Images") = sLineImages
oLineImages(sSrcFileBase) = GetLineImagePaths(sLine)
End If
End If
oTable.Rows.Add(oDataRow)
sLine = oStreamReader.ReadLine()
Loop
oStreamReader.Close()
Return oTable
End Function
Private Sub btnPlay_Click(sender As Object, e As EventArgs) Handles btnPlay.Click
PlaySound()
End Sub
Private Sub btnDelete_Click(sender As Object, e As EventArgs) Handles btnDelete.Click
Dim sFilePath As String = DeleteFile("Delete")
If sFilePath <> "" Then
UpdateFileGrid()
Else
MsgBox("MP3 file does not exist " & sFilePath)
End If
End Sub
Function DeleteFile(ByVal sAction As String) As String
Dim sFilePath As String = GetSelectedFielPath()
If IO.File.Exists(sFilePath) = False Then
Return ""
End If
If MsgBox(sAction & " file " & Path.GetFileName(sFilePath) & "?", MsgBoxStyle.YesNo, sAction & " file") <> vbYes Then
Return ""
End If
PlaySoundStop()
Try
IO.File.Delete(sFilePath)
Catch ex As Exception
MsgBox("Could Not delete file " & sFilePath & " " & ex.Message)
Return ""
End Try
Return sFilePath
End Function
Private Sub btnRegenerate_Click(sender As Object, e As EventArgs) Handles btnReGenerate.Click
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex = -1 Then
Exit Sub
End If
Dim sFilePath As String = DeleteFile("Regenerate")
If sFilePath = "" Then
'MsgBox("MP3 file does not exist " & sFilePath)
'Exit Sub
End If
btnReGenerate.Enabled = False
My.Application.DoEvents()
If btnSave.Visible = True Then
SaveTextFile()
End If
ProcessTextFile(iSelectedRowIndex + 1)
UpdateFileGrid()
PlaySound()
btnReGenerate.Enabled = True
End Sub
Sub MergeFolder(sFolderPath, sFilePath)
If System.IO.Directory.Exists(sFolderPath) = False Then
MsgBox("Folder does Not exist " & sFolderPath)
Exit Sub
End If
If IO.File.Exists(sFilePath) Then
IO.File.Delete(sFilePath)
End If
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Hidden
startInfo.FileName = "cmd.exe"
startInfo.Arguments = "/C copy /b """ & sFolderPath & "\*.mp3"" """ & sFilePath & """"
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
End Sub
Function GetPauseFilePath() As String
Dim sMp3FolderePath As String = GetFolderPath("mp3")
Return sMp3FolderePath & "\300ms.mp3"
End Function
Private Sub btnChapters_Click(sender As Object, e As EventArgs) Handles btnChapters.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" Then
MsgBox("Text file is blank")
Exit Sub
End If
If IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = ""
MsgBox("Text file is blank")
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sSrcFolderPath As String = Path.Combine(sFolderPath, sFileName)
If System.IO.Directory.Exists(sSrcFolderPath) = False Then
MsgBox("Source folder Is blank: " & sSrcFolderPath)
Exit Sub
End If
Dim sPauseFilePath As String = GetPauseFilePath()
If IO.File.Exists(sPauseFilePath) = False Then
MsgBox("Could not find " & sPauseFilePath)
Exit Sub
End If
Dim sDstFolderPath As String = Path.Combine(sFolderPath, sFileName & "-Chapters")
If System.IO.Directory.Exists(sDstFolderPath) Then
'ChangeFolderBitRate(sDstFolderPath)
'SetFileTags(sDstFolderPath, sFileName)
Try
EmptyFolder(sDstFolderPath)
Catch ex As Exception
MsgBox("Could not empty folder " & sDstFolderPath)
Exit Sub
End Try
System.Threading.Thread.Sleep(1000)
End If
If System.IO.Directory.Exists(sDstFolderPath) = False Then
System.IO.Directory.CreateDirectory(sDstFolderPath)
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
If iRows = 0 Then
Exit Sub
End If
Dim iMaxSize As Integer = iRows.ToString().Length
btnChapters.Enabled = False
My.Application.DoEvents()
Dim iRow As Integer = 0
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim iBlankCount As Integer = 0
Dim iChapterCount As Integer = 1
Dim sChapterName As String = sFirstChapterName
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
iRow += 1
If iBlankCount = 2 AndAlso Trim(sLine) <> "" Then
Dim sSilenceFile As String = CheckForSilence(sLine)
If sSilenceFile <> "" Then
'Chapter name might need to be repeated twice
'One time for file name and second time after the section header
'This feature lets you ignore first line for TTS and to be used for chapter file name only
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()
'Console.WriteLine(oFileInfo.Name)
End If
Next
End Sub
Function PadImageText(ByVal s As String)
Dim i As Integer = s.IndexOf(" ")
If i = -1 Then
Return s
End If
If IsNumeric(s.Substring(0, i)) Then
Return Trim(s.Substring(i))
End If
Return s
End Function
Sub CreateTextFile(sSubFolder As String)
Dim sHtmlFilePath As String = Path.Combine(sSubFolder, "Test.htm")
If IO.File.Exists(sHtmlFilePath) Then
IO.File.Delete(sHtmlFilePath)
End If
Dim sw As New StreamWriter(sHtmlFilePath, False)
Dim oFiles As String() = System.IO.Directory.GetFiles(sSubFolder)
Dim iFileCount As Integer = 0
sw.WriteLine("<html>")
sw.WriteLine("<body>")
sw.WriteLine("<style>")
sw.WriteLine(".FileName{font-size: 30px}")
sw.WriteLine("</style>")
sw.WriteLine("<table border=1>")
sw.WriteLine("<tr>")
For Each sPath As String In IO.Directory.GetFiles(sSubFolder)
If Path.GetExtension(sPath) = ".mp4" Then
iFileCount += 1
Dim sFileName As String = Path.GetFileName(sPath)
Dim oFileInfo As New IO.FileInfo(sPath)
sw.WriteLine("<td class='FileName'><div>" & sFileName & "</div><div>" & oFileInfo.Length & "</div></td>" &
"<td><video src='" & sFileName & "'></video></td>")
If iFileCount > 1 AndAlso iFileCount Mod 3 = 0 Then
sw.WriteLine("</tr><tr>")
End If
End If
Next
sw.WriteLine("</tr>")
sw.WriteLine("</table>")
sw.WriteLine("<script>")
sw.WriteLine("document.querySelectorAll('video').forEach(function(video) {")
sw.WriteLine(" video.addEventListener('dblclick', function() {")
sw.WriteLine("this.controls = !this.controls;")
sw.WriteLine("});")
sw.WriteLine("});")
sw.WriteLine("</script>")
sw.WriteLine("</body>")
sw.WriteLine("</html>")
sw.Close()
End Sub
Private Sub btnCreateLineVideos_Click(sender As Object, e As EventArgs) Handles btnCreateLineVideos.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" OrElse IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = ""
MsgBox("Source text file Is blank")
Exit Sub
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
If iRows = 0 Then
Exit Sub
End If
Dim iMaxSize As Integer = iRows.ToString().Length
Dim sImageFilePath As String = txtImageFile.Text
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sSrcFolderPath As String = Path.Combine(sFolderPath, sFileName)
If System.IO.Directory.Exists(sSrcFolderPath) = False Then
MsgBox("Source folder Is blank: " & sSrcFolderPath)
Exit Sub
End If
Dim sFfmpegFile As String = GetFfmpegFile()
If IO.File.Exists(sFfmpegFile) = False Then
MsgBox("ffmpeg.exe file is missing: " & sFfmpegFile)
Exit Sub
End If
If MsgBox("Creating video files might take hours. " &
"A small video mp4 file will be created for each mp3 line file. " &
"Existing video files will be skipped. " &
" Are you sure you want to do this?", vbYesNo) <> vbYes Then
Exit Sub
End If
btnCreateLineVideos.Enabled = False
My.Application.DoEvents()
Dim sVideoFolderPath As String = Path.Combine(sFolderPath, sFileName & "-SmallVideos")
If System.IO.Directory.Exists(sVideoFolderPath) = False Then
System.IO.Directory.CreateDirectory(sVideoFolderPath)
End If
Dim sChapterName As String = sFirstChapterName
Dim oExtraLineImages As New ArrayList()
Dim iFileCount As Integer = 0
Dim iRow As Integer = 0
Dim iBlankCount As Integer = 0
Dim iChapterCount As Integer = 1
ProgressBar1.Visible = True
ProgressBar1.Maximum = iRows
lbCount.Visible = True
Dim oStreamReader As System.IO.StreamReader = GetStreamReader(sFilePath)
Dim sLine As String = oStreamReader.ReadLine()
Do Until sLine Is Nothing
iRow += 1
If iBlankCount = 2 AndAlso Trim(sLine) <> "" Then
Dim sSilenceFile As String = CheckForSilence(sLine)
If sSilenceFile <> "" Then
sLine = Replace(sLine, "{{" & sSilenceFile & "}}", "")
End If
sChapterName = PadFileName(Trim(StrConv(sLine, VbStrConv.ProperCase)))
oExtraLineImages = New ArrayList() 'do not show line images from the previous chapter
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
'multiple images referenced by the same line: show the first image now
'show the remaining in later lines thet do no reference images
Dim oList As String() = sLineImageFilePath.Split(",")
sLineImageFilePath = oList(0)
For i As Integer = 1 To oList.Length - 1
oExtraLineImages.Add(oList(i))
Next
End If
ElseIf oExtraLineImages.Count > 0 Then
sLineImageFilePath = oExtraLineImages(0)
If bSilenceFile = False Then
oExtraLineImages.RemoveAt(0)
End If
End If
If IO.File.Exists(sOutputFilePath) = False Then
Dim sInputFilePath2 As String = ""
Dim sTempImageFilePath As String = ""
If sLineImageFilePath <> "" Then
sInputFilePath2 = sLineImageFilePath
ElseIf chkImageText.Checked And sImageFilePath <> "" Then
Try
'Try to add text image
sTempImageFilePath = IO.Path.Combine(GetTempFolder(), GetGuidFileName("png"))
AddTextToImage(sImageFilePath, sChapterName, sTempImageFilePath, bottomMargin)
sInputFilePath2 = sTempImageFilePath
Catch ex As Exception
'Ignore if failed
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
'Cleanup
Try
IO.File.Delete(sTempImageFilePath)
Catch ex As Exception
'Ignore
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
'Create Test.htm file in each sub-folder
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
'If sImageFilePath = "" OrElse IO.File.Exists(sImageFilePath) = False Then
' txtImageFile.Text = ""
' MsgBox("Image file Is blank")
' Exit Sub
'End If
'Dim sVolume As String = "-2.5"
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)
'If IO.File.Exists(sOutputFilePath) Then
' IO.File.Delete(sOutputFilePath)
'End If
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
'Try to add text image
sTempImageFilePath = IO.Path.Combine(GetTempFolder(), GetGuidFileName("png"))
'AddTextToImage(sImageFilePath, PadImageText(sImageText), sTempImageFilePath, bottomMargin)
sImageText = PadImageText(sImageText)
sImageText = StrConv(sImageText, VbStrConv.ProperCase)
AddTextToImage(sImageFilePath, sImageText, sTempImageFilePath, bottomMargin)
sInputFilePath2 = sTempImageFilePath
Catch ex As Exception
'Ignore if failed
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
'Cleanup
Try
IO.File.Delete(sTempImageFilePath)
Catch ex As Exception
'Ignore
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)
' Create a new blank image if the imagePath is empty
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) ' Set the background color to white if there is no image
End Using
Else
' Load the existing image
img = Image.FromFile(imagePath)
End If
' Create a Graphics object from the image
Dim graphics As Graphics = Graphics.FromImage(img)
' Create a brush for the text
Dim brush As New SolidBrush(btnTextColor.BackColor)
' Create a font for the text. Start with a large size.
Dim fontSize As Single = 40
Dim font As New Font("Arial", fontSize)
Dim iLeftMargin As Integer = 0
If txtLeftMargin.Text <> "" Then
iLeftMargin = txtLeftMargin.Text
End If
' Calculate the size of the text
Dim textSize As SizeF = graphics.MeasureString(text, font)
' If the text is too wide, decrease the font size until it fits the image's width
While textSize.Width > (img.Width - (iLeftMargin * 2))
fontSize -= 1
font = New Font("Arial", fontSize)
textSize = graphics.MeasureString(text, font)
End While
If bottomMargin + 100 > img.Height Then
bottomMargin = 0
End If
' Define where the text will be placed (bottom and center of the image, accounting for margin)
Dim rect As New RectangleF(((img.Width - textSize.Width) / 2) + iLeftMargin, img.Height - textSize.Height - bottomMargin, textSize.Width, textSize.Height)
' Fill the rectangle with the background color
Dim bgColorBrush As New SolidBrush(btnBgColor.BackColor)
graphics.FillRectangle(bgColorBrush, rect)
' Draw the string onto the image
graphics.DrawString(text, font, brush, rect)
' Save the image
img.Save(savePath, System.Drawing.Imaging.ImageFormat.Png)
' Clean up
brush.Dispose()
graphics.Dispose()
img.Dispose()
End Sub
Sub MergeMp4Files(ByVal sVideoFolderPath As String, ByVal sOutputFilePath As String, ByVal sFfmpegFile As String, iFileNameLength As Integer)
Dim sFilePath As String = txtSrcFile.Text
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sTempFolderPath As String = Path.Combine(sFolderPath, sFileName & "_one_video_" & DateTime.Now.ToString("yyyyMM_ddHHmmss"))
IO.Directory.CreateDirectory(sTempFolderPath)
'Convert .mp4 to .ts files
ConverMp4toTs(sVideoFolderPath, sTempFolderPath, sFfmpegFile)
'Wait
System.Threading.Thread.Sleep(100)
'Merge TS Files
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
'Chapter MP4 already exists - merge them instead of creating new mp4 file
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), "")
's = Replace(s, " ", "_")
Return Replace(s, "*", "")
End Function
Private Sub DataGridView1_CellClick(sender As Object, e As DataGridViewCellEventArgs) Handles DataGridView1.CellClick
SetupLineText()
End Sub
Private Sub DataGridView1_KeyUp(sender As Object, e As KeyEventArgs) Handles DataGridView1.KeyUp
SetupLineText()
If chkPlayOnKeyUp.Checked Then
Dim sFilePath As String = GetSelectedFielPath()
If sFilePath <> "" Then
PlaySound(sFilePath)
End If
End If
End Sub
Function GetSelectedRowIndex()
If DataGridView1.SelectedRows.Count > 0 Then
Return DataGridView1.SelectedRows(0).Index
ElseIf DataGridView1.SelectedCells.Count > 0 Then
Return DataGridView1.SelectedCells(0).RowIndex
End If
Return -1
End Function
Sub SetupLineText()
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex <> -1 Then
Dim oRow As DataGridViewRow = DataGridView1.Rows(iSelectedRowIndex)
txtLine.Text = oRow.Cells("Text").Value
Me.Text = "Audio Book Creator - " & oRow.Cells("Name").Value
Else
Me.Text = "Audio Book Creator"
End If
End Sub
Function GetSelectedFielPath() As String
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex <> -1 Then
Dim oRow As DataGridViewRow = DataGridView1.Rows(iSelectedRowIndex)
Return oRow.Cells("FilePath").Value
End If
Return ""
End Function
Private Sub txtLine_TextChanged(sender As Object, e As EventArgs) Handles txtLine.TextChanged
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex <> -1 Then
Dim oRow As DataGridViewRow = DataGridView1.Rows(iSelectedRowIndex)
oRow.Cells("Text").Value = txtLine.Text
btnSave.Visible = True
End If
End Sub
Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
SaveTextFile()
End Sub
Sub SaveTextFile()
Dim sFilePath As String = txtSrcFile.Text
Dim oEncoding As System.Text.Encoding = System.Text.Encoding.ASCII
Dim sBackupFilePath As String = ""
If System.IO.File.Exists(sFilePath) Then
oEncoding = DetectEncoding(sFilePath)
Dim sBackupFileName As String = Path.GetFileNameWithoutExtension(sFilePath) & "_" & DateTime.Now.ToString("yyyyMM_ddHHmmss") & Path.GetExtension(sFilePath)
sBackupFilePath = Path.Combine(Path.GetDirectoryName(sFilePath), sBackupFileName)
File.Move(sFilePath, sBackupFilePath)
End If
Dim sw As New StreamWriter(sFilePath, False, oEncoding)
For iRow = 0 To DataGridView1.RowCount - 1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim sText As String = oRow.Cells("Text").Value
Dim sName As String = oRow.Cells("Name").Value
sw.WriteLine(sText)
End If
Next
sw.Close()
If sBackupFilePath <> "" Then
If chkBackupFile.Checked Then
Dim sBackupFolder As String = Path.Combine(Path.GetDirectoryName(sFilePath), Path.GetFileNameWithoutExtension(sFilePath) & "_backup")
If IO.Directory.Exists(sBackupFolder) = False Then
IO.Directory.CreateDirectory(sBackupFolder)
End If
Dim sNewBackupFilePath = Path.Combine(sBackupFolder, Path.GetFileName(sBackupFilePath))
File.Move(sBackupFilePath, sNewBackupFilePath)
Else
File.Delete(sBackupFilePath)
End If
End If
btnSave.Visible = False
End Sub
Function DetectEncoding(filePath As String) As System.Text.Encoding
Dim encoding As System.Text.Encoding = System.Text.Encoding.Default ' Fallback to the default encoding if BOM is not found
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
' Mouse wheel was moved up, increase font size
newSize = currentSize + 1
Else
' Mouse wheel was moved down, decrease font size
newSize = Math.Max(currentSize - 1, 1)
End If
txtLine.Font = New Font(txtLine.Font.FontFamily, newSize, txtLine.Font.Style)
End If
End Sub
Private Sub btnMerge_Click(sender As Object, e As EventArgs) Handles btnMerge.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" OrElse IO.File.Exists(sFilePath) = False Then
MsgBox("Text file is blank")
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sChaptersFolderPath As String = Path.Combine(sFolderPath, sFileName & "-Chapters")
If IO.Directory.Exists(sChaptersFolderPath) = False Then
MsgBox("Chapters folder does not exist: " & sChaptersFolderPath)
Exit Sub
End If
Dim sDestFilePath As String = sFolderPath & "\" & sFileName & ".mp3"
If IO.File.Exists(sDestFilePath) Then
IO.File.Delete(sDestFilePath)
End If
MergeFolder(sChaptersFolderPath, sDestFilePath)
Dim oMP3Info As New Monotic.Multimedia.MP3.MP3Info(sDestFilePath)
txtText.Text = "Created Single MP3 File with Length: " & oMP3Info.Length
MsgBox("Done")
End Sub
Private Sub DeleteFolder(ByVal sFolderPath As String)
If IO.Directory.Exists(sFolderPath) = False Then
Exit Sub
End If
Dim oFiles As String() = System.IO.Directory.GetFiles(sFolderPath)
For Each sFile In oFiles
IO.File.Delete(sFile)
Next
IO.Directory.Delete(sFolderPath)
End Sub
Private Sub btnYouTubeIndex_Click(sender As Object, e As EventArgs) Handles btnYouTubeIndex.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" Then
MsgBox("Text file is blank")
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sChaptersFolderPath As String = Path.Combine(sFolderPath, sFileName & "-Chapters")
If System.IO.Directory.Exists(sChaptersFolderPath) = False Then
MsgBox("Chapters folder does not exist: " & sChaptersFolderPath)
Exit Sub
End If
Dim oForm As New frmYouTube
oForm.sChaptersFolderPath = sChaptersFolderPath
oForm.ShowDialog()
End Sub
Private Sub btnApiKeyShow_Click(sender As Object, e As EventArgs) Handles btnApiKeyShow.Click
If txtApiKey.PasswordChar = "*" Then
txtApiKey.PasswordChar = ""
Else
txtApiKey.PasswordChar = "*"
End If
End Sub
Private Sub selHighlight_SelectedIndexChanged(sender As Object, e As EventArgs) Handles selHighlight.SelectedIndexChanged
DataGridColor()
End Sub
Private Sub urlApiKey_LinkClicked(sender As Object, e As LinkLabelLinkClickedEventArgs) Handles urlApiKey.LinkClicked
Process.Start(New ProcessStartInfo("https://platform.openai.com/api-keys"))
End Sub
Private Sub btnRenameDown_Click(sender As Object, e As EventArgs) Handles btnRenameDown.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" OrElse IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = ""
MsgBox("Text file is blank")
Exit Sub
End If
Dim iRows As Integer = GetFileRowsCount(sFilePath)
If iRows = 0 Then
Exit Sub
End If
Dim iMaxSize As Integer = iRows.ToString().Length
Dim sFolderPath As String = Path.GetDirectoryName(txtSrcFile.Text)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sDestFolderPath As String = Path.Combine(sFolderPath, sFileName)
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex = -1 Then
Exit Sub
End If
If MsgBox("Rename file " & (iSelectedRowIndex + 1) & " and subsequent files by + 1?", MsgBoxStyle.YesNo, " file") <> vbYes Then
Exit Sub
End If
PlaySoundStop()
For iRow = DataGridView1.RowCount - 1 To iSelectedRowIndex Step -1
Dim oRow As DataGridViewRow = DataGridView1.Rows(iRow)
If oRow.IsNewRow = False Then
Dim sSrcFilePath As String = oRow.Cells("FilePath").Value
If sSrcFilePath <> "" AndAlso File.Exists(sSrcFilePath) Then
Dim sDestFileBase As String = Microsoft.VisualBasic.Right("000000" & (iRow + 2), iMaxSize)
Dim sDestFilePath As String = Path.Combine(sDestFolderPath, sDestFileBase & ".mp3")
Try
IO.File.Move(sSrcFilePath, sDestFilePath)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End If
End If
Next
MsgBox("Done")
End Sub
Private Sub btnTextColor_Click(sender As Object, e As EventArgs) Handles btnTextColor.Click
Dim cDialog As New ColorDialog()
If (cDialog.ShowDialog() = DialogResult.OK) Then
btnTextColor.BackColor = cDialog.Color
End If
End Sub
Private Sub btnBgColor_Click(sender As Object, e As EventArgs) Handles btnBgColor.Click
Dim cDialog As New ColorDialog()
If (cDialog.ShowDialog() = DialogResult.OK) Then
btnBgColor.BackColor = cDialog.Color
End If
End Sub
Private Sub chkImageText_CheckedChanged(sender As Object, e As EventArgs) Handles chkImageText.CheckedChanged
txtLeftMargin.Enabled = chkImageText.Checked
txtBottomMargin.Enabled = chkImageText.Checked
btnBgColor.Enabled = chkImageText.Checked
btnTextColor.Enabled = chkImageText.Checked
End Sub
Private Sub btnVideoTest_Click(sender As Object, e As EventArgs) Handles btnVideoTest.Click
Dim bottomMargin As Single = txtBottomMargin.Text
Dim sImageFilePath As String = txtImageFile.Text
Dim oImageTexts As String() = {"Lorem ipsum dolor sit amet, consectetur adipiscing elit.",
"Lorem ipsum dolor sit amet",
"Chapter 1",
"Introduction"}
Dim i As Integer = CInt(oImageTexts.Length * Rnd())
If i > oImageTexts.Length - 1 Then i = oImageTexts.Length - 1
Dim sImageText As String = oImageTexts(i)
Dim sTempImageFilePath As String = IO.Path.Combine(GetTempFolder(), GetGuidFileName("png"))
AddTextToImage(sImageFilePath, sImageText, sTempImageFilePath, bottomMargin)
System.Diagnostics.Process.Start(sTempImageFilePath)
End Sub
Private Sub txtSrcFile_TextChanged(sender As Object, e As EventArgs) Handles txtSrcFile.TextChanged
UpdateFileGrid()
End Sub
Private Sub btnProcessChapter_Click(sender As Object, e As EventArgs) Handles btnProcessChapter.Click
If MsgBox("Are you sure you want to process lines untill blank line?", vbYesNo) <> vbYes Then
Exit Sub
End If
Dim iSelectedRowIndex As Integer = GetSelectedRowIndex()
If iSelectedRowIndex = -1 Then
Exit Sub
End If
btnProcessChapter.Enabled = False
My.Application.DoEvents()
Dim i As Integer = iSelectedRowIndex
Do
Dim oRow As DataGridViewRow = DataGridView1.Rows(i)
Dim sText As String = Trim(oRow.Cells("Text").Value & "")
If sText = "" OrElse i > 100000 Then
Exit Do
Else
ProcessTextFile(i + 1)
i += 1
End If
Loop
UpdateFileGrid()
btnProcessChapter.Enabled = True
MsgBox("Done at line: " & (i + 1))
End Sub
Sub ConverMp4toTs(sSrcFolder As String, sDestChapterFolderPath As String, sFfmpegFile As String)
For Each sSrcFilePath As String In IO.Directory.GetFiles(sSrcFolder)
Dim sDestFilePath As String = Path.Combine(sDestChapterFolderPath, Path.GetFileNameWithoutExtension(sSrcFilePath) & ".ts")
If IO.File.Exists(sDestFilePath) = False Then
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Hidden
startInfo.FileName = sFfmpegFile
startInfo.Arguments = " -i """ & sSrcFilePath & """ -c copy -bsf:v h264_mp4toannexb -f mpegts """ & sDestFilePath & """"
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
End If
Next
End Sub
Sub MergeTsFiles(sFolder, sDestFilePath, sFfmpegFile)
If IO.File.Exists(sDestFilePath) Then
Exit Sub
End If
Dim sTextFilePath As String = Path.Combine(sFolder, "Files.txt")
Dim sw As New StreamWriter(sTextFilePath, False)
For Each sPath As String In IO.Directory.GetFiles(sFolder)
If Path.GetExtension(sPath) = ".ts" Then
sw.WriteLine("file '" & Path.GetFileName(sPath) & "'")
End If
Next
sw.Close()
Dim oProcess As New System.Diagnostics.Process()
Dim startInfo As New System.Diagnostics.ProcessStartInfo()
startInfo.WindowStyle = System.Diagnostics.ProcessWindowStyle.Hidden
startInfo.FileName = sFfmpegFile
startInfo.Arguments = "-f concat -safe 0 -i """ & sTextFilePath & """ -c:v libx264 -c:a aac """ & sDestFilePath & """"
oProcess.StartInfo = startInfo
oProcess.Start()
oProcess.WaitForExit()
System.Threading.Thread.Sleep(1000)
End Sub
Private Sub btnMergeToChapters_Click(sender As Object, e As EventArgs) Handles btnMergeToChapters.Click
Dim sFilePath As String = txtSrcFile.Text
If sFilePath = "" Then
MsgBox("Text file is blank")
Exit Sub
End If
If IO.File.Exists(sFilePath) = False Then
txtSrcFile.Text = ""
MsgBox("Text file is blank")
Exit Sub
End If
Dim sFfmpegFile As String = GetFfmpegFile()
If IO.File.Exists(sFfmpegFile) = False Then
MsgBox("ffmpeg.exe file is missing: " & sFfmpegFile)
Exit Sub
End If
Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
Dim sSrcFolderPath As String = Path.Combine(sFolderPath, sFileName & "-SmallVideos")
If System.IO.Directory.Exists(sSrcFolderPath) = False Then
MsgBox("Source folder Is blank: " & sSrcFolderPath)
Exit Sub
End If
Dim sDstFolderPath As String = Path.Combine(sFolderPath, sFileName & "-LineChapters")
If System.IO.Directory.Exists(sDstFolderPath) = False Then
System.IO.Directory.CreateDirectory(sDstFolderPath)
End If
btnMergeToChapters.Enabled = False
My.Application.DoEvents()
'Convert .mp4 to .ts files
For Each sSubFolder As String In IO.Directory.GetDirectories(sSrcFolderPath)
Dim sChapterName As String = IO.Path.GetFileName(sSubFolder)
Dim sDestChapterFolderPath As String = Path.Combine(sDstFolderPath, sChapterName)
If System.IO.Directory.Exists(sDestChapterFolderPath) = False Then
System.IO.Directory.CreateDirectory(sDestChapterFolderPath)
End If
ConverMp4toTs(sSubFolder, sDestChapterFolderPath, sFfmpegFile)
Next
'Wait
System.Threading.Thread.Sleep(100)
'Merge TS Files
For Each sSubFolder As String In IO.Directory.GetDirectories(sDstFolderPath)
Dim sDestFilePath As String = sSubFolder & ".mp4"
MergeTsFiles(sSubFolder, sDestFilePath, sFfmpegFile)
Next
'Delete .ts files
If MsgBox("Done. Do you want to delete temp (.ts) folders? You can delete them manully later, all or induvidually.", vbYesNo) = vbYes Then
For Each sSubFolder As String In IO.Directory.GetDirectories(sDstFolderPath)
System.IO.Directory.Delete(sSubFolder, True)
Next
End If
btnMergeToChapters.Enabled = True
MsgBox("Done")
End Sub
Private Sub txtTest_Click(sender As Object, e As EventArgs)
'Dim sFilePath As String = txtSrcFile.Text
'Dim sFolderPath As String = Path.GetDirectoryName(sFilePath)
'Dim sFileName As String = Path.GetFileNameWithoutExtension(sFilePath)
'Dim sVideoFolderPath As String = Path.Combine(sFolderPath, sFileName & "-SmallVideos")
'Dim oFolders As String() = System.IO.Directory.GetDirectories(sVideoFolderPath)
'For Each sSubFolder As String In oFolders
' For Each sPath As String In IO.Directory.GetFiles(sSubFolder)
' If Path.GetExtension(sPath) = ".mp4" Then
' Dim oFileInfo As New IO.FileInfo(sPath)
' If (Now - oFileInfo.LastWriteTime).TotalHours < 20 Then
' oFileInfo.Delete()
' End If
' End If
' Next
'Next
MsgBox("Done")
End Sub
End Class
历史
- 2023年11月10日：创建版本1
- 2023年12月15日：创建版本2（处理Open AI请求节流和文本背景颜色）
- 2024年1月2日：创建版本2（视频图像文本颜色和测试）
- 2024年4月26日：创建版本3（支持图形，使用.ts改进单个视频文件合并）