Insérer des données dans un fichier

Soyez le premier à donner votre avis sur cette source.

Snippet vu 8 079 fois - Téléchargée 7 fois


Contenu du snippet

Private Function InsertBytes(ByVal sFileName As String, ByRef baData() As Byte, ByVal lCursor As Long, Optional ByVal iPacketSize As Integer = 512) As Boolean
'sFileName      -> chemin du fichier
'baData         -> tableau à insérer, doit impérativement être dimensionné
'lCursor        -> position d'insertion. on considère l'insertion "avant" le caractère, donc en tout début pour "1", AVANT le dernier caractère pour filelen
'iPacketSize    -> taille du tampon à utiliser. pas de vérification, doit évidemment être positif
'retourne l'état de réussite
    Dim iNumFile As Integer            'numéro fichier
    Dim lFileLength As Long            'taille du fichier
    Dim baBuffer() As Byte             'tableau tampon
    Dim lBufferLength As Long          'taille du tampon courant
    Dim lPosStart As Long              'position début courante
    Dim lPosEnd As Long                'position début courante
    iNumFile = FreeFile
    On Local Error Resume Next
    Open sFileName For Binary Access Read Write As #iNumFile
    If Err.Number Then
        Err.Clear
    Else
        lFileLength = LOF(iNumFile)
        If (lCursor > lFileLength) Then
            lCursor = lFileLength + 1
        ElseIf (lCursor <= 0) Then
            lCursor = 1
        End If
        If lFileLength = 0 Then
'                               fichier vide, pratique
            Put #iNumFile, , baData
        Else
'                               agrandissement du fichier avec les data finales ; utilisées comme tampon
            lPosStart = lFileLength + 1
            Seek #iNumFile, lPosStart
            Put #iNumFile, , baData
'                               dépassement fin de fichier = terminé
            If lCursor <= lFileLength Then
'                                          décalage des données de la fin jusqu'au point d'insertion
                lPosEnd = lPosStart + UBound(baData) + LBound(baData) + 1
                Do While Not lPosStart = lCursor
                    lBufferLength = iPacketSize
                    If lPosStart - lBufferLength < lCursor Then lBufferLength = lPosStart - lCursor
                    lPosStart = lPosStart - lBufferLength
                    lPosEnd = lPosEnd - lBufferLength
                    ReDim baBuffer(0 To lBufferLength - 1)
                    Seek #iNumFile, lPosStart
                    Get #iNumFile, , baBuffer
                    Seek #iNumFile, lPosEnd
                    Put #iNumFile, , baBuffer
                Loop
'                                          décalage OK, on peut insérer
                Seek #iNumFile, lCursor
                Put #iNumFile, , baData
                Erase baBuffer
            End If
        End If
        Close #iNumFile
        InsertBytes = True
    End If
End Function
Private Function InsertString(ByVal sFileName As String, ByRef sData As String, ByVal lCursor As Long) As Boolean
    If LenB(sData) > 0 Then InsertString = InsertBytes(sFileName, StrConv(sData, vbFromUnicode), lCursor)
End Function

Compatibilité : VB6, VBA

A voir également

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.