Keskustelu: Koodit: WebDAV härpäke LibreOffice Basic ympäristössä

REM  *****  BASIC  *****
REM Valintaikkunaan (Dialog1):
REM 1 TreeControl ohjausobjekti (TreeControl1)
REM 2 CheckBox ohjausobjektia (CheckBox1 & CheckBox2)
REM 1 CommandButton ohjausobjekti (CommandButton1)

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

Sub ShowDialog

    If Continue Then Exit Sub

    DialogLibraries.LoadLibrary("Standard")
    oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
    oTreeControl = oDlg.getControl("TreeControl1")
    oTreeControl.Model.SelectionType = 1
    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
    PopulateTreeView

    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 'Korvaa UserXXXXXXX omalla

    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/" 'Korvaa UserXXXXXXX omalla
    Dim fullUrl As String
    fullUrl = baseUrl & fname

    Dim oDoc As Object
    oDoc = StarDesktop.loadComponentFromURL(fullUrl, "_blank", 0, Array())

End Sub

Sub WebDAV_MKCOL() 'Luo palvelimelle kansion newfolder jos sitä ei ole (ei luo uutta jos on).

    Dim sfa As Object
    sfa = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
    sfa.createFolder("https://webdavserver.net/UserXXXXXXX/newfolder/") 'Korvaa UserXXXXXXX omalla

End Sub

Sub WebDAV_PROPFIND()

    Dim sUrl As String, i As Integer
    url = "https://webdavserver.net/UserXXXXXXX/newfolder/" 'Korvaa UserXXXXXXX omalla

    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

        Erase fileNames
        Redim fileNames(UBound(files))
        For i = LBound(files) To UBound(files)
            fileNames(i) = files(i)
        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" : Aborted = True : 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 'Korvaa UserXXXXXXX omalla
    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 'Korvaa UserXXXXXXX omalla
    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, pump 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" : Goto Handler
    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

Handler:
    responseStream = Nothing
    sfa = Nothing
    cmd = Nothing
    args = nothing
    pump = nothing
    content = Nothing
    provider = Nothing
    id = Nothing
    ucb = Nothing

End Sub

Sub PopulateTreeView

    If Ubound(fileNames) < 0 Then
        MsgBox "No files in the specified folder", "48", "Files"
        Exit Sub
    End If

    Dim oMutableTreeDataModel As Object
    Dim oRootNode As Object
    Dim oChildNode1 As Object
    Dim oSubChildNode() As Object

    Dim i As Long, pos As Long, tmp As String

    pos = InStrReverse(fileNames(0), "/")
    rootName = Left(fileNames(0), pos)

    oMutableTreeDataModel = CreateUnoService("com.sun.star.awt.tree.MutableTreeDataModel")
    oRootNode = oMutableTreeDataModel.createNode(rootName , False)
    oMutableTreeDataModel.setRoot(oRootNode)
    oChildNode1 = oMutableTreeDataModel.createNode("Files", False)
    oRootNode.appendChild(oChildNode1)
    ReDim oSubChildNode(Ubound(fileNames))
    Dim nodeName As String

    For i = Lbound(fileNames) To Ubound(fileNames)
     	pos = InStrReverse(fileNames(i), "/")
     	nodeName = Replace(fileNames(i), Left(fileNames(i), pos) , "")
    	oSubChildNode(i) = oMutableTreeDataModel.createNode(nodeName, True)
        oChildNode1.appendChild(oSubChildNode(i))
    Next i

    oTreeControl.Model.DataModel = oMutableTreeDataModel
    oTreeControl.expandNode(oRootNode)
    oView = oTreeControl.getView()
    oView.setFocus()

End Sub

Sub RepopulateTreeView

    oTreeControl.Model.DataModel = Nothing
    WebDAV_PROPFIND
    PopulateTreeView

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 'Korvaa UserXXXXXXX omalla

    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 CmdAction

    oChk.Model.State = 0
    oChk2.Model.State = 0

    WebDAV_put
    If Not Aborted Then
        WebDAV_PROPFIND
        RepopulateTreeView
    End If
    Aborted = False

End Sub

Sub Chk1Cahnged(oEvent) 'Sido CheckBox1 -> Objektin tilaa muutettu tapahtumaan
    If oEvent.Source.Model.State = 1 Then
        oChk2.Model.State = 0
    End If
End Sub

Sub Chk2Cahnged(oEvent)  'Sido CheckBox2 -> Objektin tilaa muutettu tapahtumaan
    If oEvent.Source.Model.State = 1 Then
        oChk.Model.State = 0
    End If
End Sub

Sub GetSelection(oEvent)

    Dim sel As Variant
    On Error Resume Next
    sel = oEvent.Source.getSelection()

    If Err <> 0 Then
        MsgBox Err.Description
        Reset
    Else
        If Not IsNull(sel) Then
            If InStr(sel.getDisplayValue, "webdavserver.net") = 0 And InStr(sel.getDisplayValue, ".") > 0 Then
                Select Case oChk2.Model.State
                    Case 1
                        WebDav_delete sel.getDisplayValue()
                        WebDAV_PROPFIND
                        RepopulateTreeView
                        Exit Sub
                    Case Else
                End Select

                Select Case oChk.Model.State
                    Case 0
                        OpenRemoteFile sel.getDisplayValue()
                    Case 1
                        WebDAV_get sel.getDisplayValue()
                    Case Else
                End Select
            End If
        End If
    End If

End Sub

Sub TreeMouseUp(oEvent) 'Sido TreeControl1 -> Näppäin vapautettu tapahtumaan
    GetSelection oEvent
End Sub

Sub TreeKeyUp(oEvent) 'Sido TreeControl1 -> Hiiren painike vapautettu tapahtumaan
    GetSelection oEvent
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