Распознавание речи в Visual Basic

[allegro]

Доброго времени суток!

Есть желание сделать возможность заполнения поля формы посредством речи, как в многочисленных приложениях на телефонах с установленной ОС Android. Разумеется, писать это дело с нуля крайне сложно, для нуба вроде меня вообще невозможно. Однако ничто не мешает использовать уже готовые наработки.
Итак, за основу берется всем известный гугловский распознаватель речи. Как пишут в интернете, процесс его использования довольно просто. В двух словах нужно:
-записать звук, надиктованный в микрофон
-переконвертить его в формат flac
-заслать это дело, собственно, в гугл, откуда придет ответ

Ну, с записью аудиофайла при помощи микрофона проблем нет - используем встроенный компонент MMControl. Все работает.

А теперь вопрос - как это дело конвертнуть во FLAC?

Если ошибся разделом - прошу извинить, на форуме я новичок...

[FireFenix]

В винде есть спецом апи по Speech Recognition, нужно ковырять WinAPI -> http://en.wikipedia.org/wiki/Microsoft_Speech_API

А теперь вопрос - как это дело конвертнуть во FLAC?

Искать библиотеку или написать самому выкурив стаднарт

[allegro]

В винде есть спецом апи по Speech Recognitio

Я думал об этом, но, почитав интернеты, пришел к выводу, что с русским языком эта штука не сработает...(((

Искать библиотеку

Библиотеку вроде как нашел. Что делать дальше? Не очень понимаю, как писать код для конвертации. Не забывайте, я все-таки нуб))))

[FireFenix]

В винде есть спецом апи по Speech Recognitio

Я думал об этом, но, почитав интернеты, пришел к выводу, что с русским языком эта штука не сработает...(((

Да ну, это дефолтная фитча > Win7, а т.к. винда интернациональна, то и распознование интернациональное должно быть.

Искать библиотеку

Библиотеку вроде как нашел. Что делать дальше? Не очень понимаю, как писать код для конвертации. Не забывайте, я все-таки нуб))))

Ну ты так говоришь, как буд-то мы каждый день только и кодим распознаватели речи

Лично я без понятия как его использовать, поэтому могу посоветовать только http://www.google.ru

[NashRus]

Да ну, это дефолтная фитча > Win7, а т.к. винда интернациональна, то и распознование интернациональное должно быть.

Не должно и нету.

На исходниках есть раздел, посвященный речевым технологиям.
И есть там знающие люди.

А твоя задача в принципе к распознаванию речи отношения не имеет.
То, что ты задумал, давно есть и в сырцах где-нибудь на гитхабе. гугли.
На хабре вроде несколько статей было.

Можно даже попробывать выпилить движок из исходников последнего андроида.
Они на клиент вроде тоже перенесли распознавание.
Ну и с лицензией разобраться если что.

[hclubmk]

Cинтез ч/з Гугл примерно так:

Код: Выделить всё

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Sub Command1_Click()
    GoogleSpeak "Это пример озвучки Google"
    GoogleSpeak "Голос очень напоминает Акапелкину Аленку"
End Sub

Private Sub Form_Load()
   InitCommonControls
End Sub

Function Text2UTF8(text As String) As String
    Dim i, c, utfc, b1, b2, b3
   
    For i = 1 To Len(text)
        c = ToLong(AscW(Mid(text, i, 1)))
 
        If c < 128 Then
            utfc = "%" & Hex(c)
        ElseIf c < 2048 Then
            b1 = c Mod &H40
            b2 = (c - b1) / &H40
            utfc = "%" & Hex(&HC0 + b2) & "%" & Hex(&H80 + b1)
        ElseIf c < 65536 And (c < 55296 Or c > 57343) Then
            b1 = c Mod &H40
            b2 = ((c - b1) / &H40) Mod &H40
            b3 = (c - b1 - (&H40 * b2)) / &H1000
            utfc = "%" & Chr(&HE0 + b3) & "%" & Chr(&H80 + b2) & "%" & Chr(&H80 + b1)
        Else
            ' UTF-16
            utfc = "%" & Chr(&HEF) & "%" & Chr(&HBF) & "%" & Chr(&HBD)
        End If

        Text2UTF8 = Text2UTF8 + utfc
    Next
End Function

Function ToLong(intVal)
    If intVal < 0 Then
        ToLong = CLng(intVal) + &H10000
    Else
        ToLong = CLng(intVal)
    End If
End Function

Private Sub GoogleSpeak(text As String)
Dim FileLength As Long
Dim sTempPath As String, ML As String

sTempPath = App.Path & "\TempGVoice.MP3"
    If URLDownloadToFile(0&, "http://translate.google.ru/translate_tts?ie=UTF-8&q=" & Text2UTF8(text) & "&tl=ru&total=1&idx=0&textlen=" & Len(text), sTempPath, 0&, 0&) = 0 Then
        If mciSendString("open " & Chr$(34) & sTempPath & Chr$(34) & " type MpegVideo" & " alias myfile", 0&, 0&, 0&) = 0 Then
            ML = String(30, 0)
            Call mciSendString("status myfile length ", ML, 30, 0&)
            FileLength = Val(ML)
            If FileLength Then
              If mciSendString("set myFile speed " & 1050, "", 0, 0) = 0 Then
                If mciSendString("play myFile", 0&, 0&, 0&) = 0 Then
                    Do While mciSendString("status myfile position ", ML, 30, 0&) = 0
                        If Val(ML) = FileLength Then Exit Do
                        If bDoEvents Then DoEvents
                    Loop
                End If
              End If
            End If
            Call mciSendString("close myfile", 0&, 0&, 0&)
        End If
        Kill sTempPath
    End If
End Sub


Распознавание так:

Код: Выделить всё

Private Sub Command1_Click()
Dim arr() As Byte
Open App.Path & "\tmp.flac" For Binary Access Read As #1
ReDim arr(LOF(1)) As Byte
Get #1, , arr
    Inet1.Execute "https://www.google.com/speech-api/v1/recognize?xjerr=1&client=chromium&lang=ru-RU", "POST", StrConv(arr(), vbUnicode), "Content-Type: audio/x-flac; rate=8000"
Close #1
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
If State = icResponseCompleted Then
      Dim vtData As Variant
      Dim strData As String: strData = ""
      Dim bDone As Boolean: bDone = False

      ' Первый чанк
      vtData = Inet1.GetChunk(1024, icString)
      DoEvents
      Do While Not bDone
         strData = strData & vtData
         DoEvents
         ' Следующий чанк
         vtData = Inet1.GetChunk(1024, icString)
         If Len(vtData) = 0 Then
            bDone = True
         End If
      Loop
      Debug.Print DecodeUTF8(parseAnswer(strData))
End If
End Sub

Function parseAnswer(a As String) As String
Dim sPos As Long
    sPos = InStr(1, a, Chr$(34) & "utterance" & Chr$(34) & ":" & Chr$(34), vbTextCompare)
    parseAnswer = Mid(a, 13 + sPos, InStrRev(a, Chr$(34) & "," & Chr$(34) & "confidence" & Chr$(34)) - (13 + sPos))
End Function

Function DecodeUTF8(s As String) As String
    Dim i As Long, c As Long, n As Long, b1 As Integer, b2 As Integer, b3 As Integer

    i = 1
    Do While i <= Len(s)
        c = Asc(Mid(s, i, 1))
        If (c And &HC0) = &HC0 Then
            n = 1
            Do While i + n <= Len(s)
                If (Asc(Mid(s, i + n, 1)) And &HC0) <> &H80 Then
                    Exit Do
                End If
                n = n + 1
            Loop
            If n = 2 And ((c And &HE0) = &HC0) Then
                b1 = Asc(Mid(s, i + 1, 1)) And &H3F
                b2 = c And &H1F
                c = b1 + b2 * &H40
            ElseIf n = 3 And ((c And &HF0) = &HE0) Then
                b1 = Asc(Mid(s, i + 2, 1)) And &H3F
                b2 = Asc(Mid(s, i + 1, 1)) And &H3F
                b3 = c And &HF
                c = b3 * &H1000 + b2 * &H40 + b1
            Else
                c = &HFFFD
            End If
            s = Left(s, i - 1) + ChrW(c) + Mid(s, i + n)
        ElseIf (c And &HC0) = &H80 Then
            s = Left(s, i - 1) + ChrW(&HFFFD) + Mid(s, i + 1)
        End If
        i = i + 1
    Loop
    DecodeUTF8 = s
End Function

Если интересуют детали, вроде на хабре было.

[allegro]

hclubmk, большое спасибо за код. Хотя где-то я его уже видел, скорее всего это в ваших сообщениях и было, ибо аватарка знакомая
Однако ж вопрос остается открытым - как мой записанный с микрофона и сохраненный на жестком диске wav-файл перекодить в flac, чтобы потом заслать в гугл?

[hclubmk]

http://flac.sourceforge.net/

[allegro]

Да, этот сайт я тоже уже нашел... только конвертер написать не получается(((

[Хакер]

Почему не получается? Вообще-то на форуме имеет смысл писать, что именно не получается, а не сам факт того, что что-то не получается.

[allegro]

Честно - я вообще очень плохо представляю, как писать какой-нибудь конвертер. Сейчас пытаюсь найти в интернетах какую-нибудь статью или мануал толковый, чтобы получить нормальное представление, но пока безуспешно. Найденные мною книжки об этом молчат. Вот и спрашиваю у знатоков - может хоть вы объясните, как делать, или, на худой конец, ссылку толковую дадите...