• 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

Module giải nén file rar

Các Module, Class, UserControl và thư viện OCX, DLL hỗ trợ cho Visual Basic
Hình đại diện của người dùng
tungblt
Điều hành viên
Điều hành viên
Bài viết: 548
Ngày tham gia: T.Hai 22/12/2008 5:22 pm
Đến từ: quy nhơn
Has thanked: 6 time
Been thanked: 76 time
Liên hệ:

Module giải nén file rar

Gửi bàigửi bởi tungblt » T.Năm 01/12/2011 1:18 pm

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
  238.  


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:vb.rar", lbResult
  3. End Sub
  4.  



eriscool
Bài viết: 5
Ngày tham gia: T.Bảy 09/08/2008 1:35 pm

Re: Module giải nén file rar

Gửi bàigửi bởi eriscool » T.Bảy 21/04/2012 2:03 pm

Sao k thấy pần download đâu hết vậy pac'

Hình đại diện của người dùng
tungblt
Điều hành viên
Điều hành viên
Bài viết: 548
Ngày tham gia: T.Hai 22/12/2008 5:22 pm
Đến từ: quy nhơn
Has thanked: 6 time
Been thanked: 76 time
Liên hệ:

Re: Module giải nén file rar

Gửi bàigửi bởi tungblt » T.Hai 23/04/2012 8:10 pm

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
Bài viết: 5
Ngày tham gia: T.Bảy 09/08/2008 1:35 pm

Re: Module giải nén file rar

Gửi bàigửi bởi eriscool » T.Bảy 28/04/2012 3:25 pm

vậy module này dùng thư viện của winrar đúng k pác?

Hình đại diện của người dùng
tungblt
Điều hành viên
Điều hành viên
Bài viết: 548
Ngày tham gia: T.Hai 22/12/2008 5:22 pm
Đến từ: quy nhơn
Has thanked: 6 time
Been thanked: 76 time
Liên hệ:

Re: Module giải nén file rar

Gửi bàigửi bởi tungblt » T.Ba 01/05/2012 1:51 pm

ừm đúng rồi
love

Hình đại diện của người dùng
NTN
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 472
Ngày tham gia: T.Tư 05/02/2014 3:43 pm
Đến từ: Cao Lãnh, Đồng Tháp,Việt Nam
Has thanked: 19 time
Been thanked: 7 time
Liên hệ:

Re: Module giải nén file rar

Gửi bàigửi bởi NTN » CN 01/02/2015 5:57 am

GiaiNen App.Path, "D:vb.rar", lbResult
này dùng sau vậy anh tungblt ?
Dongthapseo.com - Luutru360.com - Tình yêu của tôi <3

Hình đại diện của người dùng
tungblt
Điều hành viên
Điều hành viên
Bài viết: 548
Ngày tham gia: T.Hai 22/12/2008 5:22 pm
Đến từ: quy nhơn
Has thanked: 6 time
Been thanked: 76 time
Liên hệ:

Re: Module giải nén file rar

Gửi bàigửi bởi tungblt » CN 01/02/2015 8:40 am

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

Hình đại diện của người dùng
NTN
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 472
Ngày tham gia: T.Tư 05/02/2014 3:43 pm
Đến từ: Cao Lãnh, Đồng Tháp,Việt Nam
Has thanked: 19 time
Been thanked: 7 time
Liên hệ:

Re: Module giải nén file rar

Gửi bàigửi bởi NTN » T.Bảy 07/02/2015 5:33 am

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
Dongthapseo.com - Luutru360.com - Tình yêu của tôi <3

Hình đại diện của người dùng
NTN
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 472
Ngày tham gia: T.Tư 05/02/2014 3:43 pm
Đến từ: Cao Lãnh, Đồng Tháp,Việt Nam
Has thanked: 19 time
Been thanked: 7 time
Liên hệ:

Re: Module giải nén file rar

Gửi bàigửi bởi NTN » T.Tư 29/04/2015 6:12 am

tungblt đã viết:ừ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ế ?
Dongthapseo.com - Luutru360.com - Tình yêu của tôi <3

Hình đại diện của người dùng
tungblt
Điều hành viên
Điều hành viên
Bài viết: 548
Ngày tham gia: T.Hai 22/12/2008 5:22 pm
Đến từ: quy nhơn
Has thanked: 6 time
Been thanked: 76 time
Liên hệ:

Re: Module giải nén file rar

Gửi bàigửi bởi tungblt » T.Tư 29/04/2015 2:38 pm

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


Quay về “[VB] Module, Class, UserControl, OCX”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.2 khách