Saturday, 12 September 2015

Compress Files Folders From vb.net

Compress Files and Folders From VB.net

Paste the Following Code In the Code Window:

Imports ICSharpCode.SharpZipLib.Checksums
Imports ICSharpCode.SharpZipLib.Zip
Imports ICSharpCode.SharpZipLib.GZip
Imports System.IO
Imports System.Text



Public Class frmMain
    Private Sub btnBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowse.Click
        openFileDialog1.Title = "Add File"
        openFileDialog1.Filter = "All Files (*.*)|*.*"
        openFileDialog1.FileName = ""
        If openFileDialog1.ShowDialog() = DialogResult.Cancel Then
            Return
        End If
        Dim sFilePath As String
        sFilePath = openFileDialog1.FileName
        If sFilePath = "" Then
            Return
        End If
        If System.IO.File.Exists(sFilePath) = False Then
            Return
        Else
            txtAddFile.Text = sFilePath
        End If

    End Sub



    Private Sub btnAddFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAddFile.Click
        If txtAddFile.Text = String.Empty Then
            MessageBox.Show("Use the browse button to search for " & "the file to be added.", "Missing File Name")
            Return
        End If
        Dim i As Integer
        For i = 0 To lstFilePaths.Items.Count - 1
            If lstFilePaths.Items(i).ToString() = txtAddFile.Text.ToString() Then
                MessageBox.Show("That file has already been added to the list.", "Duplicate")
                Return
            End If

        Next
        If txtAddFile.Text <> String.Empty Then
            lstFilePaths.Items.Add(txtAddFile.Text.ToString())
        End If
        txtAddFile.Text = String.Empty
        txtAddFile.Focus()

    End Sub


    Private Sub btnRemoveFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRemoveFile.Click
        Try
            lstFilePaths.Items.Remove(lstFilePaths.SelectedItem)
        Catch ex As Exception
            MessageBox.Show(ex.Message, "Error")
        End Try

    End Sub


    Private Sub btnSaveBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSaveBrowse.Click
        txtSaveTo.Text = String.Empty
        Dim result As DialogResult
        result = folderBrowserDialog1.ShowDialog()
        If result = DialogResult.OK Then
            txtSaveTo.Text = folderBrowserDialog1.SelectedPath
        End If

    End Sub




    Private Sub btnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSave.Click
        If lstFilePaths.Items.Count < 1 Then
            MessageBox.Show("There are no files queued for the zip operation", "Empty File Set")
            Return
        End If
        If txtSaveTo.Text = String.Empty Then
            MessageBox.Show("No destination file has been defined.", "Save To Empty")
            Return
        End If
        lblUpdate.Visible = True
        lblUpdate.Refresh()
        Dim sTemp As String() = txtSaveTo.Text.Split("\")
        Dim sZipFileName As String = TextBox1.Text
        Dim fi As FileInfo = New FileInfo(txtSaveTo.Text + "\" + sZipFileName + ".zip")
        If fi.Exists Then
            Try
                Dim sb As StringBuilder = New StringBuilder()
                sb.Append("The file " + sZipFileName + " already exists. ")
                sb.Append("You may rename it in the save to text box.")
                MessageBox.Show(sb.ToString(), "Existing File Name")
                txtSaveTo.Text = String.Empty
                txtSaveTo.Focus()
                Return
            Catch ex As Exception
                MessageBox.Show(ex.Message, "File Error")
                Return
            End Try
        End If

        fi = Nothing
        If (Not System.IO.Directory.Exists(txtSaveTo.Text + "\TempZipFile\")) Then
            System.IO.Directory.CreateDirectory(txtSaveTo.Text + "\TempZipFile\")
        End If
        Dim sTargetFolderPath As String = (txtSaveTo.Text + "\TempZipFile\")
        Dim i As Integer
        For i = 0 To lstFilePaths.Items.Count - 1

            Dim filePath As String = lstFilePaths.Items(i).ToString()
            Dim fi2 As FileInfo = New FileInfo(filePath)
            If fi2.Exists Then
                Try
                    fi2.CopyTo(sTargetFolderPath + fi2.Name, True)
                Catch
                    System.IO.Directory.Delete(sTargetFolderPath)
                    MessageBox.Show("Could not copy files to temp folder.", "File Error")
                    Return
                End Try
            End If
            fi2 = Nothing
        Next
        Try
            lblUpdate.Visible = True
            lblUpdate.Refresh()

            Dim filenames As String() = Directory.GetFiles(sTargetFolderPath)
            Dim s As ZipOutputStream = New ZipOutputStream(File.Create(txtSaveTo.Text + "\" + sZipFileName + ".zip"))
            s.SetLevel(9)
            Dim buffer() As Byte
            ReDim buffer(4096)
            Dim f As String
            For Each f In filenames
                Dim entry As ZipEntry = New ZipEntry(Path.GetFileName(f))
                entry.DateTime = DateTime.Now
                s.PutNextEntry(entry)
                Dim fs As FileStream = File.OpenRead(f)
                Dim sourceBytes As Integer = 1
                Do Until (sourceBytes <= 0)
                    sourceBytes = fs.Read(buffer, 0, buffer.Length)
                    s.Write(buffer, 0, sourceBytes)
                Loop
                fs.Close()
            Next
            s.Finish()
            s.Close()
            lblUpdate.Visible = False
            MessageBox.Show("Zip file " + txtSaveTo.Text + " created.")
            lstFilePaths.Items.Clear()
            txtSaveTo.Text = String.Empty
            txtAddFile.Text = String.Empty
            TextBox2.Text = String.Empty
            System.IO.Directory.Delete(sTargetFolderPath, True)
        Catch ex As Exception
            MessageBox.Show(ex.Message.ToString(), "Zip Operation Error")
        End Try
    End Sub




    Private Sub btnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        Application.Exit()
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim MyFolderBrowser As New System.Windows.Forms.FolderBrowserDialog
        MyFolderBrowser.Description = "Please Select the Folder Containing Database Files"
        MyFolderBrowser.RootFolder = Environment.SpecialFolder.MyComputer
        Dim dlgResult As DialogResult = MyFolderBrowser.ShowDialog()
        If dlgResult = Windows.Forms.DialogResult.OK Then
            TextBox2.Text = MyFolderBrowser.SelectedPath
        End If
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim d As String
        Dim d1 As String
        Dim d2 As String
        lstFilePaths.Items.Clear()
        Dim di As New IO.DirectoryInfo(TextBox2.Text)
        Dim diar1 As IO.FileInfo() = di.GetFiles()
        Dim dra As IO.FileInfo
        For Each dra In diar1
            d = di.ToString
            d1 = dra.ToString
            d2 = d & "\" & d1
            lstFilePaths.Items.Add(d2)
        Next
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        lstFilePaths.Items.Clear()
    End Sub
End Class
 

No comments:

Post a Comment