Page 1 of 1

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

Posted: Sun 16/08/2009 10:41 pm
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

  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

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

Posted: Mon 17/08/2009 9:42 am
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

  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

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

Posted: Tue 18/08/2009 9:54 am
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

  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.  

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

Posted: Sun 30/08/2009 8:15 pm
by HTV
Cái này là VB 6.0 chứ .NET hồi nào đâu mà đưa vô Tip .Net