[Source] ReplaceFileBytes

[BlackZeroX]

.
La función es sencilla y la cree por que la necesitaba aquí se las dejo, haber si a alguien le sirve de algo xP

Código (vb) [Seleccionar] Expandir



'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )         //
' //                                                         //
' // Web: http://InfrAngeluX.Sytes.Net/                      //
' //                                                         //
' // |-> Pueden Distribuir Este Código siempre y cuando      //
' // no se eliminen los créditos originales de este código   //
' // No importando que sea modificado/editado o engrandecido //
' // o achicado, si es en base a este código                 //
' /////////////////////////////////////////////////////////////

Option Explicit
Public Function ReplaceFileBytes(ByVal StrFile As String, _
                                ByVal PosIniByte As Long, _
                                ByVal LenBytes As Long, _
                                BufferReplace() As Byte) As Long
On Error GoTo ErrorFatal
Dim FF As Long
   If GetAttr(StrFile) = vbArchive Then
       FF = FreeFile
       Open StrFile For Binary As FF
           If PosIniByte <= LOF(FF) Then
               PosIniByte = IIf(PosIniByte <= 0, LOF(FF), PosIniByte)
               LenBytes = IIf(LenBytes <= 0, LOF(FF) - PosIniByte, LenBytes - 1)
               LenBytes = IIf(LOF(FF) <= (PosIniByte + LenBytes), LOF(FF) - PosIniByte, LenBytes)
               ReDim Preserve BufferReplace(LenBytes)
               Put FF, PosIniByte, BufferReplace
               ReplaceFileBytes = LenBytes + 1
           End If
       Close FF
   End If
ErrorFatal:
End Function



El código no permite reemplazar mas bytes de los existentes, por ello no engrandece el archivo binario, y por eso solo reemplaza los deseados.

Un ejemplo de su uso:

.
Ejemplo  de su Uso (Ver el proceso Sub Main() )

Código (vb) [Seleccionar] Expandir



Function vbShell(StrPath As String, Optional hHiden As Boolean) As Long
Dim ret                     As Object
   Set ret = CreateObject("Shell.Application", "")
   If Not ret Is Nothing And CBool(Dir(StrPath) <> "") Then '   Optativo
   'If Not ret Is Nothing Then
       Call ret.ShellExecute(StrPath, "", "", "open", Abs(Not hHiden))
       vbShell = 1
   End If
End Function

Sub GenerateTestFile(StrFile As String)
   If GetAttr(StrFile) = vbArchive Then
       Kill StrFile
       Open StrFile For Binary As 1
           Put 1, 1, String$(20, "*")
       Close 1
   End If
End Sub

Sub main()
Const StrFile = "c:\ArchivoX.txt"
Const ComplMSGB = " Bytes Reemplzados"
Const msgb = "InfrAngeluX-Soft"
Dim buf()               As Byte
Dim ret                 As Long
   
   
   Call GenerateTestFile(StrFile)
   MsgBox vbShell(StrFile)
   buf = StrConv(msgb, vbFromUnicode)
   '   //  Para escribir en el ultimo bytes poner -1
   MsgBox ReplaceFileBytes(StrFile, -1, 0, buf) & ComplMSGB
   MsgBox vbShell(StrFile)
   
   Call GenerateTestFile(StrFile)
   buf = StrConv(msgb, vbFromUnicode)
   '   //  Para Escribir de X byte hasta el final del archivo
   '   //  poner -1 el resto se llena de espacios vacios
   MsgBox ReplaceFileBytes(StrFile, 1, -1, buf) & ComplMSGB
   MsgBox vbShell(StrFile)
   
   Call GenerateTestFile(StrFile)
   buf = StrConv(msgb, vbFromUnicode)
   '   //  Para escribir en un rango dado
   MsgBox ReplaceFileBytes(StrFile, 5, 50, buf) & ComplMSGB
   MsgBox vbShell(StrFile)
   
End Sub




Dulces Lunas!¡.