elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: ¿Eres nuevo? ¿Tienes dudas acerca del funcionamiento de la comunidad? Lee las Reglas Generales


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [m][SRC] mTranslator [by *PsYkE1*]
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [m][SRC] mTranslator [by *PsYkE1*]  (Leído 1,940 veces)
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
[m][SRC] mTranslator [by *PsYkE1*]
« en: 29 Julio 2010, 00:53 am »

Código
  1. '-------------------------------------------------------
  2. ' *Module  : mTranslator
  3. ' *Author  : *PsYkE1*
  4. ' *Mail    : vbpsyke1@mixmail.com
  5. ' *Date    : 27/7/10
  6. ' *Purpose : Translate any text using Google Translator
  7. ' *Web     : http://foro.rthacker.net
  8. '-------------------------------------------------------
  9.  
  10. Option Explicit
  11.  
  12. Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
  13. Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
  14. Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
  15. Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
  16.  
  17. Public Const IF_NO_CACHE_WRITE = &H4000000
  18.  
  19. Public Function Get_Html_Code(sURL As String) As String
  20.    Dim sBuffer         As String * 1000
  21.    Dim lInternet       As Long
  22.    Dim lFile           As Long
  23.    Dim lRead           As Long
  24.  
  25.    lInternet = InternetOpen(0, 1, vbNullString, vbNullString, 0)
  26.    If lInternet <> 0 Then
  27.        lFile = InternetOpenUrl(lInternet, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
  28.        If lFile <> 0 Then
  29.            Do
  30.                Call InternetReadFile(lFile, sBuffer, 1000, lRead): DoEvents
  31.                Get_Html_Code = Get_Html_Code & Left$(sBuffer, lRead)
  32.            Loop While lRead <> 0
  33.        End If
  34.        Call InternetCloseHandle(lInternet)
  35.    End If
  36. End Function
  37.  
  38. Public Function Simplified_Language(ByVal sLenguage As String) As String
  39.  
  40.    sLenguage = LCase$(sLenguage)
  41.  
  42.    Select Case sLenguage
  43.        Case "albanian":        Simplified_Language = "sq"
  44.        Case "german":          Simplified_Language = "de"
  45.        Case "armenian":        Simplified_Language = "hy"
  46.        Case "bulgarsk":        Simplified_Language = "bg"
  47.        Case "greek":           Simplified_Language = "el"
  48.        Case "dutch":           Simplified_Language = "nl"
  49.        Case "polish":          Simplified_Language = "pl"
  50.        Case "portuguese":      Simplified_Language = "pt"
  51.        Case "spanish":         Simplified_Language = "es"
  52.        Case "swedish":         Simplified_Language = "sv"
  53.        Case "czech":           Simplified_Language = "cs"
  54.        Case "german":          Simplified_Language = "de"
  55.        Case Else
  56.            Simplified_Language = Left$(sLenguage, 2)
  57.        End Select
  58. End Function
  59.  
  60. Public Function Text_Between_Words(ByVal sTextToAnalyze As String, ByVal sStartWord As String, ByVal sEndWord As String) As String
  61.    Dim lPosition1             As Double
  62.    Dim lPosition2             As Double
  63.    Dim lStart                 As Double
  64.  
  65.    lPosition1 = InStr(sTextToAnalyze, sStartWord)
  66.    If lPosition1 <> 0 Then
  67.        lStart = lPosition1 + Len(sStartWord)
  68.        lPosition2 = InStr(lStart, sTextToAnalyze, sEndWord)
  69.    Else
  70.        Exit Function
  71.    End If
  72.    If lPosition2 <> 0 Then Text_Between_Words = Mid$(sTextToAnalyze, lStart, lPosition2 - lStart)
  73. End Function
  74.  
  75. Public Function Translate_Text(ByVal sTextToTranslate As String, ByVal sActualLenguage As String, ByVal sFutureLenguage As String) As String
  76.    Const sGoogleTransUrl As String = "http://translate.google.com/?js=y&prev=_t&hl=es&ie=UTF-8&layout=1&eotf=1&text="
  77.  
  78.    '# Delimiters
  79.    Const START_TRANSLATED_TEXT        As String = "onmouseout=""this.style.backgroundColor='#fff'"">"
  80.    Const END_TRANSLATED_TEXT          As String = "<br>"
  81.  
  82.    Dim sGoogleHtml As String
  83.  
  84.    If sActualLenguage <> sFutureLenguage Then
  85.        sTextToTranslate = Replace$(sTextToTranslate, Chr$(32), "%20")
  86.        sActualLenguage = Simplified_Language(sActualLenguage)
  87.        sFutureLenguage = Simplified_Language(sFutureLenguage)
  88.  
  89.        sGoogleHtml = Get_Html_Code(sGoogleTransUrl & sTextToTranslate & "%0D%0A%0D%0A&file=&sl=" & sActualLenguage & "&tl=" & sFutureLenguage & "#submit")
  90.  
  91.        Translate_Text = RTrim$(Text_Between_Words(sGoogleHtml, START_TRANSLATED_TEXT, END_TRANSLATED_TEXT))
  92.    Else
  93.        Translate_Text = sTextToTranslate
  94.    End If
  95. End Function

An example:
Código
  1. Debug.Print Translate_Text("Hoy estoy un poco cansado, pero creo que este proyecto sera grande.", "spanish", "english")

It returns:
Citar
Today I am a little tired, but I think this project will be great.

DoEvents¡! :P


« Última modificación: 6 Septiembre 2010, 03:06 am por *PsYkE1* » En línea

Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [m][SRC] mTranslator [by *PsYkE1*]
« Respuesta #1 en: 29 Julio 2010, 01:15 am »

Código:
http://www.leandroascierto.com.ar/categoria/M%C3%B3dulos/articulo/Google%20Traductor.php

Saludos ;)


En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [m][SRC] mTranslator [by *PsYkE1*]
« Respuesta #2 en: 29 Julio 2010, 01:23 am »

Código:
http://www.leandroascierto.com.ar/categoria/M%C3%B3dulos/articulo/Google%20Traductor.php

Saludos ;)
Wow  :o
Gracias tío!  ;)
No habia visto el ejemplo, voy ha hecharle un vistazo... :D

DoEvents¡! :P
En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines