Mensajes

[win.tlb]

Para los que le interese la programación de virus este código sirve para buscar espacios libres en la sección de código del ejecutable para luego poder insertar nuestro código ahi.

Lo bueno de este método es que la sección de código (.text) siempre tiene permiso de ejecución por lo que no nos dará errores de protección.

Necesita agregar como referencia al proyecto win.tlb

Código [Seleccionar] Expandir


'
'Coded by Slasher
'
Option Explicit
Option Base 1

Public Const IMAGE_SIZEOF_SHORT_NAME = 8
Public Const IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16

Public Const IMAGE_DOS_SIGNATURE = &H5A4D      ' MZ
Public Const IMAGE_OS2_SIGNATURE = &H454E      ' NE
Public Const IMAGE_OS2_SIGNATURE_LE = &H454C   ' LE
Public Const IMAGE_NT_SIGNATURE = &H4550       ' PE
Public Const IMAGE_FILE_UNKNOWN = &H0          ' Desconocido


Type IMAGE_DOS_HEADER
  e_magic     As Integer
  e_cblp      As Integer
  e_cp        As Integer
  e_crlc      As Integer
  e_cparhdr   As Integer
  e_minalloc  As Integer
  e_maxalloc  As Integer
  e_ss        As Integer
  e_sp        As Integer
  e_csum      As Integer
  e_ip        As Integer
  e_cs        As Integer
  e_lfarlc    As Integer
  e_ovno      As Integer
  e_res(3)    As Integer
  e_oemid     As Integer
  e_oeminfo   As Integer
  e_res2(9)   As Integer
  e_lfanew    As Long
End Type

Type IMAGE_FILE_HEADER
  Magic                 As Long
  Machine               As Integer
  NumberOfSections      As Integer
  TimeDateStamp         As Long
  PointerToSymbolTable  As Long
  NumberOfSymbols       As Long
  SizeOfOptionalHeader  As Integer
  Characteristics       As Integer
End Type

Type IMAGE_DATA_DIRECTORY
  VirtualAddress  As Long
  Size            As Long
End Type

Type IMAGE_OPTIONAL_HEADER
'Campos estándar
'
  Magic                     As Integer
  MajorLinkerVersion        As Byte
  MinorLinkerVersion        As Byte
  SizeOfCode                As Long
  SizeOfInitializedData     As Long
  SizeOfUninitializedData   As Long
  AddressOfEntryPoint       As Long
  BaseOfCode                As Long
  BaseOfData                As Long
 
'Campos adicionales de NT
'
  ImageBase                     As Long
  SectionAlignment              As Long
  FileAlignment                 As Long
  MajorOperatingSystemVersion   As Integer
  MinorOperatingSystemVersion   As Integer
  MajorImageVersion             As Integer
  MinorImageVersion             As Integer
  MajorSubsystemVersion         As Integer
  MinorSubsystemVersion         As Integer
  Reserved1                     As Long
  SizeOfImage                   As Long
  SizeOfHeaders                 As Long
  CheckSum                      As Long
  Subsystem                     As Integer
  DllCharacteristics            As Integer
  SizeOfStackReserve            As Long
  SizeOfStackCommit             As Long
  SizeOfHeapReserve             As Long
  SizeOfHeapCommit              As Long
  LoaderFlags                   As Long
  NumberOfRvaAndSizes           As Long
  DataDirectory(IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1) As IMAGE_DATA_DIRECTORY
End Type

Type HoleInfo
  Offset  As Long
  Size    As Long
End Type

Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long
Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long

Sub Main()
        Dim lpHoles() As HoleInfo
        Dim hMap&, lBase&, lSize&
        Dim lHoles&, i&

  hMap = MapExe("C:\WINDOWS\SYSTEM32\NOTEPAD.EXE")
  lBase = GetCodeOffset(hMap, lSize)
 
  'Busca huecos de 128 bytes como mínimo.
  '
  lHoles = FindHoles(hMap, lBase, lSize, lpHoles, 128)
 
  For i = 1 To lHoles
    Debug.Print "Hueco Nº " & i, "Offset: 0x" & Hex$(lpHoles(i).Offset), _
                "Tamaño: 0x" & Hex$(lpHoles(i).Size)
  Next
 
  Call VirtualFree(hMap, 0&, MEM_RELEASE)

End Sub

Function MapExe(Filename As String) As Long
        Dim hMem&, hFile&
        Dim r&

  hFile = CreateFile(Filename, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
 
  If hFile = INVALID_HANDLE_VALUE Then Exit Function
 
  'Asigna memoria.
  '
  hMem = VirtualAlloc(0&, GetFileSize(hFile, 0), MEM_COMMIT, PAGE_READWRITE)
 
  'Lee el archivo a memoria.
  '
  r = ReadFile(hFile, ByVal hMem, GetFileSize(hFile, 0), 0&, ByVal 0&)
 
  MapExe = hMem
End Function

Function GetCodeOffset(hMap As Long, Optional outSize As Long) As Long
        Dim lpDosHdr  As IMAGE_DOS_HEADER
        Dim lpFileHdr As IMAGE_FILE_HEADER
        Dim lpOptHdr  As IMAGE_OPTIONAL_HEADER
        Dim r&

  r = ReadProcessMemory(GetCurrentProcess(), hMap, lpDosHdr, Len(lpDosHdr))
 
  If lpDosHdr.e_magic <> IMAGE_DOS_SIGNATURE Then Exit Function
 
  r = ReadProcessMemory(GetCurrentProcess(), hMap + lpDosHdr.e_lfanew + Len(lpFileHdr), lpOptHdr, Len(lpOptHdr))
 
  outSize = lpOptHdr.SizeOfCode
  GetCodeOffset = lpOptHdr.BaseOfCode
End Function

Function FindHoles(hMap As Long, BaseOfCode As Long, SizeOfCode As Long, outHoles() As HoleInfo, Optional MinSize As Integer) As Long
        Dim btData() As Byte
        Dim lHoleSize&, lCnt&
        Dim r&, i&

  ReDim btData(SizeOfCode) As Byte
 
  r = ReadProcessMemory(GetCurrentProcess(), hMap + BaseOfCode, btData(1), SizeOfCode)
 
  If MinSize <= 0 Then MinSize = 128
 
  Erase outHoles
 
  For i = 1 To SizeOfCode
    If btData(i) <> 0 And lHoleSize > MinSize Then
      lCnt = lCnt + 1
     
      ReDim Preserve outHoles(lCnt) As HoleInfo
     
      outHoles(lCnt).Offset = BaseOfCode + i
      outHoles(lCnt).Size = lHoleSize
     
      lHoleSize = 0
     
    ElseIf btData(i) = 0 Then
      lHoleSize = lHoleSize + 1
    End If
  Next
 
  FindHoles = lCnt
End Function


Saludos.

[GetVersionEx]

Mira la función GetVersionEx

Saludos.

Eso debería ir en un módulo estándar...

Vamos Ruben, leete un tutorial de VB que te va a ayudar mucho. Aprenda Visual Basic como en primero es muy bueno y explica todas estas cosas.

Saludos.

Código [Seleccionar] Expandir


Option Explicit

Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2

Const ANYSIZE_ARRAY = 1

Type LUID
  LowPart As Long
  HighPart As Long
End Type

Type LUID_AND_ATTRIBUTES
  pLuid As LUID
  Attributes As Long
End Type

Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLUID As LUID) As Long
Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long

Declare Function SetSystemPowerState Lib "kernel32" (ByVal fSuspend As Long, ByVal fForce As Long) As Long

Private Sub SetShutdownPrivilege()
    Dim lpLUID        As LUID
    Dim lpToken       As TOKEN_PRIVILEGES
    Dim lpPrevToken   As TOKEN_PRIVILEGES
    Dim hToken&, r&

    r = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken)
    r = LookupPrivilegeValue(vbNullString, "SeShutdownPrivilege", lpLUID)
   
    With lpToken
      .PrivilegeCount = 1
      .Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
      .Privileges(0).pLuid = lpLUID
    End With
   
    r = AdjustTokenPrivileges(hToken, False, lpToken, 4 + (12 * lpToken.PrivilegeCount), lpPrevToken, 4 + (12 * lpPrevToken.PrivilegeCount))
End Sub

Sub SuspendSystem()
  Call SetShutdownPrivilege
  Call SetSystemPowerState(True, False)
End Sub


[Fuerza bruta en VB]

Si buscas encontrás

Fuerza bruta en VB

Saludos.

La idea es hacer un cliente FTP, no usar uno.

Saludos-

Busca en el foro, hay códigos que muestran como recorrer todo el disco buscando archivos, sólo lo modificas un poco y muestra "Borrando archivo..."

Para que parezca que está borrando lo abres y lo cierras en modo Input, por ejemplo:

Código [Seleccionar] Expandir


      Dim hFile%

  hFile = FreeFile
  Open "MiArchivo" For Input As #hfile
  Close #hfile


Eso haría que el disco trabaje ya que tiene que buscar en la tabla de asignación de archivos para abrirlo .

Saludos.

Eso no se puede hacer, por lo menos no desde Excel ya que es el mismo programa el que controla las macros.

Saludos.

Excelente aporte. Muchas gracias.

Saludos.

Insisto, las cadenas van entre comillas...

Código [Seleccionar] Expandir


If datos = "colgar" Then  '<----Fijate las comillas en colgar.
    BlockInput True
End If


Cuando surjan esos errores de compilación dale una leida a algún manual de VB.

Saludos.