Bing translator class

[NeoTechni]

Why Bing and not Google? Bing supports Klingon.
Requirements: HttpUtils, StringUtils, JSON

Usage:
-Register your app: https://datamarket.azure.com/developer/applications/ to get an app id/secret
-set up HttpUtils properly
-call Initialize(me, event name, secret, app id)
-Put this code in your httputils JobDone

Select Case Job
      Case "BING.AUTH", "BING.TRANS" 'Replace BING with your event name
         If HttpUtils.SuccessfulUrls.Size>0 Then
            Translator.JobDone(Job, HttpUtils.GetString(HttpUtils.SuccessfulUrls.GetKeyAt(0)))
         Else
            Translator.Failed(True, HttpUtils.GetLastError)
         End If
end select

-call Translate(Text, srcLang, destLang)
the SupportedLanguages map contains all the full language names it supports (keys), and their ID codes (values) srcLang/destLang use the ID codes
-It'll call either Error or Done
Since you only get 2 million characters translated free per month, you can impose a character limit per translation using the MaxChars value
-The History map contains keys in the format of text.toLowercase.Trim & " (" & srclangID & "-" & destlangID & ")" where the value contains the translated text
This is so you have both a history, and a cache to eliminate/reduce duplicate translations.

'Class module
Sub Class_Globals
   'These global variables will be declared once when the application starts.
   'These variables can be accessed from all modules.

   'Dim scope as string = "http://api.microsofttranslator.com"
   'Dim grant_type as string "client_credentials"
   Dim client_secret As String,client_id As String, access_token As String, token_type As String, expires_at As Long, scope As String ,MaxChars As Int
   Dim CurrentText As String, TranslatedText As String,Src As String, Dest As String , SupportedLanguages As Map ,isTranslating As Boolean ,History As Map 
   Dim MustBeKlingon As Boolean,IsNew As Boolean  'Klingon specific stuff can be removed
   
   Private module As Object, eventName As String
End Sub

'BEGIN Klingon specific stuff can be removed
Public Sub IsInvolvingKlingon(SrcLang As String, DestLang As String) As Boolean 
   If Not(MustBeKlingon) Then Return True
   Return IsKlingon(SrcLang) OR IsKlingon(DestLang)
End Sub
Public Sub IsKlingon(ShortString As String)As Boolean 
   Return ShortString.EqualsIgnoreCase("tlh") OR ShortString.EqualsIgnoreCase("tlh-QON") 
End Sub
Public Sub KlingonLanguage(IsKronos As Boolean) As String 
    If IsKronos Then 
       Return "tlh-QON"
   Else
      Return "tlh"
   End If 
End Sub
'END Klingon specific stuff can be removed (However there's more below)

Public Sub ClearHistory
   History.Initialize 
End Sub

'Register your app: https://datamarket.azure.com/developer/applications/
Public Sub Initialize(ModulePar As Object, EventNamePar As String, Secret As String, ID As String)
   module = ModulePar
    eventName = EventNamePar
   client_secret=Secret
   client_id=ID 
   InitLangs
End Sub

Private Sub InitLangs
   Dim temp As Int  ,su As StringUtils'su.EncodeUrl(access_token, "UTF8")
   If Not(SupportedLanguages.IsInitialized) Then
      SupportedLanguages.Initialize 
      Dim keys() As String = Array As String("","ar","bg","ca","zh-CHS","zh-CHT","cs","da","nl","en","et","fi","fr","de","el","ht","he","hi","mww","hu","id","it","ja","tlh","tlh-QON","ko","lv","lt","ms","no","fa","pl","pt","ro","ru","sk","sl","es","sv","th","tr","uk","ur","vi")
      Dim values() As String = Array As String("Auto-Detect","Arabic","Bulgarian","Catalan","Chinese Simplified","Chinese Traditional","Czech","Danish","Dutch","English","Estonian","Finnish","French","German","Greek","Haitian Creole","Hebrew","Hindi","Hmong Daw","Hungarian","Indonesian","Italian","Japanese","Klingon","Klingon (Kronos)","Korean","Latvian","Lithuanian","Malay","Norwegian","Persian","Polish","Portuguese","Romanian","Russian","Slovak","Slovenian","Spanish","Swedish","Thai","Turkish","Ukrainian","Urdu","Vietnamese")
      For temp = 0 To keys.Length-1
         SupportedLanguages.Put(values(temp).ToLowerCase, su.EncodeUrl(keys(temp), "UTF8"))
      Next
      ClearHistory
   End If
End Sub

'Returns empty if it's not found
Public Sub GetLanguageName(ShortString As String) As String 
   Dim temp As Int 
   For temp = 0 To SupportedLanguages.Size -1 
      If ShortString.EqualsIgnoreCase(SupportedLanguages.GetValueAt(temp)) Then
         Return SupportedLanguages.GetKeyAt(temp)
      End If
   Next
   Return ""
End Sub
Public Sub GetLanguageID(LongString As String) As String 
   Return SupportedLanguages.Get(LongString.ToLowerCase)
End Sub

Private Sub RaiseEvent(Event As String)
   If SubExists(module, eventName  & "_" & Event) Then CallSub(module, eventName  & "_" & Event)
End Sub 
Private Sub RaiseEvent1Par(Event As String, Par1 As Object)
   If SubExists(module, eventName  & "_" & Event) Then CallSub2(module, eventName  & "_" & Event, Par1)
End Sub 
Private Sub RaiseEvent2Pars(Event As String, Par1 As Object, Par2 As Object)
   If SubExists(module, eventName  & "_" & Event) Then CallSub3(module, eventName  & "_" & Event, Par1, Par2)
End Sub 

Sub Failed(External As Boolean, Message As String)
   RaiseEvent1Par("Error", Message)
   If External Then isTranslating=False
End Sub
'Sub Response(JobName As String, Data As HttpResponse)
'   Dim M As Map = Data.GetHeaders  
'   Log("Response-" & JobName & ": " & M)
'End Sub

Sub JobDone(JobName As String, Text As String)
   Dim JSON As JSONParser , Data As Map ,su As StringUtils'su.EncodeUrl(access_token, "UTF8")
   Select Case JobName
      Case eventName & ".AUTH"
         expires_at= DateTime.Now+ (DateTime.TicksPerMinute*10)-1
         JSON.Initialize(Text)
         Data = JSON.NextObject
         access_token = su.EncodeUrl("Bearer " & Data.Get("access_token"), "UTF8")
         Translate(CurrentText,Src,Dest)
      Case eventName & ".TRANS"
         isTranslating=False
         TranslatedText=Text.SubString2(4, Text.Length-3)
         'History.Put(CurrentText.ToLowerCase & "|" & Src & "|" & Dest", TranslatedText)
         History.Put(MakeKey(CurrentText, Src, Dest), TranslatedText)
         IsNew=True
         RaiseEvent2Pars("Done", CurrentText, TranslatedText)
   End Select
End Sub

Private Sub ObtainAccessToken As Boolean 
   If expires_at <= DateTime.Now OR access_token.Length=0 Then
      HttpUtils.PostString(eventName & ".AUTH", "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13/", "client_secret=" & client_secret & "&client_id=" & client_id & "&scope=http://api.microsofttranslator.com&grant_type=client_credentials")
      Return True
   End If
End Sub

Private Sub MakeKey(Text As String, SrcLang As String, DestLang As String) As String 
   If Not(IsKlingon(SrcLang)) Then Text = Text.ToLowerCase 
   Return Text.Trim.Replace("  ", " ") & "|" & SrcLang & "|" & DestLang
End Sub

Sub AutoTranslate
   Translate(CurrentText,Src,Dest)
End Sub

Sub Translate(Text As String, SrcLang As String, DestLang As String) As Boolean 
   Dim URL As String ,su As StringUtils'su.EncodeUrl(access_token, "UTF8")
   Text=Text.Replace("|", " ").Trim.Replace("  ", " ")
   URL=MakeKey(Text,SrcLang,DestLang)'  Text.ToLowerCase & "|" & SrcLang & "|" & DestLang
   If History.ContainsKey(URL) Then
      IsNew=False
      RaiseEvent2Pars("Done", Text, History.Get(URL))
   Else If IsConnected AND Not(SrcLang.EqualsIgnoreCase(DestLang)) AND DestLang.Length>0 AND Not(isTranslating) AND (Text.Length<=MaxChars OR MaxChars=0) AND Text.Length>0 AND IsInvolvingKlingon(SrcLang,DestLang) Then'<-- Klingon specific stuff can be removed
      CurrentText=Text'There is Klingon specific stuff in the line above this
      TranslatedText=""
      Src=SrcLang
      Dest=DestLang
      If Not(ObtainAccessToken) Then
         '"http://api.microsofttranslator.com/V2/Ajax.svc/Translate" +
                '"?appId=Bearer " + encodeURIComponent(window.accessToken) +
                '"&from=" + encodeURIComponent(from) +
                '"&to=" + encodeURIComponent(To) +
                '"&text=" + encodeURIComponent(Text) +
                '"&oncomplete=mycallback";
         Text = su.EncodeUrl(Text, "UTF8")
         URL="http://api.microsofttranslator.com/V2/Ajax.svc/Translate?appId=" & access_token & "&from=" & SrcLang & "&to=" & DestLang & "&text=" & Text & "&oncomplete=t"
         HttpUtils.Download(eventName & ".TRANS", URL)

         'HttpUtils.PostString("BING.TRANS",  "http://api.microsofttranslator.com/v2/Http.svc/Translate?text=" & Text & "&from=" & SrcLang & "&to=" & DestLang, "&Authorization=" & access_token)
      End If
      Return True
   Else 
      If isTranslating Then
         Failed(False, "Translation already in progress")
      Else If DestLang.Length=0 Then
         Failed(False, "Destination language not specified")
      Else If Text.Length = 0 Then
         Failed(False, "No input text given")
      Else If Text.Length>MaxChars AND MaxChars>0 Then
         Failed(False, "Input text is longer than " & MaxChars & " characters")
      Else If DestLang.EqualsIgnoreCase(SrcLang) Then
         Failed(False, "Input and output languages are the same")
      Else If Not(IsInvolvingKlingon(SrcLang,DestLang)) Then      '<-- Klingon specific stuff can be removed
         Failed(False, "One of the languages must be Klingon")   '<-- Klingon specific stuff can be removed
      Else
         Failed(False, "You are not currently online")
      End If
   End If
End Sub

Sub IsConnected As Boolean 
   Dim P As Phone,server As ServerSocket'Add a reference to the network library  'Check status: DISCONNECTED 0
   Try
       server.Initialize(0, "")
      'Log("mobile data state: " & P.GetDataState & " wifi_on: " & P.GetSettings("wifi_on") & " server ip: " & server.GetMyIP & CRLF &  "wifi ip: " & server.GetMyWifiIP)
       If server.GetMyIP = "127.0.0.1" Then Return False  'this is the local host address
      If Not(P.GetDataState.EqualsIgnoreCase("CONNECTED")) AND server.GetMyWifiIP = "127.0.0.1" Then Return False
       Return True
   Catch
      Return False
   End Try
End Sub

 

[mcmanu]

Hi

Do you have a working Example?
I dont get it work

in Httputils there is no Jobdone sub
Where do i have to put initialize()?

Can you give me an Example?

Thank you in advance

 

[NeoTechni]

HttpUtils doesn't have a JobDone sub, it calls one from wherever you set it up (ie: Main)

And you MUST register with Microsoft first.

Sub Process_Globals
   Dim Translator As BING 
End Sub

Sub Activity_Create(FirstTime As Boolean)
   Translator.Initialize(Me, "BING", "PUT YOUR SECRET HERE", "PUT YOUR APP ID HERE")
   HttpUtils.CallbackActivity="Main"
   HttpUtils.CallbackJobDoneSub = "JobDone"
   HttpUtils.CallbackUrlDoneSub = "UrlDone"
End Sub

Sub JobDone (Job As String)
        Select Case Job
                Case "BING.AUTH", "BING.TRANS"
                        If HttpUtils.SuccessfulUrls.Size>0 Then
                                Translator.JobDone(Job, HttpUtils.GetString(HttpUtils.SuccessfulUrls.GetKeyAt(0)))
                        Else
                                Translator.Failed(True, HttpUtils.GetLastError)
                            End If
        end select
end Sub

Sub BING_Error(Message As String)
   log("Bing Error: " & message)
end sub

Sub BING_Done(Source As String, Translated As String )
   log("Bing Translated: '" & Source & "' as '" & Translated & "'")
end sub

I added a new feature that ties into the history map.
Checking .IsNew will tell you if it's a new translation or a cached one.
And I changed it so BING in the job name is replaced with eventName, so you could run more than one if you wanted to.

 

[mcmanu]

HI

All right, Thank you I will give it a try

 

[mcmanu]

Hi,
Iam getting always this error message when i try to translate something the second time.
TanslateApiException: Cannot find an active Azure Market Place Translator Subscription associated with the request credentials. :

Do you know how to handle it?

 

[NeoTechni]

Id imagine you havent registered your app, or you didnt put the keys/data in the right variables. Other than that, no idea

 

[mcmanu]

I have registered an app and put the keys in the variables but the second time i translate a text it throws this error message which i wrote above.

I red some blogs where a lot of people have the same problem.
Maybe its a bug from Microsoft

 

[Theera]

Hi Neotechni,
I worder that the GetLastError isn't member of HttpUtils,is it? How to fix this problem?

P.S. I downloaded it version 1.04