Làm file CAB với thư viện COM MakeCab 1.0 Type Library

Các thủ thuật về hệ thống, thư mục, tập tin và mạng
Post Reply
User avatar
truongphu
VIP
VIP
Posts: 4779
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 525 times

Làm file CAB với thư viện COM MakeCab 1.0 Type Library

Post by truongphu »

(Thư viện COM MakeCab 1.0 Type Library với file C:\Windows\System32\catsrvut.dll\6)

Sau đây là code nén một file. Không hổ trợ Unicode

Cần CommonDialog1 để duyệt file

Code: Select all

Private Sub Command1_Click()CommonDialog1.ShowOpenIf CommonDialog1.FileName <> "" Then    Dim Xcab As New COMMKCABLib.MakeCab    Dim Fname As String    Fname = CommonDialog1.FileName    Fname = Left(Fname, Len(Fname) - 3) & "cab"     Xcab.CreateCab Fname, False, 0, False    Xcab.AddFile CommonDialog1.FileName, CommonDialog1.FileName    Xcab.CloseCabEnd IfEnd Sub
Attachments
Make CAB.rar
(1.27 KiB) Downloaded 533 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
User avatar
truongphu
VIP
VIP
Posts: 4779
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 525 times

Re: Làm file CAB với thư viện COM MakeCab 1.0 Type Library

Post by truongphu »

Sau đây là code nén một folder có nhiều file
Chưa làm được: nén folder có các foler con trong đó

Code: Select all

    Dim Xcab As New COMMKCABLib.MakeCab    Private Sub Command1_Click() ' Nén 1 FileSet objDialog = CreateObject("UserAccounts.CommonDialog")    objDialog.InitialDir = "D:\"    objDialog.ShowOpen        If objDialog.FileName <> "" Then                Xcab.CreateCab Left(objDialog.FileName, Len(objDialog.FileName) - 3) & "cab", False, 0, False                Xcab.AddFile objDialog.FileName, objDialog.FileName                Xcab.CloseCab                    MsgBox "Ðã Xong"        End IfEnd Sub Private Sub Command2_Click() ' Nén 1 Folder không có folder conOn Error GoTo 500Set PathFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Select a folder:", 0)        Xcab.CreateCab PathFolder.Self.Path & ".cab", False, 0, False            Set MyFiles = CreateObject("Scripting.FileSystemObject").GetFolder(PathFolder.Self.Path).Files                    For Each mFile In MyFiles                        Dim mFilePath$                        mFilePath = PathFolder.Self.Path & "\" & mFile.Name                        Xcab.AddFile mFilePath, mFilePath                    Next        Xcab.CloseCab            MsgBox "Ðã Xong"Exit Sub500: MsgBox "Lô~i xây ra"End Sub
Attachments
Make CAB folder.rar
(1.61 KiB) Downloaded 343 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
User avatar
truongphu
VIP
VIP
Posts: 4779
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 525 times

Re: Làm file CAB với thư viện COM MakeCab 1.0 Type Library

Post by truongphu »

Phiên bản cuối:
* Nén 1 file
* Nén Folder, kể cả Folder con, cháu
* Tạo đường dẫn tương đối như Zip hay Rar
* Không hổ trợ tên file hay folder Unicode, tuy nhiên nội dung file không đổi
Đã test trên winXP

Code: Select all

Dim Xcab As New COMMKCABLib.MakeCab    Dim SpecialPath$    'truongphuPrivate Sub Command1_Click()Set objDialog = CreateObject("UserAccounts.CommonDialog")    objDialog.InitialDir = "D:\"    objDialog.ShowOpen        If objDialog.FileName <> "" Then        Dim Fname$: Fname = Mid(objDialog.FileName, InStrRev(objDialog.FileName, "\") + 1)                Xcab.CreateCab Left(objDialog.FileName, Len(objDialog.FileName) - 3) & "cab", False, 0, False                Xcab.AddFile Fname, Fname                Xcab.CloseCab                    MsgBox "Ðã Xong"        End IfEnd Sub Private Sub Command2_Click()'On Error Resume NextSet PathFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Select a folder:", 0)Dim FolderAll As Folder, Spath$, mFilePath$        Xcab.CreateCab PathFolder.Self.Path & ".cab", False, 0, False            Set FolderAll = CreateObject("Scripting.FileSystemObject").GetFolder(PathFolder.Self.Path)            Spath = Mid(PathFolder.Self.Path, InStrRev(PathFolder.Self.Path, "\") + 1)            SpecialPath = Replace(PathFolder.Self.Path, Spath, "")            Set MyFiles = FolderAll.Files                    For Each mFile In MyFiles                        Xcab.AddFile mFile.Path, Spath & "\" & mFile.Name                    Next                    MoveToSub FolderAll        Xcab.CloseCab            MsgBox "Ðã Xong" End Sub Private Sub MoveToSub(AFolder As Folder)    Set MoreFolders = AFolder.SubFolders    Dim TmpFolder As Folder, SSpath$, mFilePath$      'On Error Resume Next        For Each TmpFolder In MoreFolders            SSpath = Replace(TmpFolder, SpecialPath, "")            Set MoreFiles = TmpFolder.Files                For Each TmpFile In MoreFiles                    Xcab.AddFile TmpFile.Path, SSpath & "\" & TmpFile.Name                Next            MoveToSub TmpFolder        NextEnd Sub 
Attachments
Make CAB TôT.rar
(1.79 KiB) Downloaded 359 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
HTV
Thành viên năng nổ
Thành viên năng nổ
Posts: 87
Joined: Fri 04/04/2008 3:32 pm

Re: Làm file CAB với thư viện COM MakeCab 1.0 Type Library

Post by HTV »

Cái này là VB 6.0 chứ .NET hồi nào đâu mà đưa vô Tip .Net
Post Reply

Return to “[VB] Hệ thống - Tập tin - Thư mục và Mạng”