转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> VB.NET程序 >> 正文
用VB6.0自制压缩与解压缩程序(一)         ★★★★

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

作者:闵涛 文章来源:闵涛的学习笔记 点击数:3690 更新时间:2009/4/23 15:43:21
 

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]  下一页


没有相关教程
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台