Re: [libreoffice-users] gettextfields

On 9/05/2013 9:13, Vieri wrote:
> --- On Thu, 5/9/13, mcmurchy1917-libreoffice@yahoo.co.uk <mcmurchy1917-libreoffice@yahoo.co.uk> 
> wrote:
>
> > Hi Vieri
> >
> > The form you've created contains a set of controls of which
> > one or more of
> > them are of the "Text box" variety.
> >
> >
> > You may also have other controls on the form such as a
> > "Check Box", "Label" or
> > "Push Button" these latter controls don't have the ability
> > to hold text or
> > edit text so don't have the .Text property. So for these
> > controls the code
> > x.Text will fail.
> >
> >
> > Try this
> >
> > Sub EnumerateFields
> >
> >      oDoc = ThisComponent
> >      oDrawPage = oDoc.DrawPage
> >      oForm = oDrawPage.Forms.GetByIndex(0)
> >        For i = 0 To oForm.getCount()-1
> >           x =
> > oForm.getByIndex(i)
> >           if
> > x.supportsService("com.sun.star.form.component.TextField")
> > then
> >       
> >            
> > Print x.getName() & " : " & x.Text
> >       
> >         End If
> >        Next
> >    
> > End Sub
> Thanks Iain.
> Your help is much appreciated. The macro works.
> Now I'm trying to send HTTPS POST requests to my web server (not succeeding but that's another 
> story).
i use a "create a Windows" object to do the posting 
"WinHttp.WinHttpRequest.5.1"

hope it helps
greetz
Fernand


Function MicrosoftTranslate(sLanguageFrom As String, sLanguageTo As 
String, sText As String) As String

  '  On Error Goto err_catch0

    Dim ID As String
    Dim sURL As String
    Dim oH As object
    Dim sToken As String

    ID = ""
    sURL = 
"http://api.microsofttranslator.com/V2/Ajax.svc/Translate?oncomplete=&appId="; 
& ID & "&from=" & sLanguageFrom & "&to=" & sLanguageTo & "&text=" & 
JSencodeURLpart(sText)
    sToken = GetAccessToken()
    oH = CreateObject("WinHttp.WinHttpRequest.5.1")
    oH.Open "POST", sURL, False
    oH.setRequestHeader "Authorization", "Bearer " & sToken
    oH.send
    t = oH.ResponseText

    MicrosoftTranslate = mid(t,3,len(t)-3)

    Set oH = Nothing

exit_sub:
    Exit Function

err_catch0:
  msgbox("err_catch0 " & Err & Error & Erl,48)

    Resume exit_sub
End Function

Function GetAccessToken() As String

    On Error Goto err_catch2


    Dim mtToken As String
    webRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    Dim URI As String
    Dim txtToken As String

    URI = "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13";

    'Client ID from https://datamarket.azure.com/developer/applications
    Dim clientId As String
    clientId = "myclientid"

    'Client secret from https://datamarket.azure.com/developer/applications
    Dim clientSecret As String
    clientSecret = "JTEGDEb1OViegnPz0kzkvRWhOSeNRJpmPgjqauyeV8k="

    Dim sRequest As String
    sRequest = "grant_type=client_credentials" & _
    "&client_id=" & JSencodeURLpart(clientId, false) & _
    "&client_secret=" & JSencodeURLpart(clientSecret, False) & _
    "&scope=http://api.microsofttranslator.com";

    webRequest.Open("POST",URI, False)
    webRequest.setRequestHeader "Content-Type", 
"application/x-www-form-urlencoded"
    webRequest.send (srequest)
    mttoken = WebRequest.ResponseText


   Dim arr As Variant, header As String

    header = """access_token"":""" '"&HMACSHA256="
    footer = """,""expires_in"":"""
  headerpos = instr(mttoken, header)+len(header)
  footerpos = instr(mttoken, footer)
  tokenl = footerpos-headerpos
    txtToken = mid(mttoken ,headerpos , tokenl)
'    xray txttoken
'    If txtToken = "_request" Then Resume err_catch:

    GetAccessToken = txtToken


exit_sub:
     Exit Function

err_catch2:
beep
    msgbox("err_catch2 " & Err & Error & Erl, 48)
    Resume exit_sub
End Function


Function URLEncode(StringToEncode As String, 
UsePlusRatherThanHexForSpace As Boolean ) As String

    On Error Goto err_catch3

    Dim TempAns As String
    Dim CurChr As Integer

    CurChr = 1
    Do Until CurChr - 1 = Len(StringToEncode)
         Select Case Asc(Mid(StringToEncode, CurChr, 1))
        Case 48 To 57, 65 To 90, 97 To 122
            TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
        Case 32
            If UsePlusRatherThanHexForSpace = True Then
                TempAns = TempAns & "+"
            Else
                TempAns = TempAns & "%" & Hex(32)
            End If
        Case Else
            TempAns = TempAns & "%" & _
            Right("0" & Hex(Asc(Mid(StringToEncode, _
            CurChr, 1))), 2)
        End Select

        CurChr = CurChr + 1
    Loop
    URLEncode = TempAns

exit_sub:
    Exit Function

err_catch3:
beep
   msgbox("err_catch3 " & Err & Error & Erl ,48)
    Resume exit_sub

End Function

> Thanks again!
>
> Vieri


--
To unsubscribe e-mail to: users+unsubscribe@global.libreoffice.org
Problems? http://www.libreoffice.org/get-help/mailing-lists/how-to-unsubscribe/
Posting guidelines + more: http://wiki.documentfoundation.org/Netiquette
List archive: http://listarchives.libreoffice.org/global/users/
All messages sent to this list will be publicly archived and cannot be deleted