-
Jul 28th, 2010, 06:37 PM
#1
Thread Starter
Addicted Member
[m][SRC] mTranslator [by *PsYkE1*]
Code:
'-------------------------------------------------------
' *Module : mTranslator
' *Author : *PsYkE1*
' *Mail : vbpsyke1@mixmail.com
' *Date : 27/7/10
' *Purpose : Translate any text using Google Translator
' *Web : http://foro.rthacker.net
'-------------------------------------------------------
Option Explicit
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
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
Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Public Const IF_NO_CACHE_WRITE = &H4000000
Public Function Get_Html_Code(sURL As String) As String
Dim sBuffer As String * 1000
Dim lInternet As Long
Dim lFile As Long
Dim lRead As Long
lInternet = InternetOpen(0, 1, vbNullString, vbNullString, 0)
If lInternet <> 0 Then
lFile = InternetOpenUrl(lInternet, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
If lFile <> 0 Then
Do
Call InternetReadFile(lFile, sBuffer, 1000, lRead): DoEvents
Get_Html_Code = Get_Html_Code & Left$(sBuffer, lRead)
Loop While lRead <> 0
End If
Call InternetCloseHandle(lInternet)
End If
End Function
Public Function Simplified_Language(ByVal sLenguage As String) As String
sLenguage = LCase$(sLenguage)
Select Case sLenguage
Case "albanian": Simplified_Language = "sq"
Case "german": Simplified_Language = "de"
Case "armenian": Simplified_Language = "hy"
Case "bulgarsk": Simplified_Language = "bg"
Case "greek": Simplified_Language = "el"
Case "dutch": Simplified_Language = "nl"
Case "polish": Simplified_Language = "pl"
Case "portuguese": Simplified_Language = "pt"
Case "spanish": Simplified_Language = "es"
Case "swedish": Simplified_Language = "sv"
Case "czech": Simplified_Language = "cs"
Case "german": Simplified_Language = "de"
Case Else
Simplified_Language = Left$(sLenguage, 2)
End Select
End Function
Public Function Text_Between_Words(ByVal sTextToAnalyze As String, ByVal sStartWord As String, ByVal sEndWord As String) As String
Dim lPosition1 As Double
Dim lPosition2 As Double
Dim lStart As Double
lPosition1 = InStr(sTextToAnalyze, sStartWord)
If lPosition1 <> 0 Then
lStart = lPosition1 + Len(sStartWord)
lPosition2 = InStr(lStart, sTextToAnalyze, sEndWord)
Else
Exit Function
End If
If lPosition2 <> 0 Then Text_Between_Words = Mid$(sTextToAnalyze, lStart, lPosition2 - lStart)
End Function
Public Function Translate_Text(ByVal sTextToTranslate As String, ByVal sActualLenguage As String, ByVal sFutureLenguage As String) As String
Const sGoogleTransUrl As String = "http://translate.google.com/?js=y&prev=_t&hl=es&ie=UTF-8&layout=1&eotf=1&text="
'# Delimiters
Const START_TRANSLATED_TEXT As String = "gtrans value="""
Const END_TRANSLATED_TEXT As String = " <br>"
Dim sGoogleHtml As String
If sActualLenguage <> sFutureLenguage Then
sTextToTranslate = Replace$(sTextToTranslate, Chr$(32), "%20")
sActualLenguage = Simplified_Language(sActualLenguage)
sFutureLenguage = Simplified_Language(sFutureLenguage)
sGoogleHtml = Get_Html_Code(sGoogleTransUrl & sTextToTranslate & "%0D%0A%0D%0A&file=&sl=" & sActualLenguage & "&tl=" & sFutureLenguage & "#submit")
Translate_Text = Text_Between_Words(sGoogleHtml, START_TRANSLATED_TEXT, END_TRANSLATED_TEXT)
Else
Translate_Text = sTextToTranslate
End If
End Function
An example:
[code=vb]Debug.Print Translate_Text("Hoy estoy un poco cansado, pero creo que este proyecto sera grande.", "spanish", "english")[/code]
It returns:
Today I am a little tired, but I think this project will be great.
See you¡! :P
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|