HTTP request headers

English
,
#1

Hi there where ever you are :slightly_smiling_face:

This works in the case that the server does not
require the HEADER parts of the requests to be set:

Sub GetStocks

    Dim URL As String
    Dim response As String
    Dim pos As Long
    Dim oServiceManager As Object
    Dim oSimpleFileAccess As Object
    Dim oInputStream As Object
    Dim oTextInputStream As Object

    URL = "https://example.com/stocks/" '(does not match the domain name used)
    oServiceManager = GetProcessServiceManager()
    oSimpleFileAccess = oServiceManager.createInstance("com.sun.star.ucb.SimpleFileAccess")
    oInText = createUNOService("com.sun.star.io.TextInputStream")
    oInputStream = oSimpleFileAccess.openFileRead(URL)
    oInText.setInputStream(oInputStream)
   	
    Do While Not oInText.isEOF()
        line = oInText.readLine()
        response = response & line & Chr(10)
    Loop
    ...
    ...	

End Sub

I can’t get this working:

Sub GetStocksWithHeaders()

    Dim URL As String
    Dim response As String
    Dim oServiceManager As Object
    Dim oWebDAV As Object
    Dim oInputStream As Object
    Dim oTextInputStream As Object

    URL = "https://example.com/stocks/"
    oServiceManager = GetProcessServiceManager()
    oWebDAV = oServiceManager.createInstance("com.sun.star.ucb.WebDAVDocumentContent")

    REM The code fails here:
    oWebDAV.setPropertyValue("URL", URL)
    REM Returns:
    REM BASIC execution error.
    REM '91'
    REM Object variable not defined.

    'This makes no difference:
    'oWebDAV.setPropertyValue("GET", URL, False)

    oWebDAV.setPropertyValue("ContentType", "text/json")
    oWebDAV.setPropertyValue("UserAgent", "LibreOffice")

    oInputStream = oWebDAV.openInputStream()
    oTextInputStream = createUNOService("com.sun.star.io.TextInputStream")
    oTextInputStream.setInputStream(oInputStream)

    response = ""
    Do While Not oTextInputStream.isEOF()
        response = response & oTextInputStream.readLine()
    Loop

    oTextInputStream.closeInput()
    oInputStream.closeInput()

    ...
    ...

End Sub
#2

You do not create the content like that. You request it from the content broker, like this:

  b = CreateUnoService("com.sun.star.ucb.UniversalContentBroker")
  id = b.createContentIdentifier("https://www.libreoffice.org")
  c = b.queryContent(id)

See the documentation.

#3

Are you serious?

#4

Sorry, I have no idea what you expect to that. If you have some specific question, please ask clearly. Note that I posted a comment, not an answer, so it wasn’t intended as w complete answer, only as some pointer in the direction that you may need to investigate.

#5

Well, I’m working on Windows so best to keep things simple and use the CreateObject(“Msxml2.ServerXMLHTTP.6.0”) method :upside_down_face:

#6

Another option (cross-platform) is to use curl (see also here).

#7

Hi there

Thanks for your suggestion.
I’ll find out what options curl offers :slightly_smiling_face:

#16

I didn’t know what exactly I was expecting, but not quite this:

Sub TestSub

    Dim sURL As String
    Dim oUBC As Object
    Dim oWebDAV As Object
	Dim id As Object
    Dim oContent As Object
    Dim response As String
	
    sURL = "https://example.com/"
    oUBC = GetProcessServiceManager().createInstance("com.sun.star.ucb.UniversalContentBroker")
    id = oUBC.createContentIdentifier(sURL)
    oContent = oUBC.queryContent(id)

    MsgBox "UniversalContentBroker object is Null = "  & IsNull(oUBC)
    MsgBox "WebDAVDocumentContent object is Null = " & IsNull(GetProcessServiceManager().createInstance("com.sun.star.ucb.WebDAVDocumentContent"))
    MsgBox "WebDAVContentProvider object is Null = " & IsNull(GetProcessServiceManager().createInstance("com.sun.star.ucb.WebDAVContentProvider"))

    ' ...
    
End Sub
#8

I almost gave up with this tuning, but then I got an idea…

REM  *****  BASIC  *****
Option Explicit

Sub Main

End Sub

Sub GetStocksWithCurl()

    Dim sCommand As String
    Dim sOutput As String
    Dim fullPath As String
    Dim fullPathUrl As String
    fullPath = "C:\Users\MySelf\Documents\curlTemp\temp.txt" '(for example)
    sCommand = "curl https://example.com/ -s -o " + fullPath + " ""Accept: application/json"""
    fullPathUrl = ConvertToURL(fullPath)
    
    If FileExists(fullPathUrl) Then
        Kill fullPathUrl
        Wait 500 
    End If
	
    Shell(sCommand, 2)
    Wait 500 'you may need to increase this value 
    sOutput = ReadFile(fullPathUrl)
    MsgBox sOutput
    
End Sub

Function ReadFile(sFileUrl As String) As String
	
    Dim oServiceManager As Object
    Dim oSimpleFileAccess As Object
    Dim oInputStream As Object
    Dim oTextInputStream As Object
    Dim oInText As Object
    Dim line As String
    Dim sOutput As String
	
    oServiceManager = GetProcessServiceManager()
    oSimpleFileAccess = oServiceManager.createInstance("com.sun.star.ucb.SimpleFileAccess")
    oInText = createUNOService("com.sun.star.io.TextInputStream")
    
Back:
    On Error Goto ErrorHandler
	
    oInputStream = oSimpleFileAccess.openFileRead(sFileUrl)
    oInText.setInputStream(oInputStream)
    
    sOutput = ""
  	
    Do While Not oInText.isEOF()
        line = oInText.readLine()
        sOutput = sOutput & line & chr(10)
    Loop

    ReadFile = sOutput
    Exit Function
    
ErrorHandler:
    Reset
    Wait 500
    Goto Back

End Function
#9

In case anyone would happen to be interested in what I tuned up

#10

I updated the error handling in the ReadFile function so that the macro would not end up to an endless loop in any case:

Function ReadFile(sFileUrl As String) As String
	
    Dim oServiceManager As Object
    Dim oSimpleFileAccess As Object
    Dim oInputStream As Object
    Dim oTextInputStream As Object
    Dim oInText As Object
    Dim line As String
    Dim sOutput As String
    Dim retryCount As Integer
    Dim maxRetries As Integer
	
    oServiceManager = GetProcessServiceManager()
    oSimpleFileAccess = oServiceManager.createInstance("com.sun.star.ucb.SimpleFileAccess")
    oInText = createUNOService("com.sun.star.io.TextInputStream")
    retryCount = 0
    maxRetries = 10 'feel free and change the value to match your needs 
    
Back:

    retryCount = retryCount + 1
    On Error Goto ErrorHandler
	
    oInputStream = oSimpleFileAccess.openFileRead(sFileUrl)
    oInText.setInputStream(oInputStream)
    
    sOutput = ""
  	
    Do While Not oInText.isEOF()
        line = oInText.readLine()
        sOutput = sOutput & line & chr(10)
    Loop

    ReadFile = sOutput
    Exit Function
    
ErrorHandler:

    Reset

    If retryCount <= maxRetries Then
        Wait 500
        Goto Back
    Else
        ReadFile = "Error: Unable to read file after " & maxRetries & " attempts."
    End If

End Function
#11

ScriptForge.TextStream service#ReadAll

ReadAll

Returns all the remaining lines in the text stream as a single string. Line breaks are not removed.

1 Like
#12

Hi there

Thanks for your reply and tip.

#17

Seems to work with rollapp as well

#13

I updated my tuning a bit based on the idea I got from a tip given by member fpy.
The macro looks like this now:

Sub GetHttpStuffWithCurl()

    GlobalScope.BasicLibraries.LoadLibrary("ScriptForge")
    Set FSO = CreateScriptService("FileSystem")
    Dim fullPath As String
    Dim folderPath As String
    Dim fullPathUrl As String
    Dim sCommand As String
    
    Select Case OSName
        Case "WIN"
            folderPath = ConvertToURL(Environ("UserProfile") & "\Documents\curlTemp")
            fullPath = (Environ("UserProfile") & "\Documents\curlTemp\temp.txt")            
        Case "LINUX", "OS2","UNIX","MAC"
            folderPath = ConvertToURL("/home/user/Documents/curlTemp")
            fullPath = folderPath & "/temp.txt"
        Case Else
    End Select
    
    fullPathUrl = ConvertToURL(fullPath)
    
    If Not FSO.FolderExists(folderPath) Then
        FSO.CreateFolder(folderPath)
    End If
    
    Set FSO = Nothing
    
    sCommand = "curl https://example.com/stocks/ -s -o " & fullPath & " ""Accept: application/json"""
    Shell sCommand, 2
    MsgBox GetResponse(fullPathUrl)
    
End Sub

Function GetResponse(sFileNameUrl As String) As String

    Dim FSO As Object
    Dim retryCount As Integer
    Dim maxRetries As Integer
    
    GlobalScope.BasicLibraries.LoadLibrary("ScriptForge")
    Set FSO = CreateScriptService("FileSystem")
    
    retryCount = 0
    maxRetries = 5
    
    Do While retryCount < maxRetries
        retryCount = retryCount + 1       
        If FSO.FileExists(sFileNameUrl) Then
            Dim inputFile As Object        
            Set inputFile = FSO.OpenTextFile(sFileNameUrl)
            GetResponse = inputFile.ReadAll()
            inputFile.CloseFile()
            Kill sFileNameUrl
            Set FSO = Nothing
            Exit Function
        Else
            Wait 500
        End If
    Loop
    
    Set FSO = Nothing
    GetResponse = "Error: Unable to read response after " & maxRetries & " attempts."

End Function

Function OSName As String

    With GlobalScope.Basiclibraries
        If Not .IsLibraryLoaded("Tools") Then .LoadLibrary("Tools")
    End With

    Dim keyNode As Object
    keyNode = Tools.Misc.GetRegistryKeyContent("org.openoffice.Office.Common/Help")
    OSName = keyNode.GetByName("System")

End Function

I would greatly appreciate it if someone could take his/her time to test the macro on a non-Windows platform and find out if the code really is cross-platform stuff, I have no chance to do it myself, because I only have this old laptop which spins on Windows platform. It would be really nice if somebody could do that and then give feedback with suggested corrections.

#14

you can also save the pain of While retryCount

Shell Function

bSync

If this value is set to true, the Shell command and all LibreOffice tasks wait until the shell process completes. If the value is set to false, the shell returns directly. The default value is false.

1 Like
#15

Thanks again :slightly_smiling_face:

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.