Zip/unzip with vb6.0

Pertama saya menggunakan komponen X-ceed Zip.

========================Start=========================

Private scp As New Scripting.FileSystemObject
Private acc As New access.Application
Private XceedZip1 As New XceedZipLib.XceedZip

Public Function Extract(ByVal fileygdiextract As String, ByVal pass As String, ByVal msgErr As String, ByVal path As String, ByVal ada As Boolean) As Boolean
Dim filenew_, fileold_ As String
On Error GoTo errhandle
If ada = True Then
filenew_ = Trim(App.path & “\” & fileygdiextract)
fileold_ = Trim(App.path & “\old” & fileygdiextract)

scp.CopyFile filenew_, fileold_, True
scp.DeleteFile filenew_, True
End If

Dim ResultCode As xcdError
‘ All properties keep their default values except the four below
XceedZip1.FilesToProcess = fileygdiextract ‘The file to unzip
XceedZip1.PreservePaths = False ‘ In case file is stored in the
‘ zip file with a path, we need to make sure the path is
‘ removed so that the file will match with “readme.txt”
XceedZip1.UnzipToFolder = App.path
XceedZip1.ZipFilename = path
XceedZip1.EncryptionPassword = EncryptText(pass, “mrthx89”)

‘ Start unzipping
ResultCode = XceedZip1.Unzip
‘ Check the return value.

If ResultCode <> xerSuccess Then
scp.CopyFile fileold_, filenew_, True
scp.DeleteFile fileold_, True
Extract = False
MsgBox msgErr, vbExclamation
Exit Function
Else
‘ scp.CopyFile XceedZip1.FilesToProcess, fileold_, True
‘ scp.DeleteFile XceedZip1.FilesToProcess, True
If ada = True Then
scp.DeleteFile fileold_, True
End If
Extract = True
Exit Function
errhandle:
If Err <> 0 Then
MsgBox msgErr, vbExclamation
Err.Clear
Extract = False
Exit Function
End If
End If

End Function

Public Function Archive(ByVal file As String, ByVal pass As String, ByVal msgErr As String, ByVal path As String, ByVal access As Boolean, ByVal dbaccess As String) As Boolean
Dim ResultCode As xcdError
Dim conExp As New ADODB.Connection
Dim filenew_, fileold_ As String
filenew_ = Trim(App.path & “\” & file)
fileold_ = Trim(App.path & “\old” & file)
On Error GoTo errhandle

scp.CopyFile filenew_, fileold_, True
‘ scp.DeleteFile filenew_, True

If access = True Then
If conExp.State = adStateOpen Then
conExp.Close
End If
DoEvents
conExp.ConnectionString = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & Trim(App.path & file) & “;JET OLEDB:DATABASE PASSWORD=” & EncryptText(dbaccess, “mrthx89”) & “”
conExp.Open

conExp.Close
Set conExp = Nothing
End If

‘All properties keep their default values except the two below
‘zip.FilesToProcess = (“database.mdb”)
XceedZip1.FilesToProcess = App.path & “\” & file
XceedZip1.ZipFilename = path
‘Start zipping
XceedZip1.EncryptionPassword = EncryptText(pass, “mrthx89”)
XceedZip1.CompressionLevel = xclMedium
XceedZip1.PreservePaths = False
ResultCode = XceedZip1.zip
‘ Check the return value.
If ResultCode <> 0 Then
scp.CopyFile fileold_, filenew_, True
scp.DeleteFile fileold_, True
Archive = False
MsgBox msgErr, vbExclamation
Exit Function
Else
scp.DeleteFile fileold_, True
Archive = True
Exit Function
errhandle:
If Err <> 0 Then
MsgBox msgErr, vbExclamation
Err.Clear
Archive = False
Exit Function
End If
End If
End Function

============================End======================

Atau download disini dan XCeed Component.

By MRTHX.

  1. No trackbacks yet.

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: