JDD < jdd@xykel.dk > skrev følgende:
> hej
>
> kan man zippe en mappe via noget kode i vb6 og i såfald hvordan. det skal
> køre på XP der kan an jo zippe uden et decideret zip program.
>
>
Hej JDD,
Nedennævnte kode, som virker hos mig, er sakset fra:
http://www.codecomments.com/showthread.php?
s=fac88e71f87bb60e68b495350d5eccaf&threadid=295877&perpage=10
&pagenumber=3
'-----------------------------------------------------------------------
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
MySource = "c:\WUTemp"
MyTarget = "c:\SinkFolder.zip"
MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0,
0, 0)
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next
Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")
'Create the basis of a zip file.
Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing
Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
Set oFolder = oApp.NameSpace(MySource)
If Not oFolder Is Nothing Then
oApp.NameSpace(MyTarget).CopyHere oFolder.Items
End If
'Wait for compressing to begin, this was necessary on my machine
wScript.Sleep(5000)
'wait for lock to release
Set oFile = Nothing
On Error Resume Next
Do While (oFile Is Nothing)
'Attempt to open the file, this causes an Err 70, Permission Denied when
the
file is already open
Set oFile = oFileSys.OpenTextFile(MyTarget, ForAppending, False)
If Err.number <> 0 then
Err.Clear
wScript.Sleep 3000
End If
Loop
Set oFile=Nothing
Set oFileSys=Nothing
'-------------------------------------------------------------
--
Med venlig hilsen
Per