Soyez le premier à donner votre avis sur cette source.
Vue 8 709 fois - Téléchargée 673 fois
Public Class GoogleTranslation Public Enum Langue Anglais Allemand Espagnol Francais Italien ChinoisSimplifie ChinoisTraditionel Arabe Coreen Grec Hebreu Hindi Japonais Polonais Portuguais Roumain Russe End Enum Public Shared Function TraductionGoogle(ByRef TexteAtraduire As String, ByVal langueAvant As Langue, ByVal langueApres As Langue) As Boolean 'cette étape a pour unique but de gérer les sauts de lignes, et d'augmenter la capacité en traitant le texte paragraphe par paragraphe. If TexteAtraduire.Contains(ControlChars.Lf) Then Dim success As Boolean = True Dim separateur As String = vbCrLf Dim paragraphes() As String paragraphes = TexteAtraduire.Split(ControlChars.Lf) For x = 0 To paragraphes.Length - 1 If TraductionGoogleSimplification(paragraphes(x), langueAvant, langueApres) = False Then success = False Next TexteAtraduire = String.Join(vbCrLf, paragraphes) Return success Else 'si aucun saut de ligne: Return TraductionGoogleSimplification(TexteAtraduire, langueAvant, langueApres) End If End Function Private Shared Function TraductionGoogleSimplification(ByRef TexteAtraduire As String, ByVal langueAvant As Langue, ByVal langueApres As Langue) As Boolean If langueApres = langueAvant Then Exit Function 'VERIFICATION DE LA LONGUEUR DE TexteATraduire: If TexteAtraduire.Length > 999 Then TexteAtraduire = TexteAtraduire.Substring(0, 997) Try TexteAtraduire = TexteAtraduire.Substring(0, TexteAtraduire.LastIndexOf(".") + 1) TexteAtraduire = TexteAtraduire & "[…]" Catch ex As Exception End Try End If 'APPEL DE LA FONCTION PRINCIPALE Dim sResult$ = "" Dim sMsgErr$ = "" Dim bVerifierDispo As Boolean = False If TraduireViaApiAjax(TexteAtraduire, interpreterLangue(langueAvant), interpreterLangue(langueApres), _ sResult, sMsgErr, bVerifierDispo) Then TexteAtraduire = sResult Return True Else TexteAtraduire = sMsgErr If bVerifierDispo Then If My.Computer.Network.IsAvailable Then ' Internet est pourtant dispo., c'est donc le site de Google qui ne l'est pas TexteAtraduire = "Site de traduction google indisponible" End If End If Return False End If End Function Private Shared Sub TraductionFormulaire_Google(ByVal formulaire As Form, Optional ByVal langueDepart As Langue = Langue.Francais, Optional ByVal langueApres As Langue = Langue.Anglais) 'fonction pour traduire un formulaire TraductionGoogle(formulaire.Text, langueDepart, langueApres) For Each objetTemporaire As Control In formulaire.Controls Try TraductionGoogle(objetTemporaire.Text, langueDepart, langueApres) Catch ex As Exception End Try If TypeOf objetTemporaire Is GroupBox Then Dim monConteneur As Control.ControlCollection = CType(objetTemporaire, GroupBox).Controls For Each sousControle As Control In monConteneur Try TraductionGoogle(sousControle.Text, langueDepart, langueApres) Catch ex As Exception End Try My.Application.DoEvents() Next End If My.Application.DoEvents() Next End Sub Public Shared Sub TraductionProjet_Google(Optional ByVal langueDepart As Langue = Langue.Francais, Optional ByVal langueApres As Langue = Langue.Anglais) Try For Each Formulaire As Form In My.Application.OpenForms TraductionFormulaire_Google(Formulaire, langueDepart, langueApres) My.Application.DoEvents() Next Catch ex As Exception End Try End Sub Private Shared Function interpreterLangue(ByVal language As Langue) As String Select Case language Case Langue.Francais Return "fr" Case Langue.Anglais Return "en" Case Langue.Espagnol Return "es" Case Langue.Allemand Return "de" Case Langue.Italien Return "it" Case Langue.ChinoisSimplifie Return "zh(-CN)" Case Langue.ChinoisTraditionel Return "zh(-TW)" Case Langue.Coreen Return "ko" Case Langue.Grec Return "el" Case Langue.Hebreu Return "iw" Case Langue.Hindi Return "hi" Case Langue.Japonais Return "ja" Case Langue.Polonais Return "pl" Case Langue.Portuguais Return "pt" Case Langue.Roumain Return "ro" Case Langue.Russe Return "ru" Case Langue.Arabe Return "ar" Case Else Return "en" End Select End Function Private Shared Function TraduireViaApiAjax(ByVal stringToTranslate$, _ ByVal fromLanguage$, ByVal toLanguage$, _ ByRef sTrad$, ByRef sMsgErr$, ByRef bVerifierDispo As Boolean) As Boolean ' Google AJAX Language API ' http://code.google.com/intl/fr/apis/ajaxlanguage/ ' D'après : ' http://www.codeproject.com/KB/aspnet/Translate_Your_Website.aspx ' Avec la conversion en VB.Net : ' http://www.vbfrance.com/auteur/GILLARDG/1360034.aspx sMsgErr = "" sTrad = "" ' Make sure that the passed string is not empty or null If String.IsNullOrEmpty(stringToTranslate) Then sMsgErr = "" Exit Function End If ' Per google's terms of use, we can only translate ' a string of up to 5000 characters long ' En pratique c'est 1000 caractère, sinon : Net.HttpStatusCode.RequestUriTooLong If stringToTranslate.Length > 1000 Then sMsgErr = "String to translate must be less than 1000 characters long." Exit Function End If Const bufSizeMax As Integer = 65536 Const bufSizeMin As Integer = 8192 Try ' By default format? is text. so we don't need to send a format? key Dim requestUri$ = _ "http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&q=" & _ stringToTranslate & "&langpair=" & fromLanguage & "%7C" & toLanguage ' Execute the request and get the response stream Dim request As Net.HttpWebRequest = _ CType(Net.WebRequest.Create(requestUri), Net.HttpWebRequest) Dim response As Net.HttpWebResponse = _ CType(request.GetResponse(), Net.HttpWebResponse) Dim responseStream As IO.Stream = response.GetResponseStream() ' Get the length of the content returned by the request Dim length As Integer = CInt(Fix(response.ContentLength)) Dim bufSize As Integer = bufSizeMin If length > bufSize Then If length > bufSizeMax Then bufSize = bufSizeMax Else bufSize = length End If End If ' Allocate buffer and StringBuilder for reading response Dim buf(bufSize - 1) As Byte Dim sb As New System.Text.StringBuilder(bufSize) ' Read the whole response length = responseStream.Read(buf, 0, buf.Length) Do While length <> 0 sb.Append(System.Text.Encoding.UTF8.GetString(buf, 0, length)) length = responseStream.Read(buf, 0, buf.Length) Loop ' The format of the response is like this ' {"responseData": {"translatedText":"¿Cómo estás?"}, "responseDetails": null, "responseStatus": 200} ' so now let's clean up the reponse by manipulating the string Dim translatedText$ = "" ' En cas d'échec : ' "{"responseData": null, "responseDetails": "invalid language pair", "responseStatus": 400}" Dim sResult$ = sb.ToString() Const sGm$ = """" Const sTagEchec$ = "{" & sGm & "responseData" & sGm & ": null" If sResult.StartsWith(sTagEchec) Then 'Dim asChamps$() = sResult.Split(","c) sMsgErr = sResult bVerifierDispo = False Else If sb.Length >= 36 Then translatedText = sb.Remove(0, 36).ToString() Else translatedText = sResult End If Dim iPos% = translatedText.IndexOf("""},") If iPos > -1 Then translatedText = translatedText.Substring(0, iPos) ' Remplacer les apostrophes sTrad = translatedText.Replace("\u0026#39;", "'") sTrad = sTrad.Replace("\u0026quot;", sGm) ' Et les guillemets Return True End If Catch ex As Net.WebException sMsgErr = "Erreur : " & ex.Message bVerifierDispo = True Try Dim response As Net.HttpWebResponse = _ CType(ex.Response, Net.HttpWebResponse) If response.StatusCode = Net.HttpStatusCode.RequestUriTooLong Then sMsgErr = "Erreur : Le texte est trop long !" bVerifierDispo = False End If Catch End Try Catch ex As Exception sMsgErr = "Erreur : " & ex.Message bVerifierDispo = True 'sMsgErr = "Impossible d'obtenir la traduction, ressayer plus tard." 'sMsgErr = "Cannot get the translation. Please try again later." End Try End Function End Class
30 oct. 2012 à 14:43
Pourtant un autre quasi même code (plus complet) fonctionne : http://www.vbfrance.com/codes/TRADUCTEUR-GOOGLE-INTERFACE-WINFORM-SERVICE-TRADUCTION-GOOGLE_49799.aspx
Je n'ai pas chercher les différences de la raison du code retour...
Pour ceux que le sujet intéresse, il y a un service similaire via MS Bing et voici un lien sur un code pour l'utiliser : http://www.codeproject.com/Articles/308809/WPF-Language-Translator
Un avantage, après création d'un compte, MS Bing (http://www.microsofttranslator.com/dev/) autorise la traduction gratuite de 2 000 000 caractères par mois, à partir d'un programme externe (identifiant à fournir et récupéré à la création de son compte). Pour l'utilisation à partir de VB, il y a le code de "codeproject" indiqué ci-dessus et il y a MSDN : http://msdn.microsoft.com/en-us/library/dd576287.aspx
30 août 2011 à 23:50
16 janv. 2011 à 22:06
A+
20 mars 2010 à 10:39
Il faudrait savoir si le problème viens de mon code ou de TraduireViaApiAjax() qui est un code de GILLARDG. Testez le francais-russe en appelant directement TraduireViaApiAjax() pour voir si le problème viens de mon code ou de TraduireViaApiAjax()
20 mars 2010 à 07:27
Avez-vous remarqué que la traduction français-espagnol ou français-russe donne une traduction anglaise ?
Ou bien j'ai un problème personnel ?
Au plaisir de vous lire
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.