elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Guía actualizada para evitar que un ransomware ataque tu empresa


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Source] ReplaceFileBytes
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Source] ReplaceFileBytes  (Leído 898 veces)
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
[Source] ReplaceFileBytes
« en: 13 Enero 2010, 00:21 am »

.
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
  1.  
  2. '
  3. ' /////////////////////////////////////////////////////////////
  4. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )         //
  5. ' //                                                         //
  6. ' // Web: http://InfrAngeluX.Sytes.Net/                      //
  7. ' //                                                         //
  8. ' // |-> Pueden Distribuir Este Código siempre y cuando      //
  9. ' // no se eliminen los créditos originales de este código   //
  10. ' // No importando que sea modificado/editado o engrandecido //
  11. ' // o achicado, si es en base a este código                 //
  12. ' /////////////////////////////////////////////////////////////
  13.  
  14. Option Explicit
  15. Public Function ReplaceFileBytes(ByVal StrFile As String, _
  16.                                 ByVal PosIniByte As Long, _
  17.                                 ByVal LenBytes As Long, _
  18.                                 BufferReplace() As Byte) As Long
  19. On Error GoTo ErrorFatal
  20. Dim FF As Long
  21.    If GetAttr(StrFile) = vbArchive Then
  22.        FF = FreeFile
  23.        Open StrFile For Binary As FF
  24.            If PosIniByte <= LOF(FF) Then
  25.                PosIniByte = IIf(PosIniByte <= 0, LOF(FF), PosIniByte)
  26.                LenBytes = IIf(LenBytes <= 0, LOF(FF) - PosIniByte, LenBytes - 1)
  27.                LenBytes = IIf(LOF(FF) <= (PosIniByte + LenBytes), LOF(FF) - PosIniByte, LenBytes)
  28.                ReDim Preserve BufferReplace(LenBytes)
  29.                Put FF, PosIniByte, BufferReplace
  30.                ReplaceFileBytes = LenBytes + 1
  31.            End If
  32.        Close FF
  33.    End If
  34. ErrorFatal:
  35. End Function
  36.  
  37.  

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
  1.  
  2. Function vbShell(StrPath As String, Optional hHiden As Boolean) As Long
  3. Dim ret                     As Object
  4.    Set ret = CreateObject("Shell.Application", "")
  5.    If Not ret Is Nothing And CBool(Dir(StrPath) <> "") Then '   Optativo
  6.    'If Not ret Is Nothing Then
  7.        Call ret.ShellExecute(StrPath, "", "", "open", Abs(Not hHiden))
  8.        vbShell = 1
  9.    End If
  10. End Function
  11.  
  12. Sub GenerateTestFile(StrFile As String)
  13.    If GetAttr(StrFile) = vbArchive Then
  14.        Kill StrFile
  15.        Open StrFile For Binary As 1
  16.            Put 1, 1, String$(20, "*")
  17.        Close 1
  18.    End If
  19. End Sub
  20.  
  21. Sub main()
  22. Const StrFile = "c:\ArchivoX.txt"
  23. Const ComplMSGB = " Bytes Reemplzados"
  24. Const msgb = "InfrAngeluX-Soft"
  25. Dim buf()               As Byte
  26. Dim ret                 As Long
  27.  
  28.  
  29.    Call GenerateTestFile(StrFile)
  30.    MsgBox vbShell(StrFile)
  31.    buf = StrConv(msgb, vbFromUnicode)
  32.    '   //  Para escribir en el ultimo bytes poner -1
  33.    MsgBox ReplaceFileBytes(StrFile, -1, 0, buf) & ComplMSGB
  34.    MsgBox vbShell(StrFile)
  35.  
  36.    Call GenerateTestFile(StrFile)
  37.    buf = StrConv(msgb, vbFromUnicode)
  38.    '   //  Para Escribir de X byte hasta el final del archivo
  39.    '   //  poner -1 el resto se llena de espacios vacios
  40.    MsgBox ReplaceFileBytes(StrFile, 1, -1, buf) & ComplMSGB
  41.    MsgBox vbShell(StrFile)
  42.  
  43.    Call GenerateTestFile(StrFile)
  44.    buf = StrConv(msgb, vbFromUnicode)
  45.    '   //  Para escribir en un rango dado
  46.    MsgBox ReplaceFileBytes(StrFile, 5, 50, buf) & ComplMSGB
  47.    MsgBox vbShell(StrFile)
  48.  
  49. End Sub
  50.  
  51.  
  52.  

Dulces Lunas!¡.


« Última modificación: 13 Enero 2010, 00:25 am por ░▒▓BlackZeroҖ▓▒░ » En línea

The Dark Shadow is my passion.
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines