Fusion bit - permet de coller des fichier bout à bout

Télécharger le projet
Commenter

Description

Voilà un programme qui permet de coller des fichiers bout à bout .

Je parrie qu'il en existe pleins , cependant je vous propose ici , une methode qui gére les grosses tailles de fichiers , et qui est performante ...

J'éspére que ce code servira , et sur ce bonne prog à tous .

(source de 8 Ko)

Source / Exemple : 


' Pour le projet , voir zip , sinon pour que vous mettiez ce module dans vos programmes 
' il vous faut copier seulement la Fonction Fusion et TailleFic
' Quand à la fonction TailleFic , elle à été codée par : SoulManTo 
' voir ci-dessous pour amples explications
Public Sub fusion(FichierExecutable As String, FichierXla As String, FichierNouveau As String)
On Error GoTo Trap
Dim ExeBuffer As String
Dim XlaBuffer As String
Dim PF1 As Long
Dim PF2 As Long
' Lecture avec Buffer des Fichiers
PF1 = FreeFile()
PF2 = FreeFile()
Open FichierExecutable For Binary Access Read As #PF1
ExeBuffer = Space(LOF(PF1))
Get #PF1, 1, ExeBuffer
Close #PF1
Open FichierXla For Binary Access Read As #PF2
XlaBuffer = Space(LOF(PF2))
Get #PF2, 1, XlaBuffer
Close #PF2
' Ecriture dans un nouveau fichier , ou écraser l'ancien
Open FichierNouveau For Output As #1
Print #1, ExeBuffer & XlaBuffer
Close #1
' Lecture des tailles de fichiers
Dim Taille1 As String
Dim Taille2 As String
Dim Taille3 As String
Taille1 = TailleFic(FichierExecutable)
Taille2 = TailleFic(FichierXla)
Taille3 = TailleFic(FichierNouveau)
MsgBox "Infos sur les fichiers Fusionés :" & vbCrLf & vbCrLf & "Fichier Executable : " & Taille1 & vbCrLf & "Fichier XLA : " & Taille2 & vbCrLf & "Fichier Nouveau : " & Taille3, vbInformation + vbOKOnly, "FUSION..."
' Effacement des Temps
PF1 = FreeFile()
PF2 = FreeFile()
ExeBuffer = Empty
XlaBuffer = Empty
MsgBox "Fusion Réussie !", vbInformation + vbOKOnly, "Ok..."
Exit Sub
Trap:
MsgBox "Erreur : " & vbCrLf & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Erreur " & Err.Number
Err.Clear
Exit Sub
End Sub

Public Function TailleFic(chemin As String) As String
Dim valeur As Variant
Dim unit As String
valeur = FileLen(chemin)
If valeur < 1000 Then
    unit = "octets"
ElseIf valeur / 1024 < 1000 Then
    unit = "Ko"
    valeur = Left(valeur / 1024, 4)
ElseIf valeur / 1024 ^ 2 < 1000 Then
    unit = "Mo"
    valeur = Left(valeur / 1024 ^ 2, 5)
ElseIf valeur / 1024 ^ 3 < 1000 Then
    unit = "Go"
    valeur = Left(valeur / 1024 ^ 3, 4)
End If
TailleFic = valeur & " " & unit
End Function

Private Sub Command1_Click(Index As Integer)
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> Empty Then _
Text1(Index).Text = CommonDialog1.FileName
End Sub

Private Sub Command2_Click()
fusion Text1(0).Text, Text1(1).Text, Text1(2).Text
End Sub

Conclusion :


Fonction TailleFic :

Fonction copiée sur Vbfrance.Com
http://www.vbfrance.com/article.asp?Val=3362
codé par SoulManTo !
Site : http://gregoo.free.fr/accueil.html
Ps : Pas mal le site d'ailleurs !
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 (akhenathon)