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