Coupeur de fichiers

Télécharger le projet
Commenter

Description

Cette sources permet de couper des fichiers, et créer un .bat permettant de la reconstruire.
Cette source est pour les débutants.

Source / Exemple : 


Option Explicit
Private file_open, dir_out As String
Private ascii() As Variant

Private Sub CommandButton1_Click()
Dim o As MSComDlg.CommonDialog
Dim tmq, tmp As String
Dim i As Long
    'initialisation de l'objet
    Set o = Me.Controls.Add("MSComDlg.CommonDialog", "Essai")
    o.InitDir = App.Path
    o.Filter = "*|*.*"
    'Methode de l'objet
    o.ShowOpen
    file_open = o.FileName
    'ouvrir et reup si erreur le fichier exel
    'permet d'afficher une fenetre de sauvegarde
    'O.ShowSave
    'Debug.Print "SAUVE :"; O.FileName
    'Propiete
    'tmp = O.FileName
    Text1.Text = file_open
    Me.Controls.Remove ("Essai")
    Set o = Nothing
    
End Sub

Private Sub CommandButton2_Click()
Dim F As Object
Dim fs As Object
Dim fol As String
Dim i, j As Integer
'le $ sert a dire que string = dim a as string
Dim flagchoix&, msg$, racine&

'flagchoix = &H1&: msg = "Choissisez un dossier :"
'Set fs = CreateObject("Shell.Application")
'Set f = fs.BrowseForFolder(&H0&, msg, flagchoix)
'If Not f Is Nothing Then
'    If InStr(1, f.ParentFolder.parsename(f.Title).Path, ":", vbTextCompare) <> 0 Then
'    dir_out = f.ParentFolder.parsename(f.Title).Path
'    Text2 = dir_out
'    Else
'    MsgBox "Veuillez sélectionner un répertoire valide"
'    End If
'End If
flagchoix = &H1&: msg = "Select a folder :"
Set fs = CreateObject("Shell.Application")
Set F = fs.BrowseForFolder(&H0&, msg, flagchoix)
If Not F Is Nothing Then
    dir_out = F.self.Path
    Text2 = dir_out
Else
    MsgBox "Veuillez sélectionner un répertoire valide"
End If

End Sub

Private Sub Form_Load()
    Text3 = "1,44"
    file_open = ""
    dir_out = ""
    Call import_table_ascii
    'Text1 = "01-sweet and tangy.mp3"
    file_open = Text1
    'Text2 = "C:\Temp\Nouveau dossier"
    dir_out = Text2
End Sub

'Private Sub CommandButton5_Click()
'Dim taille_partie As Single, taille_fichier_o As Single, nb As Single, nb_partie As Single, tmp As Single
'Dim i As Long
'Dim fRandom As Random, fWriteRandom As Random
'Dim f
'Dim tp As FileSystemObject
'Dim temp As String
'If Text3.Text <> "" And IsNumeric(Text3.Text) And file_open <> "" And dir_out <> "" Then
'    taille_partie = CSng(Text3.Text) * 1024
'    Set tp = CreateObject("Scripting.FileSystemObject")
'    temp = Mid(tp.GetFileName(file_open), 1, Len(tp.GetFileName(file_open)) - 3)
'    Set f = tp.GetFile(file_open)
'    taille_fichier_o = f.Size
'    Set f = Nothing
'    Set tp = Nothing
'    'file random
'    Set fRandom = New Random
'    Set fWriteRandom = New Random
'    fRandom.OpenFile file_open
'    fRandom.SeekAbsolute 0, 1     ' Seeks 2 bytes (0*2^32 + 2) = 1 character.
''    f.SeekRelative -2       ' Seeks backward 1 character.
'    nb_partie = taille_fichier_o / taille_partie
'    nb = 0
'    tmp = 0
'    fWriteRandom.OpenFile dir_out & "\" & file_open & "." & nb
'    While nb <> taille_fichier_o - 1
'        temp = fRandom.ReadBytes(1)
'        If taille_fichier_o Mod taille_partie And nb <> 0 Then
'            tmp = tmp + 1
'            fWriteRandom.CloseFile
'            fWriteRandom.SeekAbsolute 0, 8
'            fWriteRandom.SeekAbsolute 0, 8
'        End If
'        fWriteRandom.WriteBytes temp
'        nb = nb + taille_fichier_o
'    Wend
'End If
'End Sub
Private Sub CommandButton5_Click()
Dim taille_partie, taille_fichier_o, nb As Long
Dim tp As FileSystemObject
Dim F
Dim j, k, L As Integer
Dim Temp, new_file, ext_name, txt As String
Dim Data As Variant
Dim datawrite() As Byte
Dim fRandom As Random, fWriteRandom As Random
On Error GoTo error

If Text3.Text <> "" And IsNumeric(Text3.Text) And file_open <> "" And dir_out <> "" Then
    'test si il n'ya que 2 decimale
    If Round(CDbl(Text3.Text), 2) = CDbl(Text3.Text) Then
        taille_partie = CSng(Text3.Text) * 1024 * 1024
        Set tp = CreateObject("Scripting.FileSystemObject")
        Temp = Mid(tp.GetFileName(file_open), 1, Len(tp.GetFileName(file_open)) - 3)
        ext_name = tp.GetExtensionName(file_open)
        Set F = tp.GetFile(file_open)
        taille_fichier_o = F.Size
        If taille_fichier_o > taille_partie Then
            j = Fix(taille_fichier_o / taille_partie) 'donne le nombre de partie entière
            'couper le fichier
            new_file = dir_out & "\" & Temp
            k = 0
            Set fRandom = New Random
            Set fWriteRandom = New Random
            'fRandom.CloseFile
            fRandom.OpenFile (F.Path)
            While k <> j
'                If k * taille_partie < 2147483647 Then
'                    fRandom.SeekAbsolute k * taille_partie, (k + 1) * taille_partie
'                Else
'                    fRandom.SeekAbsolute -2147483647 - k * taille_partie - 2147483647, (k + 1) * taille_partie
'                End If
                Data = fRandom.ReadBytes(taille_partie)
                fWriteRandom.OpenFile new_file & k
                datawrite = Data
                fWriteRandom.WriteBytes datawrite()
                fWriteRandom.CloseFile
                k = k + 1
            Wend
'            If k * taille_partie < 2147483647 Then
'                fRandom.SeekAbsolute k * taille_partie, (k + 1) * taille_partie
'            Else
'                fRandom.SeekAbsolute -2147483647 - k * taille_partie - 2147483647, (k + 1) * taille_partie
'            End If
            If k * taille_partie <> taille_fichier_o Then
'            fRandom.SeekAbsolute k * taille_partie, taille_fichier_o
            Data = fRandom.ReadBytes(taille_fichier_o - k * taille_partie)
            fWriteRandom.OpenFile new_file & k
            datawrite = Data
            fWriteRandom.WriteBytes datawrite()
            fWriteRandom.CloseFile
            End If
'            Open file_open For Binary Access Read As #1
'            Do While Not EOF(1)
'                If taille_fichier_mo <> taille_partie * j And k = j Then
'                    Data = ""
'                    Data = String(f.Size - j * Fix(taille_partie * 1024 * 1024), " ")
'                End If
'                If k <= j Then
'                Open new_file & k For Binary Access Write As #2
'                Get #1, , Data
'                Put #2, , Data
'                Close #2
'                k = k + 1
'                Else
'                GoTo 1:
'                End If
'            Loop
'1:
'            Close #1
            'cration du .bat copy all partie to ancien nom fichier
            Open new_file & "bat" For Output As #1
            'Print #1, "Echo off"
            txt = ""
            For L = 0 To k
                txt = txt & " + """ & Temp & L & """"
            Next L
            txt = txt & " """ & Temp & ext_name & """"
            'Print #1, "Copy /b " & Mid(txt, 4, Len(txt) - 3)
            'Print #1, "Echo ""Fichier reconstitue"""
            'Print #1, "pause"
            txt = "Echo off" & Chr(10) & _
                  "Copy /b " & Mid(txt, 4, Len(txt) - 3) & Chr(10) & _
                  "Echo ""Fichier reconstitué""" & Chr(10) & _
                  "pause"
                Call replace_str(txt)
                Print #1, txt
            Close #1
            If taille_fichier_o <> taille_partie * j Then
            nb = j + 1
            Else
            nb = j
            End If
            MsgBox "Travail terminé : " & nb & " Parties crées pour " & Round((taille_fichier_o / 1024) / 1024, 2) & " Mo"
            Set F = Nothing
            Set tp = Nothing
        Else
            MsgBox ("La taille des parties est inférieur ou egale a celle du fichier")
        End If
    Else
        MsgBox ("La taille en Mo ne doit contenir que 2 chiffre apres la virgule")
    End If
Else
    MsgBox "Veuillez Renseigner tous les champs. Attention : " & Chr(13) & "utiliser une virgule pour la taille (Ex : 1,44)."
End If
Set fRandom = Nothing
Set fWriteRandom = Nothing
Exit Sub
error:
MsgBox Err.Number & " " & Err.Description
Set fRandom = Nothing
Set fWriteRandom = Nothing
End Sub

'old
'Private Sub CommandButton5_Click()
'Dim taille_partie, taille_fichier_mo, nb As Double
'Dim tp As FileSystemObject
'Dim f
'Dim j, k, L As Integer
'Dim temp, new_file, ext_name, txt As String
'Dim Data As String
'
'If Text3.Text <> "" And IsNumeric(Text3.Text) And file_open <> "" And dir_out <> "" Then
'    'test si il n'ya que 2 decimale
'    If Round(CDbl(Text3.Text), 2) = CDbl(Text3.Text) Then
'
'        taille_partie = CSng(Text3.Text)
'        Set tp = CreateObject("Scripting.FileSystemObject")
'        temp = Mid(tp.GetFileName(file_open), 1, Len(tp.GetFileName(file_open)) - 3)
'        ext_name = tp.GetExtensionName(file_open)
'        Set f = tp.GetFile(file_open)
'        taille_fichier_mo = Round(CDbl(CDbl(f.Size / 1024) / 1024), 2)
'        If taille_fichier_mo > taille_partie Then
'            j = Fix(taille_fichier_mo / taille_partie) 'donne le nombre de partie entière
'            'couper le fichier
'            new_file = dir_out & "\" & temp
'            Data = String(Fix(taille_partie * 1024 * 1024), " ")
'            k = 0
'            Open file_open For Binary Access Read As #1
'            Do While Not EOF(1)
'                If taille_fichier_mo <> taille_partie * j And k = j Then
'                    Data = ""
'                    Data = String(f.Size - j * Fix(taille_partie * 1024 * 1024), " ")
'                End If
'                If k <= j Then
'                Open new_file & k For Binary Access Write As #2
'                Get #1, , Data
'                Put #2, , Data
'                Close #2
'                k = k + 1
'                Else
'                GoTo 1:
'                End If
'            Loop
'1:
'            Close #1
'            'cration du .bat copy all partie to ancien nom fichier
'            Open new_file & "bat" For Output As #1
'            'Print #1, "Echo off"
'            txt = ""
'            For L = 0 To k - 1
'                txt = txt & " + """ & temp & L & """"
'            Next L
'            txt = txt & " """ & temp & ext_name & """"
'            'Print #1, "Copy /b " & Mid(txt, 4, Len(txt) - 3)
'            'Print #1, "Echo ""Fichier reconstitue"""
'            'Print #1, "pause"
'            txt = "Echo off" & Chr(10) & _
'                  "Copy /b " & Mid(txt, 4, Len(txt) - 3) & Chr(10) & _
'                  "Echo ""Fichier reconstitué""" & Chr(10) & _
'                  "pause"
'                Call replace_str(txt)
'                Print #1, txt
'            Close #1
'            If taille_fichier_mo <> taille_partie * j Then
'            nb = j + 1
'            Else
'            nb = j
'            End If
'            MsgBox "Travail terminé : " & nb & " Parties crées pour " & taille_fichier_mo & " Mo"
'            Set f = Nothing
'            Set tp = Nothing
'        Else
'            MsgBox ("La taille des parties est inférieur ou egale a celle du fichier")
'        End If
'    Else
'        MsgBox ("La taille en Mo ne doit contenir que 2 chiffre apres la virgule")
'    End If
'Else
'    MsgBox "Veuillez Renseigner tous les champs. Attention : " & Chr(13) & "utiliser une virgule pour la taille (Ex : 1,44)."
'End If
'End Sub

Public Sub import_table_ascii()
Dim txt As String
Dim i, j As Integer
ReDim ascii(127, 1)
Open App.Path & "\table.txt" For Input As #1
i = 0
Do While Not EOF(1)
Input #1, txt
j = InStr(1, txt, Chr(9), vbTextCompare)
ascii(i, 0) = Mid(txt, 1, j - 1)
ascii(i, 1) = Mid(txt, j + 1, Len(txt) - j)
i = i + 1
Loop
Close #1
End Sub

Public Sub replace_str(ByRef txt As String)
Dim i, t As Long
For i = 1 To Len(txt)
    t = Asc(Mid(txt, i, 1))
    If t > 127 Then
        If IsNumeric(ascii(t - 128, 1)) Then
        Mid(txt, i, 1) = Chr(ascii(t - 128, 1))
        End If
    End If
Next i
End Sub

Conclusion :


Utilisation pour tous les fichiers <8Go et dans la partie commentaire pour les fichiers <2Go
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_boukake)