用VB6.0自制压缩与解压缩程序(一)

当我们编写程序时,会常常遇到程序信息内容更新的问题,对于小的文件更新,可以提供给客户自己到网络上下载,但对于大且多的文件,由于网络的原因,通过下载却又不实际,动辄是更新不完整,影响了程序的运行。当时我编写“商务娱乐频道系统”时,也遇到了这样的问题,对于大型的视频及图片文件,我考虑到了使用压缩包提供给客户,但是通过使用压缩程序却不能将我的文件按要求进行解压到其他相应的目录,那时我想到了何不自己制作压缩与解压缩程序呢。解压时将文件解压到程序所要的位置。

为了这个项目,我仔细的研究了 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=

Published At
Categories with Web编程
Tagged with
comments powered by Disqus