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

                 ".Set CompressionMemory = 21" & vbCrLf & _

                 ".Set CabinetNameTemplate =" & Chr(34) & Trim(txtEditInfo(3)) & ".CAB_" & Chr(34) & vbCrLf & _

                 ".Set Cabinet=on" & vbCrLf & _

                 ".Set Compress=on" & vbCrLf

            For i = 1 To lstInfo.ListItems.count

                str1 = str1 & Chr(34) & lstInfo.ListItems(i).SubItems(1) & Chr(34) & vbCrLf

            Next

           

            str1 = str1 & Chr(34) & FileName & Chr(34)                              ''''追加展开列表信息到包中

            WriteTextFileContents str1, App.Path & "\商务.DDF"

           

            ''''启动打包程序

            resultat = CreateProcess(vbNullString, WindowsSysPath & "\makecab.exe /f 商务.DDF", secu, secu, _

                        0, 0, 0, App.Path, startinfo, procinfo)

            resultat2 = WaitForSingleObject(procinfo.hProcess, INFINITE)

            resultat2 = CloseHandle(procinfo.hProcess)

             ''''

            DoEvents

            ''''删除不必要的信息

            If FileExists(App.Path & "\商务.DDF") Then Kill App.Path & "\商务.DDF"

            If FileExists(App.Path & "\更新.ini") Then Kill App.Path & "\更新.ini"

            If FileExists(App.Path & "\setup.inf") Then Kill App.Path & "\setup.inf"

            If FileExists(App.Path & "\setup.rpt") Then Kill App.Path & "\setup.rpt"

            DoEvents

           

            MsgBox "压缩包已生成!返回主窗体通过“展开”按钮将相应的信息文件展开到相应的目录中!" & vbCrLf & _

                    "文件列表已被导出在“" & FileName & "”中,若要编辑当前的信息,请在打包窗体中提取该信息文件!", , App.EXEName

            Screen.MousePointer = 1

            Unload Me

           

        Case 1    ''''导出包列表

            With frmMain.comdInfo

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

                        

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

                .InitDir = CurDir()

                .Flags = cdlOFNHideReadOnly

                        

                .FileName = txtEditInfo(3) & ".TLB"

                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

                        Writ

上一页  [1] [2] [3] [4] [5] [6] [7] [8] [9] [10]  ...  下一页 >> 

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