打印本文 打印本文 关闭窗口 关闭窗口
用VB6.0自制压缩与解压缩程序(一)
作者:武汉SEO闵涛  文章来源:敏韬网  点击数4683  更新时间:2009/4/23 15:43:21  文章录入:mintao  责任编辑:mintao
 

Private Sub cmdOK_Click(Index As Integer)

  Dim FileNum As Long

  Dim i As Long

  Dim j As Long

  Dim FileName As String

 

  Select Case Index

    Case 0

        FileName = App.Path & "\更新.ini"

        ''''查找包文件信息

        s_FileNames = GetFiles(App.Path & "\*.cab_")

        If UBound(s_FileNames) = 0 Then

            MsgBox "当前目录下没找到“商务频道系统文件更新”包文件!", , App.EXEName

            Exit Sub

        End If

       

        If UBound(s_FileNames) > 1 Then

            With comdInfo

                .Filter = "商务频道系统文件更新包|*.cab_|"

                .DialogTitle = "请指定“商务频道系统文件更新”包的位置"

                .InitDir = App.Path

                .Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly

                .FileName = App.Path & "\" & s_FileNames(1)

                On Error GoTo Errfind

                .ShowOpen

               

                cab_FileName = Trim(Right(.FileName, Len(.FileName) - Len(App.Path & "\")))

                On Error GoTo 0

            End With

        Else

            cab_FileName = s_FileNames(1)

        End If

       

        Screen.MousePointer = 11

        PGBar.Visible = False

        lblInfo(1).Visible = True

        DoEvents

       

        ''''将当前包复制到系统安装文件夹下

        If FileExists(WindowsPath & cab_FileName) Then Kill WindowsPath & cab_FileName

        FileCopy App.Path & "\" & cab_FileName, WindowsPath & cab_FileName

        ''''转换包路径信息(为系统安装目录下的文件)

        cab_FileName = WindowsPath & cab_FileName

        SetAttr cab_FileName, vbNormal

       

        ''''获得“更新.ini”文件

        j = ExtractFileFromCab(cab_FileName, "@更新.ini", FileName, 1, App.Path & "\")

        SetAttr FileName, vbNormal

       

        lblInfo(1).Visible = False

        PGBar.Visible = True

        Screen.MousePointer = 1

        DoEvents

       

        If j = 0 Then

            MsgBox "该压缩包信息不完整,或不是“商务频道系统文件更新”包!" & vbCrLf & vbCrLf & "解压没完成,请索取最新的更新包!", , App.EXEName

            ''''删除系统安装目录下的复制包

            Kill cab_FileName

            Exit Sub

        Else

            SetAttr FileName, vbNormal

        End If

       

        Screen.MousePointer = 11

        ''''解压信息

        FileNum = CLng(CLng(ReadIniFile(FileName, "文件数目", "FileNum")))

        ReDim s_FileNames(FileNum)

        ReDim d_FileNames(FileNum)

        ''''其中s_FileNames的最后一个数据为播放信息文件

        For i = 1 To FileNum

            s_FileNames(i - 1) = ReadIniFile(FileName, "源文件信息", "File" & i)

            s_FileNames(i - 1) = GetFileName(s_FileNames(i - 1))

上一页  [1] [2] [3] [4] [5] [6]  下一页

打印本文 打印本文 关闭窗口 关闭窗口