SourceCode Membuat file Zip dengan VisualBasic6.0
Seperti yang kita ketahui bahwa terkadang kita harus membuat aplikasi dimana aplikasi tersebut harus mampu untuk membundel file atau membuat file zip pada data tertentu yang ingin dikirimkan maupun ingin dilindungi isinya.
Sebelum membahas pemrogramannya kita bahas dulu apa itu file zip. file zip yaitu sebuah standar kompresi data atau pemampatan data atau data compression yang paling populer di dunia komputer, Pencipta file zip adalah Phil Katz. Dengan compresi zip ukuran data akan lebih kecil karena di mampatkan atau dikompresi sehingga penggunaan media penyimpanan atau transfer data apa pun akan menjadi lebih efisien.
Nah Terkadang kita harus membuat code di program aplikasi untuk bisa membuat bundle zip atau membuat file zip jika di visualbasic6.0 sebenarnya itu mudah saja.
anda bisa menambahkan sebuah module berinama module tersebut "modShellZipUnzip.bas" kemudian isi dengan code berikut:
Option Explicit
Public Function ShellZip(ByRef Source As String, ByRef DestZip As String) As Boolean
CreateNewZip DestZip
On Error Resume Next
With CreateObject("Shell.Application") 'Late-bound
'With New Shell 'Referenced
If Right$(Source, 1&) = "\" Then
.NameSpace(CVar(DestZip)).CopyHere .NameSpace(CVar(Source)).Items
Else
.NameSpace(CVar(DestZip)).CopyHere CVar(Source)
End If
End With
ShellZip = (Err = 0&)
End Function
Public Function ShellUnzip(ByRef SrcZip As String, ByRef DestDir As String) As Boolean
On Error Resume Next
With CreateObject("Shell.Application") 'Late-bound
'With New Shell 'Referenced
.NameSpace(CVar(DestDir)).CopyHere .NameSpace(CVar(SrcZip)).Items
End With
ShellUnzip = (Err = 0&)
RemoveTempDir Right$(SrcZip, Len(SrcZip) - InStrRev(SrcZip, "\"))
End Function
'Creates a new empty Zip file only if it doesn't exist.
Private Function CreateNewZip(ByRef sFileName As String) As Boolean
With CreateObject("Scripting.FileSystemObject") 'Late-bound
'With New FileSystemObject 'Referenced
On Error GoTo 1
With .CreateTextFile(sFileName, Overwrite:=False)
.Write "PK" & Chr$(5&) & Chr$(6&) & String$(18&, vbNullChar)
.Close
1 End With
End With
CreateNewZip = (Err = 0&)
End Function
Private Function RemoveTempDir(ByRef sFolderName As String) As Boolean
Dim sPath As String, sTemp As String
On Error Resume Next
sTemp = Environ$("TEMP") & "\"
sPath = Dir(sTemp & "Temporary Directory * for " & sFolderName, vbDirectory Or vbHidden)
If LenB(sPath) Then
With CreateObject("WScript.Shell") 'Late-bound
'With New WshShell 'Referenced
Do: .RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\*RD_" & _
Replace(sPath, " ", "_"), Environ$("ComSpec") & " /C " & _
"@TITLE Removing " & sPath & " ...&" & _
"@RD /S /Q """ & sTemp & sPath & """"
sPath = Dir
Loop While LenB(sPath)
End With
End If
RemoveTempDir = (Err = 0&)
End Function
Public Function ShellZip(ByRef Source As String, ByRef DestZip As String) As Boolean
CreateNewZip DestZip
On Error Resume Next
With CreateObject("Shell.Application") 'Late-bound
'With New Shell 'Referenced
If Right$(Source, 1&) = "\" Then
.NameSpace(CVar(DestZip)).CopyHere .NameSpace(CVar(Source)).Items
Else
.NameSpace(CVar(DestZip)).CopyHere CVar(Source)
End If
End With
ShellZip = (Err = 0&)
End Function
Public Function ShellUnzip(ByRef SrcZip As String, ByRef DestDir As String) As Boolean
On Error Resume Next
With CreateObject("Shell.Application") 'Late-bound
'With New Shell 'Referenced
.NameSpace(CVar(DestDir)).CopyHere .NameSpace(CVar(SrcZip)).Items
End With
ShellUnzip = (Err = 0&)
RemoveTempDir Right$(SrcZip, Len(SrcZip) - InStrRev(SrcZip, "\"))
End Function
'Creates a new empty Zip file only if it doesn't exist.
Private Function CreateNewZip(ByRef sFileName As String) As Boolean
With CreateObject("Scripting.FileSystemObject") 'Late-bound
'With New FileSystemObject 'Referenced
On Error GoTo 1
With .CreateTextFile(sFileName, Overwrite:=False)
.Write "PK" & Chr$(5&) & Chr$(6&) & String$(18&, vbNullChar)
.Close
1 End With
End With
CreateNewZip = (Err = 0&)
End Function
Private Function RemoveTempDir(ByRef sFolderName As String) As Boolean
Dim sPath As String, sTemp As String
On Error Resume Next
sTemp = Environ$("TEMP") & "\"
sPath = Dir(sTemp & "Temporary Directory * for " & sFolderName, vbDirectory Or vbHidden)
If LenB(sPath) Then
With CreateObject("WScript.Shell") 'Late-bound
'With New WshShell 'Referenced
Do: .RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\*RD_" & _
Replace(sPath, " ", "_"), Environ$("ComSpec") & " /C " & _
"@TITLE Removing " & sPath & " ...&" & _
"@RD /S /Q """ & sTemp & sPath & """"
sPath = Dir
Loop While LenB(sPath)
End With
End If
RemoveTempDir = (Err = 0&)
End Function
Kemudian jika ingin menggunakan nya anda tinggal memanggil dengan perintah berikut:
ShellZip "somedirectory\file.ext", "someotherdirectory\file.ZIP"
Mudah bukan? Code diatas hanya contoh sederhana saja, sebenarnya banyak cara jika anda cari di internet mungkin ada yang menggunakan:
- Class Modules CGZipFiles and CGUnzipFiles - codeguru
- komponen X-ceed Zip
- using IStorage and IDropTarget
Dan mungkin masih banyak lagi yang codingnya rumit dan bikin pening kepala, yah saya hanya mencontohkan yang simpel aja agar mudah dipakai dan diterapkan.
Demikian sedikit tulisan mengenai SourceCode Membuat file Zip dengan VisualBasic6.0
Jika artikel ini bermanfaat silahkan di share !!!
Jika ada kritik dan saran silahkan tulis di kolom komentar !!
0 Response to "SourceCode Membuat file Zip dengan VisualBasic6.0"
Posting Komentar