Accueil > > > COUPEUR DE FICHIERS
COUPEUR DE FICHIERS
Information sur la source
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
- 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
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
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Coller un fichier sur un .bat en VB.net [ par ngranier ]
BonjourVoici la problématique:J'ai besoin de convertir un fichie XML dans un format bien particulier. Pour cela je dispose du fichier en .bat qui conv
Identifier le code ASCII d'un caractère [ par PatBlarg ]
Bonjour, j'ai chargé dans blocnotes un fichier d'un ancient logiciel DOS qui permet de créer des plaquettes d'identification sur une vieille machine.
lancer fichier .bat et recuperer la sortie [ par farradjs ]
Bonjour,je travail sous vb 2008 je souhaite lancer un fichier .bat ( par shell ou autre) et récuperer le resultat dans une textbox, est ce qu'il y a u
fihier .bat et vb.net [ par moqomni ]
bonjour, lors d'excuter un fichier .bat en appelant par une application vb2003.net je remarque que la commande move qui se trouve dans le fichier .bat
Fin de processus [ par steph064 ]
Je dois exécuter mon .bat qui va me créer un .text que je vais lire juste après. Le problème c'est que lorsque je veux ouvrir ce fichier texte, visual
fichier .bat [ par mohamedmounassir ]
salut tout le monde j'ai un petit soucis dans une application vb.net 2005 et sql server2000 voila en bref j'ai un fichier .bat qui récupérer les don
creation fichier ascii [ par amel3011 ]
Bonjour à tousje voudrais creer un fichier ascii et importer des données d'une base de données access vers le fichier crée !je ne sais pas par quoi co
Ouvrir un fichier ascii sur excel [ par khev ]
Bonjour,Est-ce que quelqu'un pourrait me dire si c'est possible d'importer un fichier ascii sur excel en recuperant des longeur fixe dans des colonnes
Rechercher et remplacer texte dans un fichier. [ par MacGaliver ]
Bonjour, Est-ce que quelqu'un connait un code fiable en VB permettant de remplacer un texte dans un fichier .bat, svp ? Ex: shutdown -> stop (dans C
VB & fichiers .bat [ par doudinho06 ]
Bonjour, Je veux lancer un exe VB à partir d'un fichier .bat, le soucis c'est que l'exe VB a besoin d'un paramettre d'entrée alors que moi je veux l'e
|
Derniers Blogs
GESTION D'EXCEPTION AVEC LES TASKSGESTION D'EXCEPTION AVEC LES TASKS par richardc
Nous avons vu dans un précédent article comment utiliser Task pour effectuer des opérations dans un autre thread.
Malheureusement, comme tout le monde n'est pas parfait, il se peut que cette exécution se passe mal et qu'une exception se produise.
La...
Cliquez pour lire la suite de l'article par richardc DéMARRONS AVEC LES TASKSDéMARRONS AVEC LES TASKS par richardc
Que vous le vouliez ou non, le développement multi-tâche est maintenant une obligation pour toute nouvelle application. Il est donc vital d'en comprendre les mécanismes et de s'y mettre le plus tôt possible.
En attendant le .NET Framework 4.5 avec le...
Cliquez pour lire la suite de l'article par richardc SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPSSLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko
Retrouvez les slides et les démo de ma session Fast & Furious XAML Apps. A ceux qui se posent la question : "est-ce que le code de la DataGrid est disponible?", je vous répondrais "pas encore". Je vais mettre en place un projet codeplex pour part...
Cliquez pour lire la suite de l'article par Vko XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|