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