برنامج من صُنعى لدمج ملفات مع بعض وفكلها - مكتبة أكواد VB.NET

'أصنع Module 
'وسمها FilesStructure
'ثم ضع الكود التالي فيها
    Public Structure FileEx
        Dim FileName As String
        Dim FileDir As String
        Dim FileFolder As String
        Dim File() As Byte
    End Structure
    Public Structure Info
        Dim FilesCount As Integer
        Dim Password As String
    End Structure
    Public Structure AllFileS
        Dim Files() As FileEx
        Dim Inf As Info
    End Structure
    Public Sub CreateFile(ByVal Files As AllFileS, ByVal FilePath As String)
        Dim i As Int16 = FreeFile()
        FileOpen(i, FilePath, OpenMode.Binary, OpenAccess.ReadWrite)
        FilePut(1, Files)
        FileClose(i)
    End Sub
'ثم في أي فورم
    Private Sub br_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles br.Click
        Dim a As New SaveFileDialog
        a.Filter = "WinArb Files (*.arb)|*.arb"
        If a.ShowDialog = Windows.Forms.DialogResult.OK Then
            FileSavePath.Text = a.FileName
        End If
    End Sub

    Private Sub BrowseBtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BrowseBtn.Click
        Dim A As New OpenFileDialog
        A.Multiselect = True
        A.Filter = "All Files (*.*)|*.*"
        If A.ShowDialog = Windows.Forms.DialogResult.OK Then
            Dim St As String
            For Each St In A.FileNames
                FileList.Items.Add(St)
            Next
        End If
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If FileSavePath.Text = Nothing Then
            MsgBox("الرجاء إختيار أسم ملف", MsgBoxStyle.Critical)
        Else
            CreateArchive(FileSavePath.Text)
        End If
    End Sub
    Public Sub CreateArchive(ByVal filename As String)
        Dim Fil As New FileEx
        Dim Fils(FileList.Items.Count) As FileEx
        Dim AllFiles As New AllFileS
        Prog.Maximum = FileList.Items.Count
        Dim i As Integer
        Dim o As Integer
        For i = 1 To FileList.Items.Count
            o = i - 1
            Fil.FileName = IO.Path.GetFileName(FileList.Items.Item(o))
            Fil.FileDir = IO.Path.GetDirectoryName(FileList.Items.Item(o))
            Fil.File = My.Computer.FileSystem.ReadAllBytes(FileList.Items.Item(o))
            Fil.FileFolder = IO.Path.GetFileName(FileList.Items.Item(o))
            Fils(o) = Fil
            Prog.Value = i
        Next
        Dim Inf As New Info
        Inf.FilesCount = FileList.Items.Count
        AllFiles.Files = Fils
        AllFiles.Inf = Inf
        CreateFile(AllFiles, filename)
    End Sub
    Private Sub FileList_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles FileList.KeyDown
        If e.KeyCode = Keys.Delete Then
            FileList.Items.Remove(FileList.SelectedItem)
        End If
    End Sub

    Private Sub FileList_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles FileList.SelectedIndexChanged

    End Sub

    Private Sub GroupBox1_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GroupBox1.Enter

    End Sub

    Private Sub FileB_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles FileB.Click
        Dim a As New OpenFileDialog
        a.Filter = "WinArb Files (*.arb)|*.arb"
        If a.ShowDialog = Windows.Forms.DialogResult.OK Then
            FileToEx.Text = a.FileName
        End If
    End Sub

    Private Sub DirBr_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DirBr.Click
        Dim a As New FolderBrowserDialog
        a.Description = "Please select folder to Extract"
        If a.ShowDialog = Windows.Forms.DialogResult.OK Then
            DirToEx.Text = a.SelectedPath
        End If
    End Sub

    Private Sub Extract_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Extract.Click
        If IO.File.Exists(FileToEx.Text) = True And IO.Directory.Exists(DirToEx.Text) = True Then
            ExtractE(FileToEx.Text, DirToEx.Text)
        Else
            MsgBox("Error", MsgBoxStyle.Critical)
        End If
    End Sub
    Public Sub ExtractE(ByVal filename As String, ByVal ExDir As String)
        Dim Fil As New FileEx
        Dim AllFil As New AllFileS
        Dim FrFile As Integer = FreeFile()
        FileOpen(FrFile, filename, OpenMode.Binary)
        FileGet(FrFile, AllFil)
        FileClose(FrFile)
        Dim inf As Info = AllFil.Inf
        ExProg.Maximum = inf.FilesCount
        Dim i As Integer
        For i = 1 To AllFil.Files.Length
            On Error Resume Next
            Fil = AllFil.Files(i - 1)
            Dim D As String = ExDir & "\" & IO.Path.GetFileName(Fil.FileDir)
            IO.Directory.CreateDirectory(D)
            Dim FileNa As String = D & "\" & Fil.FileName
            My.Computer.FileSystem.WriteAllBytes(FileNa, Fil.File, False)
            ExProg.Value = i - 1
        Next
    End Sub

Please SUBSCRIBE to get new articles directly into your Email inbox!