当我们编写程序时,会常常遇到程序信息内容更新的问题,对于小的文件更新,可以提供给客户自己到网络上下载,但对于大且多的文件,由于网络的原因,通过下载却又不实际,动辄是更新不完整,影响了程序的运行。当时我编写“商务娱乐频道系统”时,也遇到了这样的问题,对于大型的视频及图片文件,我考虑到了使用压缩包提供给客户,但是通过使用压缩程序却不能将我的文件按要求进行解压到其他相应的目录,那时我想到了何不自己制作压缩与解压缩程序呢。解压时将文件解压到程序所要的位置。
为了这个项目,我仔细的研究了 VB 的安装程序,原来 VB 是通过系统所自带的资源来进行压缩与解压缩,如 MakeCab.exe 、 vb6stkit.dll 等。
其实真真做起来还是挺简单的,就是调用几个 API 函数便可以搞定。近日,闲着有空,翻看自己的旧程序,故决定将该程序整理出来,与大家共享。
下面是具体的程序编写模块,首先你需要建立一个工程(名称由你自己确定了):
1. 添加两个模块,在这里我给它们分别命名为 modAPI 、 modMain ;
2. 添加三个窗体,在这里我给它们分别命名为 frmMain 、 frmLogin 、 frmAddInfo ;
3. 以下是各个模块的源代码内容,请先保存该工程,并且关闭,然后转到该工程的文件夹下,按下面的提示进行源代码拷贝;
用记事本打开 ** frmMain.frm ** 文件, copy 以下内容到其中 :
VERSION 5.00
Object = "{831FDD16 -0C 5C -11D2-A9FC -0000F 8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F 9043C 88-F 6F 2 -101A -A 3C 9-08002B 2F 49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = " 信息文件更新 "
ClientHeight = 5385
ClientLeft = 45
ClientTop = 330
ClientWidth = 8550
ControlBox = 0 'False
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5385
ScaleWidth = 8550
StartUpPosition = 2 ' 屏幕中心
Begin VB.CommandButton cmdOk
Caption = " 导出更新列表 "
Height = 375
Index = 3
Left = 5385
TabIndex = 6
Top = 4980
Width = 1545
End
Begin VB.CommandButton cmdOk
Caption = " 关 闭 "
Height = 375
Index = 2
Left = 7620
TabIndex = 5
Top = 4980
Width = 885
End
Begin VB.CommandButton cmdOk
Caption = " 打 包 "
Height = 375
Index = 1
Left = 3810
TabIndex = 1
Top = 4980
Width = 885
End
Begin VB.CommandButton cmdOk
Caption = " 展 开 "
Height = 375
Index = 0
Left = 0
TabIndex = 0
Top = 4980
Width = 885
End
Begin MSComctlLib.ListView lstInfo
Height = 4275
Left = 0
TabIndex = 2
Top = 330
Width = 8505
_ExtentX = 15002
_ExtentY = 7541
View = 3
Arrange = 1
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 3
BeginProperty ColumnHeader(1) {BDD 1F 052-858B-11D1-B 16A -00C 0F 0283628}
Text = " 序号 "
Object.Width = 1235
EndProperty
BeginProperty ColumnHeader(2) {BDD 1F 052-858B-11D1-B 16A -00C 0F 0283628}
SubItemIndex = 1
Text = " 压缩包文件 "
Object.Width = 6068
EndProperty
BeginProperty ColumnHeader(3) {BDD 1F 052-858B-11D1-B 16A -00C 0F 0283628}
SubItemIndex = 2
Text = " 目标信息 "
Object.Width = 7832
EndProperty
End
Begin MSComDlg.CommonDialog comdInfo
Left = 0
Top = 360
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
MaxFileSize = 30000
End
Begin MSComctlLib.ProgressBar PGBar
Height = 345
Left = 30
TabIndex = 4
Top = 4620
Width = 8505
_ExtentX = 15002
_ExtentY = 609
_Version = 393216
Appearance = 0
Scrolling = 1
End
Begin VB.Label lblAbout
BackStyle = 0 'Transparent
Caption = " 关于本程序 ..."
Height = 255
Left = 7260
TabIndex = 8
Top = 60
Width = 1215
End
Begin VB.Label lblInfo
AutoSize = -1 'True
Caption = " 请等待,正在创建包信息文件 ..."
Height = 180
Index = 1
Left = 30
TabIndex = 7
Top = 4740
Width = 4980
End
Begin VB.Label lblInfo
AutoSize = -1 'True
Caption = " 展开打包信息更新列表: "
Height = 180
Index = 0
Left = 30
TabIndex = 3
Top = 30
Width = 1980
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ==============================================
' 信息打包与展开 ( 主窗体模块,即展开窗体 )
'
' 功能 : 利用系统所存在的资源自作压缩与解压缩程序
'
' 作 者 : 谢家峰
' 整理日期 : 2004-08-08
' Email :[email protected]
'
' ==============================================
'
Option Explicit
Private Declare Function ExtractFileFromCab Lib "vb6stkit.dll" _
(ByVal Cab As String, ByVal File As String, ByVal dest As String, _
ByVal iCab As Long, ByVal sSrc As String) As Long
' 说明:
'cab 为系统安装目录下的压缩包
'file 为压缩包内的某文件名称(需在该文件名前加“ @ ”字符)
'dest 为压缩包内的某文件解压后的完全路径名
'icab 为压缩包的数目
'ssrc 临时文件夹,一个有效的文件夹路径
Dim s_FileNames() As String ' 源文件名(不含路径)
Dim d_FileNames() As String ' 目标文件名(含路径)
Dim cab_FileName As String<SPAN style=