• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

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
User avatar
truongphu
VIP
VIP
Posts: 4764
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

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

Postby truongphu » Sun 16/08/2009 10:41 pm

(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

  1. Private Sub Command1_Click()
  2. CommonDialog1.ShowOpen
  3. If CommonDialog1.FileName <> "" Then
  4.     Dim Xcab As New COMMKCABLib.MakeCab
  5.     Dim Fname As String
  6.     Fname = CommonDialog1.FileName
  7.     Fname = Left(Fname, Len(Fname) - 3) & "cab"
  8.  
  9.     Xcab.CreateCab Fname, False, 0, False
  10.     Xcab.AddFile CommonDialog1.FileName, CommonDialog1.FileName
  11.     Xcab.CloseCab
  12. End If
  13. End Sub
Attachments
Make CAB.rar
(1.27 KiB) Downloaded 509 times


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4764
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

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

Postby truongphu » Mon 17/08/2009 9:42 am

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

  1.    Dim Xcab As New COMMKCABLib.MakeCab
  2.    
  3. Private Sub Command1_Click() ' Nén 1 File
  4. Set objDialog = CreateObject("UserAccounts.CommonDialog")
  5.     objDialog.InitialDir = "D:\"
  6.     objDialog.ShowOpen
  7.         If objDialog.FileName <> "" Then
  8.                 Xcab.CreateCab Left(objDialog.FileName, Len(objDialog.FileName) - 3) & "cab", False, 0, False
  9.                 Xcab.AddFile objDialog.FileName, objDialog.FileName
  10.                 Xcab.CloseCab
  11.                     MsgBox "Ðã Xong"
  12.         End If
  13. End Sub
  14.  
  15. Private Sub Command2_Click() ' Nén 1 Folder không có folder con
  16. On Error GoTo 500
  17. Set PathFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Select a folder:", 0)
  18.         Xcab.CreateCab PathFolder.Self.Path & ".cab", False, 0, False
  19.             Set MyFiles = CreateObject("Scripting.FileSystemObject").GetFolder(PathFolder.Self.Path).Files
  20.                     For Each mFile In MyFiles
  21.                         Dim mFilePath$
  22.                         mFilePath = PathFolder.Self.Path & "\" & mFile.Name
  23.                         Xcab.AddFile mFilePath, mFilePath
  24.                     Next
  25.         Xcab.CloseCab
  26.             MsgBox "Ðã Xong"
  27. Exit Sub
  28. 500: MsgBox "Lô~i xây ra"
  29. End Sub
Attachments
Make CAB folder.rar
(1.61 KiB) Downloaded 322 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4764
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

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

Postby truongphu » Tue 18/08/2009 9:54 am

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

  1. Dim Xcab As New COMMKCABLib.MakeCab
  2.     Dim SpecialPath$
  3.     'truongphu
  4. Private Sub Command1_Click()
  5. Set objDialog = CreateObject("UserAccounts.CommonDialog")
  6.     objDialog.InitialDir = "D:\"
  7.     objDialog.ShowOpen
  8.         If objDialog.FileName <> "" Then
  9.         Dim Fname$: Fname = Mid(objDialog.FileName, InStrRev(objDialog.FileName, "\") + 1)
  10.                 Xcab.CreateCab Left(objDialog.FileName, Len(objDialog.FileName) - 3) & "cab", False, 0, False
  11.                 Xcab.AddFile Fname, Fname
  12.                 Xcab.CloseCab
  13.                     MsgBox "Ðã Xong"
  14.         End If
  15. End Sub
  16.  
  17. Private Sub Command2_Click()
  18. 'On Error Resume Next
  19. Set PathFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Select a folder:", 0)
  20. Dim FolderAll As Folder, Spath$, mFilePath$
  21.         Xcab.CreateCab PathFolder.Self.Path & ".cab", False, 0, False
  22.             Set FolderAll = CreateObject("Scripting.FileSystemObject").GetFolder(PathFolder.Self.Path)
  23.             Spath = Mid(PathFolder.Self.Path, InStrRev(PathFolder.Self.Path, "\") + 1)
  24.             SpecialPath = Replace(PathFolder.Self.Path, Spath, "")
  25.             Set MyFiles = FolderAll.Files
  26.                     For Each mFile In MyFiles
  27.                         Xcab.AddFile mFile.Path, Spath & "\" & mFile.Name
  28.                     Next
  29.                     MoveToSub FolderAll
  30.         Xcab.CloseCab
  31.             MsgBox "Ðã Xong"
  32.  
  33. End Sub
  34.  
  35. Private Sub MoveToSub(AFolder As Folder)
  36.     Set MoreFolders = AFolder.SubFolders
  37.     Dim TmpFolder As Folder, SSpath$, mFilePath$
  38.       'On Error Resume Next
  39.         For Each TmpFolder In MoreFolders
  40.             SSpath = Replace(TmpFolder, SpecialPath, "")
  41.             Set MoreFiles = TmpFolder.Files
  42.                 For Each TmpFile In MoreFiles
  43.                     Xcab.AddFile TmpFile.Path, SSpath & "\" & TmpFile.Name
  44.                 Next
  45.             MoveToSub TmpFolder
  46.         Next
  47. End Sub
  48.  
Attachments
Make CAB TôT.rar
(1.79 KiB) Downloaded 332 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

Postby HTV » Sun 30/08/2009 8:15 pm

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


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

Who is online

Users browsing this forum: No registered users and 0 guests