⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.vb

📁 自己编的zip压缩工具。以供大家参考
💻 VB
📖 第 1 页 / 共 2 页
字号:

Imports System.IO
Imports System.IO.Packaging


Public Class frmMain


    '*** First - Add a reference to the WindowsBase.dll
    '
    '  Project Menu | Add Reference...
    '
    '    On the .Net tab, look for System.IO.Packing
    '
    '      I was not able to find it on the .Net tab, so I searched my c: for "WindowsBase.dll",
    '      and found it in the following location:
    '
    '        C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0\WindowsBase.dll



#Region " Declarations"

    Private mCurrentZip As String = String.Empty

#End Region    'Declarations


    'This sub demonstrates adding files to a zip
    Private Function AddFileToZip(ByVal filePath As String, _
                             Optional ByVal uri As String = "") As ArchiveFile

        'ArchiveFile is a custom class that stores the File Name, Type, Modified, Uri,
        '  and gets the correct system icon.
        Dim archFile As New ArchiveFile(filePath)

        'Open the zip file if it exists, else create a new one
        Dim zip As Package = ZipPackage.Open(mCurrentZip, IO.FileMode.OpenOrCreate, IO.FileAccess.ReadWrite)

        'If no Uri was provided, then create one from the existing file path
        '   An optional route would be to just use the file name as the Uri, but then
        '   it will extract to the root directory. 
        If uri <> "" Then
            'Change all backward slashes to forward slashes
            uri = uri.Replace("\", "/")
        Else
            'Uri was not provided, so use the name of the file:
            uri = String.Concat("/", IO.Path.GetFileName(filePath))

            'Spaces cannot appear in the file name, so replace them with underscores.
            uri = uri.Replace(" ", "_")
        End If

        Dim partUri As New Uri(uri, UriKind.Relative)
        Dim contentType As String = Net.Mime.MediaTypeNames.Application.Zip   'constant: "application/zip"

        'The PackagePart contains the information:
        '   Where to extract the file when it's extracted (partUri)
        '   The type of content stream (MIME type) - (contentType)
        '   The type of compression to use (CompressionOption.Normal)
        Dim pkgPart As PackagePart = _
            zip.CreatePart(partUri, contentType, CompressionOption.Normal)

        'Read all of the bytes from the file to add to the zip file
        Dim bites As Byte() = File.ReadAllBytes(filePath)

        'Compress and write the bytes to the zip file
        pkgPart.Package.PackageProperties.Modified = archFile.Modified
        pkgPart.GetStream().Write(bites, 0, bites.Length)

        'store the Uri in the Custom ArchiveFile
        archFile.Uri = uri

        zip.Close()  'Close the zip file

        Return archFile

    End Function


    'This sub demonstrates retrieving the contents of a zip file
    Private Sub LoadArchive(ByVal path As String)

        'Clear ListView
        Me.ListView1.Items.Clear()

        mCurrentZip = path

        'Open the zip file
        Dim zip As Package = ZipPackage.Open(mCurrentZip, IO.FileMode.OpenOrCreate, IO.FileAccess.ReadWrite)

        For Each pkgPart As PackagePart In zip.GetParts()

            'Gets the complete path without the leading "/"
            Dim fileName As String = pkgPart.Uri.OriginalString.Substring(1)

            'The psmdcp is a file containing meta-data for the package properties
            '  The _rels file contains the package relationships
            '  skip both of them.
            If IO.Path.GetExtension(fileName) = ".psmdcp" OrElse _
                fileName.IndexOf("_rels") > -1 Then _
                    Continue For

            Dim archFile As New ArchiveFile(fileName)

            Dim item As New ListViewItem(fileName)

            'Get Icon and add to image list
            Dim ico As System.Drawing.Icon = Shell32.GetIcon(fileName)

            'Add the image to the list if it's not already in it
            If Me.imgLstFiles.Images.ContainsKey(archFile.Type) = False Then _
                Me.imgLstFiles.Images.Add(archFile.Type, ico)

            'Set the image key and store the Uri in the Tag
            item.ImageKey = archFile.Type
            item.Tag = pkgPart.Uri.ToString()  'Store Uri in ListView Tag

            'Add the Type and Modified date
            With item.SubItems
                .Add(archFile.Type)
                .Add(pkgPart.Package.PackageProperties.Modified.ToString())
            End With

            'Add the ListViewItem to the ListView
            Me.ListView1.Items.Add(item)

        Next

        zip.Close()

        EnableControls(True)

    End Sub


#Region " Infrastructure"

#Region " Events"

#Region " Form Events"

    Private Sub Form1_Load(ByVal sender As System.Object, _
                           ByVal e As System.EventArgs) Handles MyBase.Load

        'Show Eula
        Dim frm As New frmEula()
        frm.ShowDialog()

        frm.Dispose()

        SetImages()

    End Sub

#End Region    'Form Events


#Region " Control Events"


#Region " MenuStrip"

    Private Sub mnuFileNew_Click(ByVal sender As System.Object, _
                                 ByVal e As System.EventArgs) Handles mnuFileNew.Click

        NewArchive()

    End Sub


    Private Sub mnuFileOpen_Click(ByVal sender As System.Object, _
                                  ByVal e As System.EventArgs) Handles mnuFileOpen.Click

        OpenArchive()

    End Sub


    Private Sub mnuFileFavorites_Click(ByVal sender As System.Object, _
                                       ByVal e As System.EventArgs) Handles mnuFileFavorites.Click

        Favorites()

    End Sub


    Private Sub mnuFileClose_Click(ByVal sender As System.Object, _
                                   ByVal e As System.EventArgs) Handles mnuFileClose.Click

        mCurrentZip = String.Empty
        Me.ListView1.Items.Clear()

        EnableControls(False)

    End Sub


    Private Sub mnuFileExit_Click(ByVal sender As System.Object, _
                                  ByVal e As System.EventArgs) Handles mnuFileExit.Click

        Application.Exit()

    End Sub


    Private Sub mnuActionsAdd_Click(ByVal sender As System.Object, _
                                    ByVal e As System.EventArgs) Handles mnuActionsAdd.Click

        AddFileToArchive()

    End Sub


    Private Sub mnuActionsDelete_Click(ByVal sender As System.Object, _
                                       ByVal e As System.EventArgs) Handles mnuActionsDelete.Click

        DeleteFileFromArchive()

    End Sub


    Private Sub mnuActionsExtract_Click(ByVal sender As System.Object, _
                                        ByVal e As System.EventArgs) Handles mnuActionsExtract.Click

        ExtractArchive()

    End Sub


    Private Sub mnuHelpAbout_Click(ByVal sender As System.Object, _
                                   ByVal e As System.EventArgs) Handles mnuHelpAbout.Click

        Dim frm As New frmAbout()
        frm.ShowDialog()

        frm.Dispose()

    End Sub

#End Region    'MenuStrip


#Region " ToolStrip"

    Private Sub FileToolStripMenuItem_DropDownOpening(ByVal sender As System.Object, _
                                                  ByVal e As System.EventArgs) Handles FileToolStripMenuItem.DropDownOpening

        'If no zip archive is open, then disable the close menu item,
        '  else, enable it
        Me.mnuFileClose.Enabled = _
            Not (Me.mCurrentZip = String.Empty AndAlso Me.ListView1.Items.Count = 0)

    End Sub


    Private Sub btnNew_Click(ByVal sender As System.Object, _
                         ByVal e As System.EventArgs) Handles btnNew.Click

        NewArchive()

    End Sub


    Private Sub btnOpen_Click(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) Handles btnOpen.Click

        OpenArchive()

    End Sub


    Private Sub btnFavorites_Click(ByVal sender As System.Object, _
                                   ByVal e As System.EventArgs) Handles btnFavorites.Click

        Favorites()

    End Sub


    Private Sub btnAdd_Click(ByVal sender As System.Object, _
                             ByVal e As System.EventArgs) Handles btnAdd.Click

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -