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