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

SOS sos at pmg.be
Mon Oct 12 09:34:59 PDT 2015


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 at 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 at 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 at lists.freedesktop.org
>> http://lists.freedesktop.org/mailman/listinfo/libreoffice
>
> _______________________________________________
> LibreOffice mailing list
> LibreOffice at lists.freedesktop.org
> http://lists.freedesktop.org/mailman/listinfo/libreoffice



More information about the LibreOffice mailing list