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
' ' ///////////////////////////////////////////////////////////// ' // 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
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!¡.