Re: zip/unzip jar archive or add/remove file using a Basic macro?

Regina,
found some basic code  from Laurent Godard

'*************************************************************************************
' Zip Routines by Laurent Godard
'*************************************************************************************

Sub ZipFolderToFile(source as string, cible as string, sMimetype as string)
'Author: laurent Godard - listes.godard@laposte.net
    dim retour() as string

    'création de l'instance du fichier Zip
    LeFichierZip = createUnoService("com.sun.star.packages.Package")

    'Dim aArg As New com.sun.star.beans.NamedValue
    'aArg.Name = "PackageFormat"
    'aArg.Value = False
    'p.initialize(Array(cible, aArg))

    dim args(0)
    args(0)=ConvertToURL(cible)
    LeFichierZip.initialize(args())

    'création de la structure des repertoires dans le zip
    call Recursedirectory(source, retour)

    dim argsDir(0)

    argsDir(0)=true
    'on saute le premier --> repertoire contenant
    'Pourra etre une option a terme
    Repbase=retour(1)
    For i=2 To UBound(retour)
        chaine=mid(retour(i),len(repbase)+2)
decoupe=split(mid(retour(i),len(repbase)+1),getPathSeparator)
        repZip=decoupe(UBound(decoupe))
        azipper=LeFichierZip.createInstanceWithArguments(argsDir())
        If len(chaine)<>len(repZip) then
            RepPere=left(chaine,len(chaine)-len(repZip)-1)
            RepPere=RemplaceChaine(reppere, getpathseparator, "/", false)
        Else
            RepPere=""
        Endif
        RepPereZip=LeFichierZip.getByHierarchicalName(RepPere)
        RepPereZip.insertbyname(repzip, azipper)
    Next i
    'insertion des fichiers dans les bons repertoires

LeFichierZip.getByHierarchicalName("").setPropertyValue("MediaType", 
sMimetype)
    dim args2(0)
    args2(0)=false
    oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
    for i = 2 to UBound(retour)

        'just testing the mid function in LO 4.0
         'strg = mid("Hallo", 7)
        'if retour(i) = repbase then
        '    chaine = repbase
        'else
        '    chaine = mid(retour(i), len(repbase) + 2)
        'end if

        chaine = mid(retour(i), len(repbase) + 2)
        repzip = remplacechaine(chaine, getpathseparator, "/", false)
        fichier = dir(retour(i)+getPathSeparator,0)

        While fichier<>""
            azipper = LeFichierZip.createInstanceWithArguments(args2())
            oFile = oUcb.OpenFileRead(ConvertToURL(retour(i)+"/"+fichier))
            azipper.SetInputStream(ofile)
            RepPere = LeFichierZip.getByHierarchicalName(repZip)
            RepPere.insertbyname(fichier, azipper)
            fichier = dir()
        Wend
    next i
    'Valide les changements
    LeFichierZip.commitChanges()
    oFile.closeInput()
    'msgbox "C'est fini"
End Sub

'----------------------------------------------------------------------
Sub RecurseDirectory(chemin, reponse as variant)
'Author: laurent Godard - listes.godard@laposte.net
'reponse est un tableau contenant la liste de tous les sous répertoires 
de chemin
    redim preserve reponse(1 to 1)
    compte=1
    reponse(1)=chemin
    repbase=1
    rep=dir(convertTourl(chemin+"/"),16)
    while rep<>""
        if rep<>"." and rep<>".." then
        compte=compte+1
        redim preserve reponse(1 to compte)
        reponse(compte)=convertfromurl(reponse(RepBase)+"/"+rep)
        endif
        rep=dir()
        while rep="" and repbase<compte
            repbase=repbase+1
            rep=dir(convertToURL(reponse(repbase)+"/"),16)
        wend
    wend
End Sub

'----------------------------------------------------------------------
Function RemplaceChaine(ByVal chaine As String, src As String, dest As 
String,_
                        casse As Boolean)
'Auteurs: Laurent Godard & Bernard Marcelly
' fournit une chaine dont toutes les occurences de src ont été 
remplacées par dest
'casse = true pour distinguer majuscules/minuscules, = false sinon
    Dim lsrc As Integer, i As Integer, kas As Integer
    Dim limite as string

    limite=""
    kas = iif(casse, 0, 1)
    lsrc = len(src)
    i = instr(1, chaine, src, kas)
    while i<>0
        while i<0
            limite=limite+left(chaine,32000)
            chaine=mid(chaine,32001)
            i=instr(1, chaine, src, kas)
        wend
        ' ici i est toujours positif non nul
        if i>1 then
            limite = limite + Left(chaine, i-1) +dest
        else ' ici i vaut toujours 1
            limite = limite +dest
        endif
        ' raccourcir en deux temps car risque : i+src > 32767
        chaine = Mid(chaine, i)
        chaine = Mid(chaine, 1+lsrc)
        i = instr(1, chaine, src, kas)
    wend
    RemplaceChaine = limite + chaine
End Function


Sub unzipFileFromArchive(strZipArchivePath As String, strSourceFileName 
As String, strDestinationFilePath As String)

  Dim blnExists           As Boolean
  Dim args(0)             As Variant
  Dim objZipService       As Variant
  Dim objPackageStream    As Variant
  Dim objOutputStream     As Variant
  Dim objInputStream      As Variant
  Dim i                   As Integer

'================================================================================= 

  ' Unzip a single file from an archive.  You must know the exact name  
of the file
  ' inside the archive before this sub can dig it out.
  '
  ' strZipArchivePath = full path (directory and filename) to the .zip 
archive file.
  ' strSourceFileName = the name of the file being dug from the .zip 
archive.
  ' strDestinationFilePath = full path (directory and filename) where 
the source
  '                          file will be dumped.
'================================================================================= 


  ' Create a handle to the zip service,
  objZipService = createUnoService("com.sun.star.packages.Package")
  args(0) = ConvertToURL(strZipArchivePath)
  objZipService.initialize(args())

  ' Does the source file exist?
  If Not objZipService.HasByHierarchicalName(strSourceFileName) Then 
Exit Sub

  ' Get the file input stream from the archive package stream.
  objPackageStream = 
objZipService.GetByHierarchicalName(strSourceFileName)
  objInputStream = objPackageStream.GetInputStream()

  ' Define the output.
  objOutputStream = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  objOutputStream.WriteFile(ConvertToURL(strDestinationFilePath), 
objInputStream)
End Sub

On 12/10/2015 17:56, Regina Henschel wrote:
> Hi Stephan,
>
> thank you for your answer. I will try that service and report back in 
> some days.
>
> Kind regards
> Regina
>
> Stephan Bergmann schrieb:
> > On 10/11/2015 08:31 PM, Regina Henschel wrote:
> > > I want to write a Basic macro to preview an .xhp file while editing it.
> > > Viewing such file works fine with LoadComponentFromUrl with protocol
> > > "vnd.sun.star.help", if the file is inside a .jar container.
> > >
> > > But how can I modify or create or zip/unzip the content of such
> > > container using a Basic macro? A SimpleFileAccess sees it only as file,
> > > not as folder.
> >
> > There is a UCP for a vnd.sun.star.pkg URL scheme, to access content
> > within a (zip, jar) package.  See the documentation of the
> > css.ucb.PackageContentProvider UNO service for details.  (There is also
> > a css.uri.VndSunStarPkgUrlReferenceFactory UNO service that helps create
> > such vnd.sun.star.pkg URLs.)
> >
> > Underlying that is UNO services like css.packages.Package and
> > css.packages.zip.ZipFileAccess.
> > _______________________________________________
> > LibreOffice mailing list
> > LibreOffice@lists.freedesktop.org
> > http://lists.freedesktop.org/mailman/listinfo/libreoffice
>
> _______________________________________________
> LibreOffice mailing list
> LibreOffice@lists.freedesktop.org
> http://lists.freedesktop.org/mailman/listinfo/libreoffice