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
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.