Переводчик в Бэйсике

Private Type Language
    Name As String
    Src As String
    Dest As String
End Type
 
Dim Lang(1) As Language
 
Private Sub Command1_Click()
    Text2.Text = TL.Translate(Text1.Text, Lang(Combo1.ListIndex).Dest, Lang(Combo1.ListIndex).Src)
End Sub
 
Private Sub Form_Load()
    Dim i&
    With Lang(0): .Name = "Англ. -> Рус.": .Src = "en": .Dest = "ru": End With
    With Lang(1): .Name = "Рус. -> Англ.": .Src = "ru": .Dest = "en": End With
    For i = 0 To UBound(Lang)
        Combo1.AddItem Lang(i).Name
    Next
    Combo1.ListIndex = 0
End Sub

'---------------------------------------------------------------------------------------
' Модуль    : modFunctions
' Автор     : EducatedFool (Игорь)                    Дата: 29.03.2011
' Разработка макросов для Excel, Word, CorelDRAW. Быстро, профессионально, недорого.
' [url]http://excelvba.ru/[/url]          ICQ: 5836318           Skype: ExcelVBA.ru
' Реквизиты для оплаты: [url]http://excelvba.ru/payments[/url]
'---------------------------------------------------------------------------------------
 
Function Translate$(ByVal TextToBeTranslated$, ByVal resultLanguageCode$, _
                    Optional ByVal sourceLanguageCode$ = "")
    ' переводит текст TextToBeTranslated$ с языка sourceLanguageCode$
    ' на язык resultLanguageCode$, используя сервис переводов Google Translate
'    Application.Volatile True
    Set ADOStream = CreateObject("ADODB.Stream")
    With ADOStream
        .Charset = "utf-8": .Mode = 3: .Type = 2: .Open
        .WriteText TextToBeTranslated: .Flush: .Position = 0
        .Type = 1: .Read 3: ByteArrayToEncode = .Read(): .Close
    End With
 
    For i = 0 To UBound(ByteArrayToEncode)
        iAsc = ByteArrayToEncode(i)
        Select Case iAsc    ' переводим текст в кодировку, понятную Google
            Case 32: sTemp$ = "+"    'space
            Case 48 To 57, 65 To 90, 97 To 122: sTemp$ = Chr(ByteArrayToEncode(i))
            Case Else: sTemp$ = "%" & Hex(iAsc)     'Chr(iAsc)
        End Select
        txt$ = txt$ & sTemp$
    Next
 
    ' формируем ссылку, по которой Google выдаст нам файл с переводом
    URL$ = "http://translate.google.com.ua/translate_a/t?client=json&text=" & _
           txt$ & "&hl=" & resultLanguageCode$ & "&sl=" & sourceLanguageCode$
 
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")    ' скачиваем файл
    XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False": XMLHTTP.send
 
    If XMLHTTP.statustext = "OK" Then
        LocalPath$ = Environ("TMP") & "\google.txt"
        With ADOStream    ' перекодировка файла
            .Type = 1: .Open: .Write XMLHTTP.responseBody
            .SaveToFile LocalPath$, 2
            .Close: .Type = 2: .Charset = "utf-8": .Open:
            .LoadFromFile LocalPath$    ' загружаем данные из файла
            Translate$ = .ReadText   ' считываем текст файла в переменную Translate$
        End With
 
        On Error Resume Next    ' вырезаем нужный текст из ответа
        Translate$ = Split(Translate$, """trans"":""")(1)
        Translate$ = Split(Translate$, """,""orig")(0)
        Translate$ = Replace(Translate$, "quot;", Chr(39))
        If Translate$ = " null, " Then Translate$ = "Не переведено"
    End If
    Set XMLHTTP = Nothing: Set ADOStream = Nothing
End Function