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
Creating an HTTP Object for Linux
#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
#19

mikekaganski

Here is my solution

'Sign in to:
'https://www.webdavsystem.com/
'You don't need to download anything, just select the 72 hours test service.
'You'll get your personal account, https://webdavserver.net/UserXXXXXXX
'where XXXXXXX is a serie of numbes/chars

'It is a demo sever for WebDAV Server Engine for .NET and WebDAV Ajax Library.

'A Test Folder will be created (https://webdavserver.net/UserXXXXXXX)
'You can use it for example to map a network drive
'Note that this folder and all files in it will be deleted within 72 hours.
'You can use the above url to test WebDAV server with various WebDAV clients.


REM  *****  BASIC  *****

Private oDlg As Object
Private oDropDown As Object
Private oChk As Object
Private oChk2 As Object
Private Continue As Boolean
Private fileNames() As String

Sub ShowDialog

    If Continue Then Exit Sub

    DialogLibraries.LoadLibrary("Standard")
    oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
    oDropDown = oDlg.getControl("ComboBox1")
    oChk = oDlg.getControl("CheckBox1")
    oChk2 = oDlg.getControl("CheckBox2")
    Dim oListenerTop As Object
    oListenerTop=createUnoListener("TopListen_", "com.sun.star.awt.XTopWindowListener")
    oDlg.addTopWindowlistener(oListenerTop)
	
    Continue = True
    CenterDialog
    WebDAV_MKCOL
    WebDAV_PROPFIND
	
    Do while Continue
        Wait 20
        oDlg.setVisible(true)
    Loop

    oDlg = Nothing

End Sub

Sub TopListen_WindowClosing
    Continue=false
    ThisComponent.setModified(False)
End Sub
Sub  TopListen_windowOpened
End Sub
Sub  TopListen_windowClosed
End Sub
Sub TopListen_windowMinimized
End Sub
Sub  TopListen_windowNormalized
End Sub
Sub  TopListen_windowActivated
End Sub
Sub  TopListen_windowDeactivated
End Sub
Sub  TopListen_disposing
End Sub

Sub CenterDialog

    Dim oSize As New com.sun.star.awt.Size, factor As Double
    Dim oCC, oComponentWindow, oTopWindowPosSize
    oCC = ThisComponent.getCurrentController()
    oComponentWindow = oCC.ComponentWindow
    oTopWindowPosSize = oComponentWindow.Toolkit.ActiveTopWindow.getPosSize()
    
    oSize.Width = oDlg.Model.Width
    oSize.Height = oDlg.Model.Height
    factor = oSize.Width / oDlg.convertSizeToPixel(oSize, com.sun.star.util.MeasureUnit.APPFONT).Width
    
    With oDlg.Model
        .PositionX = (factor * oTopWindowPosSize.Width - .Width) / 2
        .PositionY = (factor * oTopWindowPosSize.Height - .Height) / 1.7
    End With
    
End Sub

Sub OpenRemoteFile(fName)
	
    url = "https://webdavserver.net/UserXXXXXXX/newfolder/" & fName 'Change the UserXXXXXXX to correspond your account 
	
    Dim pos As Integer, tmp As String, ext As String
    pos = InStrReverse(url, ".")
    tmp = Left(url, pos - 1)
    ext = Replace(url, tmp, "")
    Select Case ext
        Case ".ods", ".odt", ".odf", ".ott", ".odp", ".otp", ".fodp", ".fodg", "rtf", ".csv", ".txt"
            pos = InStrReverse(url, "/") 
            tmp = Left(url, pos)
            fname = Replace(url, tmp, "")
            OpenRemoteFileDirect fname
            Exit Sub
        Case ".pdf"
            Dim oShellExec As Object
            oShellExec = CreateUnoService("com.sun.star.system.SystemShellExecute")
            oShellExec.execute(url, "", 0)
            oShellExec = Nothing
        Case Else
    End Select
	
End Sub

Sub OpenRemoteFileDirect(fname As String)

    Dim baseUrl As String
    baseUrl = "https://webdavserver.net/UserXXXXXXX/newfolder/" 'Change the UserXXXXXXX to correspond your account
    Dim fullUrl As String
    fullUrl = baseUrl & fname
    
    Dim oDoc As Object
    oDoc = StarDesktop.loadComponentFromURL(fullUrl, "_blank", 0, Array())
    
End Sub

Sub WebDAV_MKCOL()

    Dim sfa As Object
    sfa = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
    sfa.createFolder("https://webdavserver.net/UserXXXXXXX/newfolder/") 'Change the UserXXXXXXX to correspond your account
    
End Sub

Sub WebDAV_PROPFIND()
    
    Dim sUrl As String, i As Integer
    url = "https://webdavserver.net/UserXXXXXXX/newfolder/" 'Change the UserXXXXXXX to correspond your account
    
    Dim sfa As Object
    sfa = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
    Erase  fileNames
    
    If  sfa.Exists(url) Then
        Dim files()
        files = sfa.GetFolderContents(url, True)
        If UBound(files) < 0 Then
        	Print "No files in the specified folder"
        	Exit Sub
        End If
        Redim Preserve fileNames(UBound(files))
        For i = LBound(files) To UBound(files)
            fileNames(i) = files(i)
        Next i
        
        FillCombo
            
    End If
    
End Sub

Sub FillCombo

    If Ubound(fileNames) > - 1 Then
        If oDropDown.getItemCount() > 0 Then
            oDropDown.removeItems(0, oDropDown.getItemCount())
        End If
        Dim i As Integer, cnt As Integer, pos As Integer
        Dim fName As String, tmp As String, ext As string
	
        For i = Lbound(fileNames) To Ubound(fileNames)
            pos = InStrReverse(fileNames(i), "/")
            tmp = Left(fileNames(i), pos)
            If i = 0 Then oDlg.Title = tmp
            fName = Replace(fileNames(i), tmp, "")
            pos = InStrReverse(fName, ".") -1
            tmp = Left(fName, pos)
            ext = Replace(fName, tmp, "")
            Select Case ext
                Case ".ods", ".odt", ".odf", ".ott", ".odp", ".otp", ".fodp", ".fodg", "rtf", ".csv", ".txt", ".pdf"
                    oDropDown.addItem(fName, cnt)
                    cnt = cnt + 1
                Case Else
            End Select
        Next i
		
    End If
	
End Sub

Sub WebDAV_put

    Dim filepicker As Object, localFile As String, sFileArray As Variant
    filepicker = createUnoService("com.sun.star.ui.dialogs.FilePicker")
    filepicker.setDisplayDirectory(thisComponent.URL)
    filepicker.appendFilter("All files", "*.*")
    filepicker.setMultiSelectionMode(False)
	
    If filepicker.Execute() Then
        sFileArray = filepicker.getFiles()
        localFile = sFileArray(0)
    End If
	
    filepicker = Nothing
	
    If localFile = "" Then
        MsgBox "Operation aborted by user", "48", "Open" : Exit Sub
    End If
	
    Dim url As String, ucb As Object, provider As Object, id As Object, content As Object
    Dim pos As Integer, tmp As String, fName As String
	
    pos = InStrReverse(localFile, "/")
    tmp = Left(localFile, pos)
    fName = Replace(localFile, tmp, "")
		
    url  = "https://webdavserver.net/UserXXXXXXX/newfolder/" & fName 'Change the UserXXXXXXX to correspond your account
    ucb = CreateUnoService("com.sun.star.ucb.UniversalContentBroker")
    provider =  CreateUnoService("com.sun.star.ucb.WebDAVContentProvider")
    id = ucb.createContentIdentifier(url)
    content = provider.queryContent(id)
	
    Dim sfa As Object, inputStream As Object
    Dim args As Object, cmd As Object

    sfa = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
    inputStream = sfa.openFileRead(localFile)
    args = CreateUnoStruct("com.sun.star.ucb.InsertCommandArgument")
    args.Data = inputStream
    args.ReplaceExisting = True
    cmd = new com.sun.star.ucb.Command
    cmd.Name = "insert"
    cmd.Handle = -1
    cmd.Argument = args
    On Error Resume Next
    content.execute(cmd, 0, Nothing)
    If Err <> 0 Then Err.Clear
    inputStream.CloseInput()
    inputStream = Nothing
    sfa = Nothing
    content = Nothing
    id = Nothing
    provider = Nothing
    ubc = Nothing
	
End Sub

Sub WebDAV_get(fName As String)

    Dim url As String, ucb As Object, provider As Object, id As Object, content As Object
    url = "https://webdavserver.net/UserXXXXXXX/newfolder/" & fName 'Change the UserXXXXXXX to correspond your account
    Dim pos As Integer, tmp As String, ext As String
    pos = InStrReverse(fName, ".")
    tmp = Left(fName, pos)
    ext = Replace(fName, tmp, "")
    
    
    ucb = CreateUnoService("com.sun.star.ucb.UniversalContentBroker")
    provider = CreateUnoService("com.sun.star.ucb.WebDAVContentProvider")
    id = ucb.createContentIdentifier(url)
    content = provider.queryContent(id)

    Dim args As Object, cmd As Object, result As Object, pipe As Object
    pump = CreateUnoService("com.sun.star.io.Pump")

    args = CreateUnoStruct("com.sun.star.ucb.OpenCommandArgument2")
    args.Mode = 2 'file
    args.Priority = 0
    args.Sink = pump
    
    cmd = CreateUnoStruct("com.sun.star.ucb.Command")
    cmd.Name = "open"
    cmd.Handle = -1
    cmd.Argument = args
    content.execute(cmd, 0, Nothing)
    Dim responseStream As Object
    responseStream = pump.getInputStream()

    Dim filepicker As Object, saveFile As String
    filepicker = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
    filepicker.initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_SIMPLE))
    filepicker.setDisplayDirectory(thisComponent.URL)
    filepicker.appendFilter("All files", "*.*")
    filepicker.setMultiSelectionMode(False)
	
    If filepicker.Execute() Then
        sFileArray = filepicker.getFiles()
        localFile = sFileArray(0)
    End If
	
    filepicker = Nothing
	
    If localFile = "" Then
        MsgBox "Operation aborted by user", "48", "Open" : Exit Sub
    End If
	
    Dim bytes() As Byte
    responseStream.readBytes(bytes, responseStream.available)
    If InStr(localFile, ".") = 0 Then
        localFile = localFile & "." & ext
    End If 
	
    Dim sfa As Object, outStream As Object
    sfa = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
    outStream = sfa.openFileWrite(localFile)
    outStream.writeBytes(bytes)
    outStream.closeOutput()
    responseStream.closeInput()
    outStream = Nothing
    responseStream = Nothing
    sfa = Nothing
    cmd = Nothing
    args = nothing
    pump = nothing
    content = Nothing
    provider = Nothing
    id = Nothing
    ucb = Nothing

End Sub

Sub WebDAV_delete(fName As String)

    Dim url As String, ucb As Object, provider As Object, id As Object, content As Object
    url = "https://webdavserver.net/UserXXXXXXX/newfolder/" & fName 'Change the UserXXXXXXX to correspond your account
    
    ucb = CreateUnoService("com.sun.star.ucb.UniversalContentBroker")
    provider = CreateUnoService("com.sun.star.ucb.WebDAVContentProvider")
    id = ucb.createContentIdentifier(url)
    content = provider.queryContent(id)

    Dim args As Object, cmd As Object

    args = CreateUnoStruct("com.sun.star.ucb.OpenCommandArgument2")
    args.Mode = 2 'file
    args.Priority = 0
    
    cmd = CreateUnoStruct("com.sun.star.ucb.Command")
    cmd.Name = "delete"
    cmd.Handle = -1
    cmd.Argument = args
    content.execute(cmd, 0, Nothing)
    cmd  = Nothing
    args = Nothing
    content = Nothing
    provider = Nothing
    id = Nothing
    ucb = Nothing

End Sub

Sub ComboItemChange(oEvent) 'Bind to the comboBox1 ItemChange event

    Select Case oChk2.Model.State
        Case 1
            WebDav_delete oEvent.source.Model.Text
            WebDAV_PROPFIND
            FillCombo
            oEvent.source.Model.Text = ""
            Exit Sub
        Case Else
    End Select
	
    Select Case oChk.Model.State
        Case 0
            OpenRemoteFile oEvent.source.Model.Text
        Case 1
            WebDAV_get oEvent.source.Model.Text
        Case Else
    End Select

End Sub

Sub CmdAction 'Bind to the CommandButton1 ActionCommand event

    WebDAV_put
    WebDAV_PROPFIND
    FillCombo
    oDropDown.Model.Text = ""
	
End Sub

Sub Chk1Cahnged(oEvent) 'Bind to the CheckBox1 StateChange event
    If oEvent.Source.Model.State = 1 Then
        oChk2.Model.State = 0
    End If
End Sub

Sub Chk2Cahnged(oEvent) 'Bind to the CheckBox2 StateChange event
    If oEvent.Source.Model.State = 1 Then
        oChk.Model.State = 0
    End If
End Sub

Function InStrReverse(sText As String, search As String) As Long
	
    If sText = "" Or search = "" Or Len(search) > Len(sText) Then
    	InStrReverse = 0
    	Exit Function
    End If
	
    Dim i As Long

    For i = Len(sText) To 1 Step -1
        If Mid(sText, i, Len(search)) = search Then
            InStrReverse = i : Exit Function
        End If
    Next i
	
End Function
#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:

#18

I came back to this topic because I wasn’t happy with the curl/temp file solution.

Sub GetJsonString

    Dim sAccessKey As String
    Dim sUrl As String
    Dim response As String

    sAccessKey = "Your_Access_Key" 'get from api.marketstack.com
    sUrl = "http://api.marketstack.com/v1/eod?access_key=" & sAccessKey & "&symbols=AAPL"
	
    Select Case OSName
        Case "WIN"
            Dim req As Object 
            Set req = CreateObject("WinHttp.WinHttpRequest.5.1")          
            req.Open "GET", sUrl, False
            req.setRequestHeader "Accept", "application/json"
            req.Send
            response = req.responseTEXT
            Set req = Nothing
        Case "LINUX", "OS2","UNIX","MAC" 
            Dim oServiceManager As Object
            Dim oSimpleFileAccess As Object
            Dim oInputStream As Object
            Dim oTextInputStream As Object
            Dim oInText As Object
            oServiceManager = GetProcessServiceManager()
            oSimpleFileAccess = oServiceManager.createInstance("com.sun.star.ucb.SimpleFileAccess")
            oInText = createUNOService("com.sun.star.io.TextInputStream")
            oInputStream = oSimpleFileAccess.openFileRead(sURL)
            oInText.setInputStream(oInputStream)
            Do While Not oInText.isEOF()
            line = oInText.readLine()
                response = response & line
            Loop
            oInText.closeInput()
            oInText = Nothing
            oInputStream = Nothing
            oInText = Nothing
            oSimpleFileAccess = nothing
            oServiceManager = Nothing
        Case Else
    End Select
    
    MsgBox response
    response = ""
	
End Sub

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

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