Module giải nén file rar

Các Module, Class, UserControl và thư viện OCX, DLL hỗ trợ cho Visual Basic
Post Reply
User avatar
tungblt
Điều hành viên
Điều hành viên
Posts: 550
Joined: Mon 22/12/2008 5:22 pm
Location: quy nhơn
Has thanked: 8 times
Been thanked: 74 times
Contact:

Module giải nén file rar

Post by tungblt »

Tên: Module giải nén file rar
Loại: module
Ngôn ngữ lập trình: Vb6
Tác giả: Sưu tầm
Chức năng: giải nén file rar
Hàng sưu tầm :">

code

  1.   Option Explicit
  2.  
  3.   Dim udtRAR As RAROpenArchiveData
  4.   Dim lHandle As Long
  5.   Dim udtHeader As RARHeaderData
  6.   Dim lBytesCount As Long
  7.   Dim lBytesTotal As Long
  8.   Dim tmp As Long
  9.   Dim rtnRar As Long
  10.   Dim i
  11.  
  12.   Public RAR_ABORT As Boolean
  13.  
  14.   Const ERAR_END_ARCHIVE      As Long = 10 '/ end of archive
  15.  Const ERAR_NO_MEMORY        As Long = 11 '/ not enough memory to init data structures
  16.  Const ERAR_BAD_DATA         As Long = 12 '/ archive header broken
  17.  Const ERAR_BAD_ARCHIVE      As Long = 13 '/ not a valid rar archive
  18.  Const ERAR_UNKNOWN_FORMAT   As Long = 14 '/ unknow comment format
  19.  Const ERAR_EOPEN            As Long = 15 '/ file open error
  20.  Const ERAR_ECREATE          As Long = 16 '/ file create error
  21.  Const ERAR_ECLOSE           As Long = 17 '/ file close error
  22.  Const ERAR_EREAD            As Long = 18 '/ read error
  23.  Const ERAR_EWRITE           As Long = 19 '/ write error
  24.  Const ERAR_SMALL_BUF        As Long = 20 '/ buffer too small, comments are not read completly
  25.  Const ERAR_NORARDLL         As Long = 50 '/ Unrar.dll not found
  26.  Const RAR_OM_LIST           As Long = 0  '/ open archive for reading file headers only
  27.  Const RAR_OM_EXTRACT        As Long = 1  '/ open archive for testing and extracting files
  28.  Const RAR_SKIP              As Long = 0  '/ move to the next file in archive
  29.                                           '/ if the archive is solid and RAR_OM_EXTRACT
  30.                                           '/ mode was set when the archive was opened,
  31.                                           '/ the current file will be processed - the
  32.                                           '/ operation will be performed slower than a
  33.                                           '/ single seek
  34.  Const RAR_TEST              As Long = 1  '/ Test the current file and move to the next
  35.                                           '/ file in the archive. If the archive was opened
  36.                                           '/ with RAR_OM_LIST mode, the operation is equal
  37.                                           '/ to RAR_SKIP.
  38.  Const RAR_EXTRACT           As Long = 2  '/ Extract the current file and move to the next
  39.                                           '/ file in the archive. If the archive was opened
  40.                                           '/ with RAR_OM_LIST mode, the operation is equal
  41.                                           '/ to RAR_SKIP
  42.  Const RAR_VOL_ASK           As Long = 0  '/ Required volume is absent. The function should
  43.                                           '/ prompt user and return non-zero value to retry
  44.                                           '/ the operation. The function may also specify a
  45.                                           '/ new volumename, placing it to ArcName parameter.
  46.  Const RAR_VOL_NOTIFY        As Long = 1  '/ Required volume is succesfully opened.
  47.                                           '/ This is not a notification call and ArcName
  48.                                           '/ modification is not allowed.
  49.                                           '/ The function should return non-zero value to
  50.                                           '/ continue or a zero-value to terminate the
  51.                                           '/ operation
  52.  
  53.   Type RARHeaderData
  54.     ArcName As String * 260
  55.     FileName As String * 260
  56.     Flags As Long
  57.     PackSize As Long
  58.     UnpSize As Long
  59.     HostOS As Long
  60.     FileCRC As Long
  61.     FileTime As Long
  62.     UnpVer As Long
  63.     Method As Long
  64.     FileAttr As Long
  65.     CmtBuf As String
  66.     CmtBufSize As Long
  67.     CmtSize As Long
  68.     CmtState As Long
  69.   End Type
  70.  
  71.   Type RAROpenArchiveData
  72.     ArcName As String
  73.     OpenMode As Long
  74.     OpenResult As Long
  75.     CmtBuf As String
  76.     CmtBufSize As Long
  77.     CmtSize As Long
  78.     CmtState As Long
  79.   End Type
  80.  
  81. Declare Function RAROpen Lib "unrar.dll" Alias "RAROpenArchive" _
  82.                  (ByRef RAROpenData As RAROpenArchiveData) As Long
  83.                  
  84. Declare Function RARClose Lib "unrar.dll" Alias "RARCloseArchive" _
  85.                  (ByVal HandleToArchive As Long) As Long
  86.                  
  87. Declare Function RARReadHdr Lib "unrar.dll" Alias "RARReadHeader" _
  88.                  (ByVal HandleToArcRecord As Long, ByRef ArcHeaderRead As RARHeaderData) As Long
  89.                  
  90. Declare Function RARProcFile Lib "unrar.dll" Alias "RARProcessFile" _
  91.                  (ByVal HandleToArcHeader As Long, ByVal Operation As Long, ByVal DestPath As String, ByVal DestName As String) As Long
  92.  
  93. Declare Function RARSetPassword Lib "unrar.dll" _
  94.                  (ByVal HandleToArchive As Long, ByVal Password As String) As Long
  95.  
  96. Declare Function RARSetChangeVolProc Lib "unrar.dll" _
  97.                  (ByVal HandleToArchive As Long, ByVal mode As Long) As Long
  98.  
  99.  
  100. Function GiaiNen(sExtractDir As String, sArchName As String, lbResult As Label, Optional sRarPassword As String)
  101.    
  102.  ' check if the selected archive exists otherwise program would crash
  103.  
  104.  i = Dir(sArchName)
  105.    If i = "" Then MsgBox "Archive " & sArchName & " not found!", vbCritical Exit Function
  106.  
  107.  ' check if the sExtractDir end with ""
  108.  
  109.  If Right(sExtractDir, 1) <> "" Then sExtractDir = sExtractDir & ""
  110.  
  111.  ' open the archive for testing
  112.  
  113.     udtRAR.ArcName = sExtractDir
  114.     udtRAR.ArcName = sArchName
  115.     udtRAR.OpenMode = RAR_OM_LIST
  116.     lHandle = RAROpen(udtRAR)
  117.     lBytesCount = 0
  118.     lBytesTotal = 0
  119.     RAR_ABORT = False
  120. Do
  121.   rtnRar = RARReadHdr(lHandle, udtHeader)
  122.  
  123.    
  124.     If rtnRar = 0 Then
  125.     lbResult.Caption = "testing - " & LCase(udtHeader.FileName) lbResult.Refresh
  126.        tmp = RARProcFile(lHandle, RAR_TEST, sExtractDir, sExtractDir & udtHeader.FileName)
  127.         If tmp <> 0 Then
  128.            i = RarErrorHandle(tmp)
  129.            If i = False Then Exit Function
  130.            End If
  131.        lBytesTotal = lBytesTotal + udtHeader.UnpSize
  132.     DoEvents
  133.     Else
  134.      i = RarErrorHandle(rtnRar)
  135.       If i = False Then Exit Function
  136.     End If
  137.  
  138. If RAR_ABORT = True Then Exit Function
  139.  
  140. Loop Until rtnRar <> 0
  141.  
  142.   tmp = RARClose(lHandle)
  143.   i = RarErrorHandle(tmp)
  144.     If i = False Then Exit Function
  145.    
  146.  ' xoa thanh tien trinh & nhan tien trinh
  147.  
  148.  
  149.  ' mo ngay bay h de trich xuat
  150.    
  151.     udtRAR.ArcName = sExtractDir
  152.     udtRAR.ArcName = sArchName
  153.     udtRAR.OpenMode = RAR_OM_EXTRACT
  154.     lHandle = RAROpen(udtRAR)
  155.     lBytesCount = 0
  156.     If sRarPassword <> "" Then RARSetPassword lHandle, sRarPassword
  157.    
  158. Dim Cnt
  159. Do
  160.     rtnRar = RARReadHdr(lHandle, udtHeader)
  161.    
  162.     If rtnRar = 0 Then
  163.      
  164.        lbResult.Caption = LCase(udtHeader.FileName) lbResult.Refresh
  165.        tmp = RARProcFile(lHandle, RAR_EXTRACT, sExtractDir, sExtractDir & udtHeader.FileName)
  166.           If tmp <> 0 Then
  167.              i = RarErrorHandle(tmp)
  168.              If i = False Then Exit Function
  169.              End If
  170.        lBytesCount = lBytesCount + udtHeader.UnpSize
  171.        '/ thanh tien trinh
  172.  
  173.        DoEvents
  174.     Else
  175.        i = RarErrorHandle(rtnRar)
  176.        If i = False Then Exit Function
  177.     End If
  178.  If RAR_ABORT = True Then Exit Do
  179. Loop Until rtnRar <> 0
  180.  
  181.   tmp = RARClose(lHandle)
  182.   RarErrorHandle (tmp)
  183.  
  184. End Function
  185. Function RarErrorHandle(Error As Long) As Boolean
  186.  
  187.  RarErrorHandle = True
  188.  
  189.  Select Case Error
  190.  
  191.   Case ERAR_END_ARCHIVE
  192.   '/ danh sach loi
  193.  Case ERAR_NO_MEMORY
  194.      MsgBox "Lo64i  Kho6ng d9u3 bo65 nho71 d9e63 kho73i ta5o ca61u tru1c du74 lie65", vbCritical
  195.      RarErrorHandle = False
  196.   Case ERAR_BAD_DATA
  197.      MsgBox "Lo64i  Pha62n d9a62u du74 lie65u bi5 ho3ng", vbCritical
  198.      RarErrorHandle = False
  199.   Case ERAR_BAD_ARCHIVE
  200.      MsgBox "Lo64i  D9a6y kho6ng pha3i la2 1 file rar ho75p le65 " & udtHeader.ArcName, vbCritical
  201.      RarErrorHandle = False
  202.   Case ERAR_UNKNOWN_FORMAT
  203.      MsgBox "Lo64i  Kho6ng ro4 ghi chu1 cu3a d9i5ng da5ng" & udtHeader.ArcName, vbCritical
  204.      RarErrorHandle = False
  205.   Case ERAR_EOPEN
  206.      Msg "Lo64i Mo73 Ta65p  " & udtHeader.ArcName, vbCritical
  207.      RarErrorHandle = False
  208.   Case ERAR_ECREATE
  209.      Msg "Lo64i Ta5o thu7 mu5c hoa85c file " & udtHeader.FileName, vbInformation
  210.      RarErrorHandle = True
  211.   Case ERAR_ECLOSE
  212.      MsgBox "Lo64i  D9ang d9o1ng file " & udtHeader.FileName, vbCritical
  213.      RarErrorHandle = False
  214.   Case ERAR_EREAD
  215.      MsgBox "Lo64i  D9ang d9o5c file " & udtHeader.FileName, vbCritical
  216.      RarErrorHandle = False
  217.   Case ERAR_EWRITE
  218.      MsgBox "Lo64i  D9ang ghi file " & udtHeader.FileName, vbCritical
  219.      RarErrorHandle = True
  220.   Case ERAR_SMALL_BUF
  221.      MsgBox "Lo64i  Bo65 d9e65m qua1 nho3, d9o5c kho6ng tha2nh co6ng", vbInformation
  222.      RarErrorHandle = True
  223.   Case ERAR_NORARDLL
  224.   '/ Unrar.dll khong co
  225.  
  226.  End Select
  227. End Function
  228.  
  229. Function StripDirPath(sPath As String)
  230.  Dim x
  231.   x = Len(sPath)
  232.  Do Until Mid(sPath, x, 1) = ""
  233.   x = x - 1
  234.   If x = 1 Then Exit Do
  235.  Loop
  236.  StripDirPath = Mid(sPath, x + 1, Len(sPath))
  237. End Function


cách dùng
GiaiNen "thư mục cần giải nén", "file cần giải nén", "nhãn tiến trình", "password file rar"
  1. Private Sub cmdgiainen_Click()
  2. GiaiNen App.Path, "D\1.rar", lbResult
  3. End Sub
eriscool
Posts: 5
Joined: Sat 09/08/2008 1:35 pm

Re: Module giải nén file rar

Post by eriscool »

Sao k thấy pần download đâu hết vậy pac'
User avatar
tungblt
Điều hành viên
Điều hành viên
Posts: 550
Joined: Mon 22/12/2008 5:22 pm
Location: quy nhơn
Has thanked: 8 times
Been thanked: 74 times
Contact:

Re: Module giải nén file rar

Post by tungblt »

bạn tạo 1 module .. copy phần code ở trên dán vào
cách sử dụng ở dưới
love
eriscool
Posts: 5
Joined: Sat 09/08/2008 1:35 pm

Re: Module giải nén file rar

Post by eriscool »

vậy module này dùng thư viện của winrar đúng k pác?
User avatar
tungblt
Điều hành viên
Điều hành viên
Posts: 550
Joined: Mon 22/12/2008 5:22 pm
Location: quy nhơn
Has thanked: 8 times
Been thanked: 74 times
Contact:

Re: Module giải nén file rar

Post by tungblt »

ừm đúng rồi
love
User avatar
NTN
Thành viên tâm huyết
Thành viên tâm huyết
Posts: 491
Joined: Wed 05/02/2014 3:43 pm
Location: Đồng Tháp,Việt Nam
Has thanked: 20 times
Been thanked: 7 times
Contact:

Re: Module giải nén file rar

Post by NTN »

GiaiNen App.Path, "D:vb.rar", lbResult
này dùng sau vậy anh tungblt ?
Contact me: trungnhan0911@yandex.com
Github: https://github.com/nhannt201
User avatar
tungblt
Điều hành viên
Điều hành viên
Posts: 550
Joined: Mon 22/12/2008 5:22 pm
Location: quy nhơn
Has thanked: 8 times
Been thanked: 74 times
Contact:

Re: Module giải nén file rar

Post by tungblt »

cách dùng
GiaiNen "thư mục cần giải nén", "file cần giải nén", "nhãn tiến trình", "password file rar"

? em không đọc à?
love
User avatar
NTN
Thành viên tâm huyết
Thành viên tâm huyết
Posts: 491
Joined: Wed 05/02/2014 3:43 pm
Location: Đồng Tháp,Việt Nam
Has thanked: 20 times
Been thanked: 7 times
Contact:

Re: Module giải nén file rar

Post by NTN »

Nhãn tiến trình là gì thế ? em chỉ cần thư mục giải nén , file giải nén và pass
Contact me: trungnhan0911@yandex.com
Github: https://github.com/nhannt201
User avatar
NTN
Thành viên tâm huyết
Thành viên tâm huyết
Posts: 491
Joined: Wed 05/02/2014 3:43 pm
Location: Đồng Tháp,Việt Nam
Has thanked: 20 times
Been thanked: 7 times
Contact:

Re: Module giải nén file rar

Post by NTN »

tungblt wrote:ừm đúng rồi
Cho em hỏi cái nhãn tiến trình là gì vậy ? em chạy nó lỗi chỗ lbResult à báo là
ByRef argument type mismatch
tại sao thế ?
Contact me: trungnhan0911@yandex.com
Github: https://github.com/nhannt201
User avatar
tungblt
Điều hành viên
Điều hành viên
Posts: 550
Joined: Mon 22/12/2008 5:22 pm
Location: quy nhơn
Has thanked: 8 times
Been thanked: 74 times
Contact:

Re: Module giải nén file rar

Post by tungblt »

đó là 1 cái label thôi .
love
Post Reply

Return to “[VB] Module, Class, UserControl, OCX”