打印本文 打印本文 关闭窗口 关闭窗口
用VB6.0自制压缩与解压缩程序(一)
作者:武汉SEO闵涛  文章来源:敏韬网  点击数4683  更新时间:2009/4/23 15:43:21  文章录入:mintao  责任编辑:mintao
            d_FileNames(i - 1) = ReadIniFile(FileName, "目标文件信息", "File" & i)

            DoEvents

        Next

       

        lstInfo.ListItems.Clear

        PGBar.Min = 1

        PGBar.Max = FileNum + 1

       

        For i = 1 To FileNum

            DoEvents

            ''''建立文件夹

            CreateFloder d_FileNames(i - 1)

            ''''解压文件

            If FileExists(d_FileNames(i - 1)) Then SetAttr d_FileNames(i - 1), vbNormal

            j = ExtractFileFromCab(cab_FileName, "@" & s_FileNames(i - 1), d_FileNames(i - 1), 1, App.Path & "\")

            If j = 0 Then

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

                lstInfo.ListItems.Clear

                PGBar.Min = 0

                PGBar.Value = 0

                Screen.MousePointer = 1

                Exit Sub

            End If

            PGBar.Value = i

            DoEvents

            lstvInfo_Add lstInfo, 3, False, lstInfo.ListItems.count + 1, s_FileNames(i - 1), d_FileNames(i - 1)

        Next

                  

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

        Kill cab_FileName

        Kill FileName

        PGBar.Value = FileNum + 1

         

        MsgBox "解压缩完成,系统更新完成,谢谢使用!", , App.EXEName

        PGBar.Min = 0

        PGBar.Value = 0

       

    Case 1    '''' 执行信息打包

        lstInfo.ListItems.Clear

        frmLogin.Show 1, Me

    Case 2

        Unload Me

    Case 3

        If lstInfo.ListItems.count = 0 Then MsgBox "无信息可供导出!", , App.EXEName: Exit Sub

        With frmMain.comdInfo

            .Filter = "更新列表信息|*.txt"

            .DialogTitle = "导出包列表信息文件"

            .InitDir = CurDir()

            .Flags = cdlOFNHideReadOnly

            .FileName = "更新列表.txt"

            On Error GoTo ErrLab

            .ShowSave

                               

            FileName = .FileName

            If FileExists(FileName) Then

                SetAttr FileName, vbNormal

                Kill FileName

            End If

            ''''导出信息

            With lstInfo

                WritePrivateProfileString "文件数目", "FileNum", CStr(.ListItems.count), FileName

                For i = 1 To .ListItems.count

                    WritePrivateProfileString "压缩包文件信息", "File" & i, .ListItems(i).SubItems(1), FileName

                    WritePrivateProfileString "目标文件信息", "File" & i, .ListItems(i).SubItems(2), FileName

                Next

    &n

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

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