1,486
社区成员
发帖
与我相关
我的任务
分享关于用VB压缩和解压缩技术rar和zip（用我所有财产求解）
现在国内流行压缩软件有rar和zip
我想用vb来解开他们！
好象我知道事先要加载2个dll文件是unrar32.dll和unzip32.dll文件
然后声明API。再以后我也不晓得了，
我想用一个函数来打开，
例如：function unrarfile （lnghWnd As Long,“被解压文件名（包括路径）” as string ,“解开后存放文件夹路径” as string ，“解开后的文件夹名字” as string )
lnghwnd 是句丙，为了在里面传递给unrar32的参数
问题：现在求 解zip ，rar 和 压zip ，rar代码。谢谢
我想用vb来解开他们！
好象我知道事先要加载2个dll文件是unrar32.dll和unzip32.dll文件
然后声明API。再以后我也不晓得了，
我想用一个函数来打开，
例如：function unrarfile （lnghWnd As Long,“被解压文件名（包括路径）” as string ,“解开后存放文件夹路径” as string ，“解开后的文件夹名字” as string )
lnghwnd 是句丙，为了在里面传递给unrar32的参数
问题：现在求 解zip ，rar 和 压zip ，rar代码。谢谢
...全文
请发表友善的回复…
发表回复
maolz36 2005-10-28
- 打赏
- 举报
unrar.dll只提供了解压缩吧，没提供压缩啊
zou19820704 2005-09-05
- 打赏
- 举报
一样适用！！请放心使用，呵呵
VBAHZ 2005-09-04
- 打赏
- 举报
主题——能解压缩Zip吗？
我啃 2005-09-03
- 打赏
- 举报
方法1:使用shell函数调用rar.exe并参考其提供的参数列表进行调用操作
方法2:调用WINRAR提供的.DLL文件,使用其中的API函数,(楼上的已经完全解释了)
方法2:调用WINRAR提供的.DLL文件,使用其中的API函数,(楼上的已经完全解释了)
zou19820704 2005-09-02
- 打赏
- 举报
Const ERAR_END_ARCHIVE = 10
Const ERAR_NO_MEMORY = 11
Const ERAR_BAD_DATA = 12
Const ERAR_BAD_ARCHIVE = 13
Const ERAR_UNKNOWN_FORMAT = 14
Const ERAR_EOPEN = 15
Const ERAR_ECREATE = 16
Const ERAR_ECLOSE = 17
Const ERAR_EREAD = 18
Const ERAR_EWRITE = 19
Const ERAR_SMALL_BUF = 20
Const RAR_OM_LIST = 0
Const RAR_OM_EXTRACT = 1
Const RAR_SKIP = 0
Const RAR_TEST = 1
Const RAR_EXTRACT = 2
Const RAR_VOL_ASK = 0
Const RAR_VOL_NOTIFY = 1
Enum RarOperations
OP_EXTRACT = 0
OP_TEST = 1
OP_LIST = 2
End Enum
Private Type RARHeaderData
ArcName As String * 260
FileName As String * 260
Flags As Long
PackSize As Long
UnpSize As Long
HostOS As Long
FileCRC As Long
FileTime As Long
UnpVer As Long
Method As Long
FileAttr As Long
CmtBuf As String
CmtBufSize As Long
CmtSize As Long
CmtState As Long
End Type
Private Type RAROpenArchiveData
ArcName As String
OpenMode As Long
OpenResult As Long
CmtBuf As String
CmtBufSize As Long
CmtSize As Long
CmtState As Long
End Type
Private Declare Function RAROpenArchive Lib "unrar.dll" (ByRef ArchiveData As RAROpenArchiveData) As Long
Private Declare Function RARCloseArchive Lib "unrar.dll" (ByVal hArcData As Long) As Long
Private Declare Function RARReadHeader Lib "unrar.dll" (ByVal hArcData As Long, ByRef HeaderData As RARHeaderData) As Long
Private Declare Function RARProcessFile Lib "unrar.dll" (ByVal hArcData As Long, ByVal Operation As Long, ByVal DestPath As String, ByVal DestName As String) As Long
Private Declare Sub RARSetChangeVolProc Lib "unrar.dll" (ByVal hArcData As Long, ByVal Mode As Long)
Private Declare Sub RARSetPassword Lib "unrar.dll" (ByVal hArcData As Long, ByVal Password As String)
Private Sub Command5_Click()
End
End Sub
Private Sub RARExecute(Mode As RarOperations, RarFile As String, Optional Password As String)
' Description:-
' Extract file(s) from RAR archive.
' Parameters:-
' Mode = Operation to perform on RAR Archive
' RARFile = RAR Archive filename
' sPassword = Password (Optional)
Dim lHandle As Long
Dim iStatus As Integer
Dim uRAR As RAROpenArchiveData
Dim uHeader As RARHeaderData
Dim sStat As String, Ret As Long
uRAR.ArcName = RarFile
uRAR.CmtBuf = Space(16384)
uRAR.CmtBufSize = 16384
If Mode = OP_LIST Then
uRAR.OpenMode = RAR_OM_LIST
Else
uRAR.OpenMode = RAR_OM_EXTRACT
End If
lHandle = RAROpenArchive(uRAR)
If uRAR.OpenResult <> 0 Then OpenError uRAR.OpenResult, RarFile
If Password <> "" Then RARSetPassword lHandle, Password
If (uRAR.CmtState = 1) Then MsgBox uRAR.CmtBuf, vbApplicationModal + vbInformation, "Comment"
iStatus = RARReadHeader(lHandle, uHeader)
Show
Do Until iStatus <> 0
sStat = Left(uHeader.FileName, InStr(1, uHeader.FileName, vbNullChar) - 1)
Select Case Mode
Case RarOperations.OP_EXTRACT
List1.AddItem "Extracting " & sStat
Ret = RARProcessFile(lHandle, RAR_EXTRACT, "", uHeader.FileName)
Case RarOperations.OP_TEST
List1.AddItem "Testing " & sStat
Ret = RARProcessFile(lHandle, RAR_TEST, "", uHeader.FileName)
Case RarOperations.OP_LIST
List1.AddItem "File: " & sStat & vbTab & vbTab & vbTab & "Size: " & uHeader.UnpSize
Ret = RARProcessFile(lHandle, RAR_SKIP, "", "")
End Select
If Ret = 0 Then
List1.List(List1.ListCount - 1) = List1.List(List1.ListCount - 1) & vbTab & vbTab & "OK"
Else
ProcessError Ret
End If
iStatus = RARReadHeader(lHandle, uHeader)
Refresh
Loop
If iStatus = ERAR_BAD_DATA Then Erro ("File header broken")
RARCloseArchive lHandle
End Sub
Private Sub Form_Load()
Dim Vals() As String, Msg As String
Dim Command As String
Command = "x " & "D:\外语学习\lhut3227\文档\UnRarOCX.rar" & " 0" '在这里用Commondilog 来确定你的文件路径。“X”，“0” 应该保留哦
If Command = "" Then
Msg = "VBUNRAR.EXE. This is a simple example of UNRAR.DLL usage" & vbCrLf & vbCrLf
Msg = Msg & "Syntax:" & vbCrLf
Msg = Msg & "VBUNRAR X <Archive> <Password> extract archive contents" & vbCrLf
Msg = Msg & "VBUNRAR T <Archive> <Password> test archive contents" & vbCrLf
Msg = Msg & "VBUNRAR L <Archive> <Password> view archive contents"
MsgBox Msg, vbApplicationModal + vbInformation, "VBUnRAR"
End
End If
Vals = Split(Command, " ")
ReDim Preserve Vals(2)
If Vals(0) = "" Or Vals(1) = "" Then Erro ("Missing arguments!")
Select Case UCase(Vals(0))
Case "X"
RARExecute OP_EXTRACT, Vals(1), Vals(2)
Case "T"
RARExecute OP_TEST, Vals(1), Vals(2)
Case "L"
RARExecute OP_LIST, Vals(1), Vals(2)
Case Else
Erro "Invalid Arguments!"
End Select
Command5.Enabled = True
End Sub
Private Sub OpenError(ErroNum As Long, ArcName As String)
Select Case ErroNum
Case ERAR_NO_MEMORY
Erro "Not enough memory"
Case ERAR_EOPEN:
Erro "Cannot open " & ArcName
Case ERAR_BAD_ARCHIVE:
Erro ArcName & " is not RAR archive"
Case ERAR_BAD_DATA:
Erro ArcName & ": archive header broken"
End Select
End Sub
Private Sub ProcessError(ErroNum As Long)
Select Case ErroNum
Case ERAR_UNKNOWN_FORMAT
Erro "Unknown archive format"
Case ERAR_BAD_ARCHIVE:
Erro "Bad volume"
Case ERAR_ECREATE:
Erro "File create error"
Case ERAR_EOPEN:
Erro "Volume open error"
Case ERAR_ECLOSE:
Erro "File close error"
Case ERAR_EREAD:
Erro "Read error"
Case ERAR_EWRITE:
Erro "Write error"
Case ERAR_BAD_DATA:
Erro "CRC error"
End Select
End Sub
Private Sub Erro(Msg As String)
MsgBox Msg, vbApplicationModal + vbExclamation, "Error"
End
End Sub
Const ERAR_NO_MEMORY = 11
Const ERAR_BAD_DATA = 12
Const ERAR_BAD_ARCHIVE = 13
Const ERAR_UNKNOWN_FORMAT = 14
Const ERAR_EOPEN = 15
Const ERAR_ECREATE = 16
Const ERAR_ECLOSE = 17
Const ERAR_EREAD = 18
Const ERAR_EWRITE = 19
Const ERAR_SMALL_BUF = 20
Const RAR_OM_LIST = 0
Const RAR_OM_EXTRACT = 1
Const RAR_SKIP = 0
Const RAR_TEST = 1
Const RAR_EXTRACT = 2
Const RAR_VOL_ASK = 0
Const RAR_VOL_NOTIFY = 1
Enum RarOperations
OP_EXTRACT = 0
OP_TEST = 1
OP_LIST = 2
End Enum
Private Type RARHeaderData
ArcName As String * 260
FileName As String * 260
Flags As Long
PackSize As Long
UnpSize As Long
HostOS As Long
FileCRC As Long
FileTime As Long
UnpVer As Long
Method As Long
FileAttr As Long
CmtBuf As String
CmtBufSize As Long
CmtSize As Long
CmtState As Long
End Type
Private Type RAROpenArchiveData
ArcName As String
OpenMode As Long
OpenResult As Long
CmtBuf As String
CmtBufSize As Long
CmtSize As Long
CmtState As Long
End Type
Private Declare Function RAROpenArchive Lib "unrar.dll" (ByRef ArchiveData As RAROpenArchiveData) As Long
Private Declare Function RARCloseArchive Lib "unrar.dll" (ByVal hArcData As Long) As Long
Private Declare Function RARReadHeader Lib "unrar.dll" (ByVal hArcData As Long, ByRef HeaderData As RARHeaderData) As Long
Private Declare Function RARProcessFile Lib "unrar.dll" (ByVal hArcData As Long, ByVal Operation As Long, ByVal DestPath As String, ByVal DestName As String) As Long
Private Declare Sub RARSetChangeVolProc Lib "unrar.dll" (ByVal hArcData As Long, ByVal Mode As Long)
Private Declare Sub RARSetPassword Lib "unrar.dll" (ByVal hArcData As Long, ByVal Password As String)
Private Sub Command5_Click()
End
End Sub
Private Sub RARExecute(Mode As RarOperations, RarFile As String, Optional Password As String)
' Description:-
' Extract file(s) from RAR archive.
' Parameters:-
' Mode = Operation to perform on RAR Archive
' RARFile = RAR Archive filename
' sPassword = Password (Optional)
Dim lHandle As Long
Dim iStatus As Integer
Dim uRAR As RAROpenArchiveData
Dim uHeader As RARHeaderData
Dim sStat As String, Ret As Long
uRAR.ArcName = RarFile
uRAR.CmtBuf = Space(16384)
uRAR.CmtBufSize = 16384
If Mode = OP_LIST Then
uRAR.OpenMode = RAR_OM_LIST
Else
uRAR.OpenMode = RAR_OM_EXTRACT
End If
lHandle = RAROpenArchive(uRAR)
If uRAR.OpenResult <> 0 Then OpenError uRAR.OpenResult, RarFile
If Password <> "" Then RARSetPassword lHandle, Password
If (uRAR.CmtState = 1) Then MsgBox uRAR.CmtBuf, vbApplicationModal + vbInformation, "Comment"
iStatus = RARReadHeader(lHandle, uHeader)
Show
Do Until iStatus <> 0
sStat = Left(uHeader.FileName, InStr(1, uHeader.FileName, vbNullChar) - 1)
Select Case Mode
Case RarOperations.OP_EXTRACT
List1.AddItem "Extracting " & sStat
Ret = RARProcessFile(lHandle, RAR_EXTRACT, "", uHeader.FileName)
Case RarOperations.OP_TEST
List1.AddItem "Testing " & sStat
Ret = RARProcessFile(lHandle, RAR_TEST, "", uHeader.FileName)
Case RarOperations.OP_LIST
List1.AddItem "File: " & sStat & vbTab & vbTab & vbTab & "Size: " & uHeader.UnpSize
Ret = RARProcessFile(lHandle, RAR_SKIP, "", "")
End Select
If Ret = 0 Then
List1.List(List1.ListCount - 1) = List1.List(List1.ListCount - 1) & vbTab & vbTab & "OK"
Else
ProcessError Ret
End If
iStatus = RARReadHeader(lHandle, uHeader)
Refresh
Loop
If iStatus = ERAR_BAD_DATA Then Erro ("File header broken")
RARCloseArchive lHandle
End Sub
Private Sub Form_Load()
Dim Vals() As String, Msg As String
Dim Command As String
Command = "x " & "D:\外语学习\lhut3227\文档\UnRarOCX.rar" & " 0" '在这里用Commondilog 来确定你的文件路径。“X”，“0” 应该保留哦
If Command = "" Then
Msg = "VBUNRAR.EXE. This is a simple example of UNRAR.DLL usage" & vbCrLf & vbCrLf
Msg = Msg & "Syntax:" & vbCrLf
Msg = Msg & "VBUNRAR X <Archive> <Password> extract archive contents" & vbCrLf
Msg = Msg & "VBUNRAR T <Archive> <Password> test archive contents" & vbCrLf
Msg = Msg & "VBUNRAR L <Archive> <Password> view archive contents"
MsgBox Msg, vbApplicationModal + vbInformation, "VBUnRAR"
End
End If
Vals = Split(Command, " ")
ReDim Preserve Vals(2)
If Vals(0) = "" Or Vals(1) = "" Then Erro ("Missing arguments!")
Select Case UCase(Vals(0))
Case "X"
RARExecute OP_EXTRACT, Vals(1), Vals(2)
Case "T"
RARExecute OP_TEST, Vals(1), Vals(2)
Case "L"
RARExecute OP_LIST, Vals(1), Vals(2)
Case Else
Erro "Invalid Arguments!"
End Select
Command5.Enabled = True
End Sub
Private Sub OpenError(ErroNum As Long, ArcName As String)
Select Case ErroNum
Case ERAR_NO_MEMORY
Erro "Not enough memory"
Case ERAR_EOPEN:
Erro "Cannot open " & ArcName
Case ERAR_BAD_ARCHIVE:
Erro ArcName & " is not RAR archive"
Case ERAR_BAD_DATA:
Erro ArcName & ": archive header broken"
End Select
End Sub
Private Sub ProcessError(ErroNum As Long)
Select Case ErroNum
Case ERAR_UNKNOWN_FORMAT
Erro "Unknown archive format"
Case ERAR_BAD_ARCHIVE:
Erro "Bad volume"
Case ERAR_ECREATE:
Erro "File create error"
Case ERAR_EOPEN:
Erro "Volume open error"
Case ERAR_ECLOSE:
Erro "File close error"
Case ERAR_EREAD:
Erro "Read error"
Case ERAR_EWRITE:
Erro "Write error"
Case ERAR_BAD_DATA:
Erro "CRC error"
End Select
End Sub
Private Sub Erro(Msg As String)
MsgBox Msg, vbApplicationModal + vbExclamation, "Error"
End
End Sub
dyb1234567 2005-08-31
- 打赏
- 举报
mark
bigmgii 2005-08-30
- 打赏
- 举报
好像看到过什么利用二叉树压缩的方法
>_<看不懂啊，你去搜搜
>_<看不懂啊，你去搜搜
zou19820704 2005-08-30
- 打赏
- 举报
deng dai .......
zou19820704 2005-08-26
- 打赏
- 举报
感谢各位，我明白现在有2个方法来解决这个问题
1 是调用rar.exe程序在后台解压缩文件
2 是使用别人的rar控件来解压缩
做为一个技术员，要的是无限追求技术。现在解压缩大家基本是可以知道怎么做了！但是我们需要的是他是怎么去实现的呢？人家的rar控件到底是怎么写出来的呢？是vb还是c呢？我是一个初学者，很多问题都是很肤浅，还希望高手门不要笑话我哦！
1 是调用rar.exe程序在后台解压缩文件
2 是使用别人的rar控件来解压缩
做为一个技术员，要的是无限追求技术。现在解压缩大家基本是可以知道怎么做了！但是我们需要的是他是怎么去实现的呢？人家的rar控件到底是怎么写出来的呢？是vb还是c呢？我是一个初学者，很多问题都是很肤浅，还希望高手门不要笑话我哦！
langhua018 2005-08-22
- 打赏
- 举报
学习...
VBAHZ 2005-08-21
- 打赏
- 举报
是解压Zip和Rar吗？（本主题就是这个）
boyzhang 2005-08-21
- 打赏
- 举报
小吉写过一个纯VB的压缩程序,
效果还不错,
你可以在CSDN里搜一下.
:D
效果还不错,
你可以在CSDN里搜一下.
:D
VBAHZ 2005-08-21
- 打赏
- 举报
最大的问题！！！解压缩呢？
网上流行最多的毕竟还是Zip格式，Rar行吗？
网上流行最多的毕竟还是Zip格式，Rar行吗？
熊孩子开学喽 2005-08-21
- 打赏
- 举报
偶也喜欢调用RAR控制台程序，简单快速。因为参数非常详细，所以只需要写一个界面外壳就能做很多事，如果只是设置关键参数，也可以放在后台运行，很简洁。再说，楼主调用人家写好的DLL和直接调用EXE也没有什么大的区别，何必这么在意这么小的区别呢，反正关键算法都不是自己写的，５步和１０步的区别而已。
嘿嘿，调用现有的资源，不正是VB最拿手的事么。
嘿嘿，调用现有的资源，不正是VB最拿手的事么。
zou19820704 2005-08-19
- 打赏
- 举报
强烈谢谢dingmin（）
dingmin 2005-08-19
- 打赏
- 举报
http://community.csdn.net/Expert/topic/4215/4215789.xml?temp=.9125788
有你需要的答案~
留下邮箱并注明所要解决的问题~
有你需要的答案~
留下邮箱并注明所要解决的问题~
VBDN 2005-08-13
- 打赏
- 举报
对了，获得系统临时目录的方法：Environ("temp") 或 Environ("tmp")
VBDN 2005-08-13
- 打赏
- 举报
强烈支持 jxgzay(jxgzay) 使用控制台程序rar.exe的方法，拷贝这个rar.exe文件即可在没有装winrar的机器上直接使用 shell "rar.exe 参数列表" 的方法调用。
另外：你可以使用vbHide参数隐藏shell调用时rar.exe的运行界面。
你可以将这个rar.exe加入到资源文件中，然后编译，实现所谓的绿色软件。需要用的时候，先释放到系统临时目录中。
鄙人单位的oracle每天导出的数据达四百多M，写了个压缩程序，就用的这个方法。
另外：你可以使用vbHide参数隐藏shell调用时rar.exe的运行界面。
你可以将这个rar.exe加入到资源文件中，然后编译，实现所谓的绿色软件。需要用的时候，先释放到系统临时目录中。
鄙人单位的oracle每天导出的数据达四百多M，写了个压缩程序，就用的这个方法。
zou19820704 2005-08-12
- 打赏
- 举报
谢谢各位兄弟，我需要的是不是调用exe来接压缩，我想用自己的语言来接压缩，尽管关键的技术还是需要调用dll文件，
昨天我查找了一下，发现是调用unrar.dll文件，然后再声明其中的函数，可是我笨，不晓得函数怎么使用，呵呵，希望大虾指点指点！！
如果可能希望吧制作ocx空间的代码贴出来！
就是UnRarOCX.ocx这个控件代码，谢谢
2005.8.12. 11：32
昨天我查找了一下，发现是调用unrar.dll文件，然后再声明其中的函数，可是我笨，不晓得函数怎么使用，呵呵，希望大虾指点指点！！
如果可能希望吧制作ocx空间的代码贴出来！
就是UnRarOCX.ocx这个控件代码，谢谢
2005.8.12. 11：32
僵哥 2005-08-12
- 打赏
- 举报
调用示例:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3090
ClientLeft = 60
ClientTop = 450
ClientWidth = 7680
LinkTopic = "Form1"
ScaleHeight = 3090
ScaleWidth = 7680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command2
Caption = "解压缩"
Height = 525
Left = 2130
TabIndex = 1
Top = 300
Width = 1245
End
Begin VB.CommandButton Command1
Caption = "压缩"
Height = 525
Left = 570
TabIndex = 0
Top = 300
Width = 1245
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
Dim l As Long, b() As Byte, bTmp() As Byte
Open "d:\in.dat" For Binary As #1 '从in.dat中读取数据
Open "d:\out.dat" For Binary As #2 '压缩后生成out.dat
l = LOF(1) - 1
ReDim b(l) '定义数组
Get #1, , b() '读入数据
bTmp() = PackStream(b(), ZLIB_CompressionLevel_Default) '压缩
Put #2, , bTmp() '写入文件
Close #2
Close #1
End Sub
Private Sub Command2_Click()
Dim l As Long, b() As Byte, bTmp() As Byte
Open "d:\out.dat" For Binary As #1 '打开刚才生成的文件（压缩后数据）读取数据
Open "d:\old.dat" For Binary As #2 '解压缩后生成old.dat，应该与in.dat完全相同
l = LOF(1) - 1
ReDim b(l) '定义数组
Get #1, , b() '读入数据
bTmp() = UnPackStream(b()) '解压缩
Put #2, , bTmp() '写入文件
Close #2
Close #1
End Sub
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3090
ClientLeft = 60
ClientTop = 450
ClientWidth = 7680
LinkTopic = "Form1"
ScaleHeight = 3090
ScaleWidth = 7680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command2
Caption = "解压缩"
Height = 525
Left = 2130
TabIndex = 1
Top = 300
Width = 1245
End
Begin VB.CommandButton Command1
Caption = "压缩"
Height = 525
Left = 570
TabIndex = 0
Top = 300
Width = 1245
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
Dim l As Long, b() As Byte, bTmp() As Byte
Open "d:\in.dat" For Binary As #1 '从in.dat中读取数据
Open "d:\out.dat" For Binary As #2 '压缩后生成out.dat
l = LOF(1) - 1
ReDim b(l) '定义数组
Get #1, , b() '读入数据
bTmp() = PackStream(b(), ZLIB_CompressionLevel_Default) '压缩
Put #2, , bTmp() '写入文件
Close #2
Close #1
End Sub
Private Sub Command2_Click()
Dim l As Long, b() As Byte, bTmp() As Byte
Open "d:\out.dat" For Binary As #1 '打开刚才生成的文件（压缩后数据）读取数据
Open "d:\old.dat" For Binary As #2 '解压缩后生成old.dat，应该与in.dat完全相同
l = LOF(1) - 1
ReDim b(l) '定义数组
Get #1, , b() '读入数据
bTmp() = UnPackStream(b()) '解压缩
Put #2, , bTmp() '写入文件
Close #2
Close #1
End Sub
加载更多回复（9）
