Tulkošanas makrosi

Divi Word makrosi, kas varētu noderēt tiem, kam nav instalēta Tildes vārdnīca, bet ir pieejams internets.

Lai lietotu, makrosu projektiem referencēs jāpieliek Microsoft XML (es liku V 6.0, bet derēs jebkurš). Pēc tam atliek uzbindēt klaviatūras saīsni. Piemēram, es ieliku Shift+Ctrl+Alt+E tulkojumam uz angļu valodu un Shift+Ctrl+Alt+L tulkojumam uz latviešu valodu. Pēc tam, kad vajag tulkojumu, iezīmējam tulkojamo vārdu un izpildām klaviatūras maģiju.

Uzskatu, ka SIA “Tilde” tiesības ar šo neesmu pārkāpis, jo esmu tikai vienkāršojis piekļuvi datiem, kas ir publiski pieejami.

Rezultāts izskatās šādi:

'tulko iezīmēto tekstu uz angļu valodu
Sub TranslateToEn()
    Dim sRes As String
    sRes = Translate("L", GetSelection())
    If TrimEnd(sRes) <> "" Then MsgBox sRes
End Sub

'tulko iezīmēto tekstu uz angļu valodu
Sub TranslateToLV()
    Dim sRes As String
    sRes = Translate("E", GetSelection())
    If TrimEnd(sRes) <> "" Then MsgBox sRes
End Sub
'ielasa iezīmēto vārdu vai vārdu pirms kursora
Public Function GetSelection() As String
        Dim sTran As String
    If TrimEnd(Selection.Text) <> "" Then
        sTran = Trim(Selection.Text)
    Else
        Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
        sTran = Trim(Selection.Text)
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
    GetSelection = sTran
End Function

'izpilda tulkošanas darbu
Function Translate(ByVal spDirection As String, ByVal spText As String) As String
  Dim oXML As New XMLHTTP
  Dim sPost As String
  Dim sResponse As String

  If TrimEnd(spText) = "" Then Exit Function

  sPost = "MfcISAPICommand=Translate" & spDirection & _
         "&ApostrofeMode=0&DictionaryView=1&WholeWordsCheckBox=1&EditLine=" & _
         URLEncode(spText)

  'nolasa rezultātus no servera
  Call oXML.Open("POST", "http://dictionary.tilde.lv/idiction.dll?", False)
  Call oXML.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
  Call oXML.setRequestHeader("Encoding", "Windows-1257")
  oXML.send (sPost)

  sResponse = ToChars(oXML.responseBody)

  'vairāk nevajadzēs
  Set oXML = Nothing

  'iespējams, vārds nebūs vispār atrasts
  If InStr(1, sResponse, "images/not_found_text.gif") Then
    sResponse = spText & ": " & vbCrLf & "Vārds nav atrasts"
  End If


  Dim iNum As Integer
  iNum = InStr(1, sResponse, "<B>")
  If Not iNum > 0 Then
   iNum = 1
  End If
  sResponse = Mid(sResponse, iNum)
  Dim sRemoves() As String
  Dim i As Integer
  sRemoves = Split("<b>,</b>,<i>,</i>,<strong>,</strong>," & _
                   "<u>,</u>,<script>,</script>,<p>,</p>,<i>," & _
                   "</i>,<big>,</big>,<small>,</small>,</body>,</html>", _
                   ",", , vbTextCompare)

  sResponse = Replace(sResponse, spText & "</B><SMALL><P>", _
                      spText & vbCrLf, , , vbTextCompare)
  'izvācam visādus tagus
  For i = 0 To UBound(sRemoves, 1)
      sResponse = Replace(sResponse, sRemoves(i), "", , , vbTextCompare)
  Next i

  'atstarpes vajag
  sResponse = Replace(sResponse, "&nbsp;", " ")
  sResponse = Replace(sResponse, "<br>", vbCrLf)

  'atgriežamajai vērtībai novāc beigās enterus
  Translate = TrimEnd(sResponse)
End Function


Function URLEncode(EncodeStr As String) As String
    Dim i As Integer
    Dim erg As String

    erg = EncodeStr

    ' *** First replace '%' chr
    erg = Replace(erg, "%", Chr(1))

    ' *** then '+' chr
    erg = Replace(erg, "+", Chr(2))

    For i = 0 To 255
        Select Case i
            ' *** Allowed 'regular' characters
            Case 37, 43, 48 To 57, 65 To 90, 97 To 122

            Case 1  ' *** Replace original %
                erg = Replace(erg, Chr(i), "%25")

            Case 2  ' *** Replace original +
                erg = Replace(erg, Chr(i), "%2B")

            Case 32
                erg = Replace(erg, Chr(i), "+")

            Case 3 To 15
                erg = Replace(erg, Chr(i), "%0" & Hex(i))

            Case Else
                erg = Replace(erg, Chr(i), "%" & Hex(i))

        End Select
    Next

    URLEncode = erg

End Function

'no ResponseBody izveido normālu stringu
Function ToChars(ByVal opBody) As String
    Dim i As Integer
    Dim sChar As String
    Dim sReturn As String
    For i = 0 To Len(opBody) * 2 - 1
      sChar = (Chr(opBody(i)))
      sReturn = sReturn & sChar
    Next i
    ToChars = sReturn
End Function

'novāc lieko beigās - tabus, enterus
Function TrimEnd(ByVal spText As String) As String
  Dim i As Integer
  Dim sChar As String

  For i = Len(spText) To 1 Step -1
     sChar = Mid(spText, 1, 1)
      If sChar <> vbCr And sChar <> vbLf And _
         sChar <> " " And sChar <> vbTab Then
        TrimEnd = Left(spText, i)
        Exit Function
      End If
  Next i
End Function

Instrukcija tiem, kam šīs lietas nav diez ko pazīstamas:

• Iekopējam visu šeit redzamo kodu (to, kam kreisajā malā oranža svītra)
• Dodamies uz Wordu
• Spiežam uz klaviatūras Alt+F11
• Atrodam brīvu vietiņu, spiežam “Paste”
• Ejam uz menu: tools->references. Ieliekam ķeksīti pie “Microsoft XML, v. 6.0”
• Veram ciet šo papildus logu
• Izveicam augstāk minēto klaviatūras saīsnes veidošanu