La verdad este code de MachineDramon trabaja bien solamente ejecutandolo desde la IDE de visual basic, no se porque compilandolo me da error.

cualquier mejora o solucion es de gran ayuda

el el Form_Load simplemente se llama a la funcion

Call Zipea("archivo_a_comprimir", "nombre_del_zip", "nombre_del_archivo_dentro_del_Zip")
 

este code va en el modulo:

'Codigo para Zipear Basado en zipstore.c del worm Mydoom
'y Small ZIP Component de www.positronvx.cjb.net en DELPHI
 
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numbytes As Long)
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private Const FILE_BEGIN = 0
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1
Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
 
Private Type LOCAL_FILE_HEADER
 signature As Long          'Firma &H04034b50
 ver_needed As Integer      'Version minima de software necesaria para extraer el archivo
 flags As Integer           'Opciones
 method As Integer          'Metodo de compresion
 lastmod_time As Integer    'Tiempo de ultima modificacion
 lastmod_date As Integer    'Fecha de ultima modificacion
 crcLO As Integer                'CRC del file
 crcHI As Integer
 compressed_sizeLO As Integer    'Tamaño de file comprimido
 compressed_sizeHI As Integer
 uncompressed_sizeLO As Integer  'Tamaño del file sin comprimir
 uncompressed_sizeHI As Integer
 filename_length As Integer 'Longitud del nombre del Archivo
 extra_length As Integer    'Longitud de "InFormacion Adicional" ¿?
End Type
 
Private Type CENTRAL_DIRECTORY_STRUCTURE
 signature As Long          'FIRMA &H02014b50
 made_by As Integer         'Indica SO y version de software donde se comprimio el file
 ver_needed As Integer      'Version minima de software necesaria para extraer el archivo
 flags As Integer           'Opciones
 method As Integer          'Metodo de compresion
 lastmod_time As Integer    'Tiempo de ultima modificacion
 lastmod_date As Integer    'Fecha de ultima modificacion
 crc As Long                'CRC del file
 compressed_size As Long    'Tamaño de file comprimido
 uncompressed_size As Long  'Tamaño del file sin comprimir
 filename_length As Integer 'Longitud del nombre del Archivo
 extra_length As Integer    'Longitud de "InFormacion Adicional" ¿?
 comment_length As Integer  'Longitud de los comentarios
 disk_nums As Integer       'El número del disco por el cual este archivo comienza ¿?
 internal_attr As Integer   'Opciones entre ellas: Si el file tiene datos ASCII(texto) o Binarios
 external_attrLO As Integer 'Opciones entre ellas: Tipo de Sistema de Archivos
 external_attrHI As Integer '
 local_offs As Long         'N° de Byte donde comienza el correspondiente
                            'LOCAL_FILE_HEADER de esta struct CENTRAL_DIRECTORY_STRUCTURE
End Type
 
Private Type END_CENTRAL_DIR
 signature As Long           'FIrma &H06054b50
 disk_nums As Integer        '"El número de este disco, que contiene el expediente de extremo central del directorio" ¿?
 disk_dirstart As Integer    '"El número del disco en el cual el directorio central comienza" ¿?
 disk_dir_entries As Integer 'El número de entradas en el central directory en este disco
 dir_entries As Integer      'El número total de archivos en el zipfile
 dir_size As Long            'El tamaño (en bytes) de la o las CENTRAL_DIRECTORY_STRUCTURE que contenga el zip
 dir_offs As Long            'N° de Byte donde comienza la CENTRAL_DIRECTORY_STRUCTURE o la primera CENTRAL_DIRECTORY_STRUCTURE
                             'si es que hay más de una
 comment_length As Integer   'Longitud de los Comentarios
End Type
 
Private Type SYSTEMTIME
 wYear As Integer
 wMonth As Integer
 wDayOfWeek As Integer
 wDay As Integer
 wHour As Integer
 wMinute As Integer
 wSecond As Integer
 wMilliseconds As Integer
End Type
 
Private Type HL_DWORD
 LOWORD As Integer
 HIWORD As Integer
End Type
 
Private CRCTable(256) As Long
 
Private Sub SetCRCTable()
 'Code CRC32 de www.vbaccelerator.com
 On Error Resume Next
 Dim dwPolynomial As Long, dwCrc As Long, i As Integer, j As Integer
 dwPolynomial = &HEDB88320
 
 For i = 0 To 255
  dwCrc = i
  For j = 8 To 1 Step -1
   If (dwCrc And 1) Then
   dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
   dwCrc = dwCrc Xor dwPolynomial
   Else
   dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
   End If
  Next
  CRCTable(i) = dwCrc
 Next
End Sub
 
Private Function GetCRC32(Buffer As String) As Long
'Code CRC32 de www.vbaccelerator.com
On Error Resume Next
Dim crc As Long, i As Long, iLookup As Integer
 
crc = &HFFFFFFFF
 
For i = 1 To Len(Buffer)
 iLookup = (crc And &HFF) Xor Asc(Mid(Buffer, i, 1))
 crc = ((crc And &HFFFFFF00) \ &H100) And 16777215
 crc = crc Xor CRCTable(iLookup)
Next
 
GetCRC32 = Not (crc)
End Function
 
Public Function Zipea(ffile As String, fzip As String, fname As String) As Boolean
On Error Resume Next
 Dim lfh As LOCAL_FILE_HEADER
 Dim cds As CENTRAL_DIRECTORY_STRUCTURE
 Dim ecd As END_CENTRAL_DIR
 Dim st As SYSTEMTIME
 Dim File As String, FPtr As Long
 Dim sz As Long, dw As Long, o As Long
 Dim hFile As Long, hZip As Long
 Dim HL As HL_DWORD
 Dim CRC32 As Long
 
 o = 0
 
 hFile = CreateFile(ffile, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
 If (hFile = INVALID_HANDLE_VALUE) Then Zipea = False: Exit Function
 
 hZip = CreateFile(fzip, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, 0, 0)
 If (hZip = INVALID_HANDLE_VALUE) Then CloseHandle (hFile): Zipea = False: Exit Function
 
 ZeroMemory ByVal lfh, Len(lfh)
 ZeroMemory ByVal cds, Len(cds)
 ZeroMemory ByVal ecd, Len(ecd)
 
 Call GetSystemTime(st)
 If (st.wHour > 12) Then st.wHour = st.wHour - 12
 
 sz = GetFileSize(hFile, 0)
 
 lfh.signature = &H4034B50
 lfh.ver_needed = 10
 lfh.flags = 0
 lfh.method = 0
 lfh.lastmod_time = (st.wHour) * (2 ^ 11) Or (st.wMinute * (2 ^ 5)) Or (st.wSecond / 2)
 lfh.lastmod_date = ((st.wYear - 1980) * (2 ^ 9)) Or (st.wMonth * (2 ^ 5)) Or (st.wDay)
 CopyMemory ByVal HL, sz, 4
 lfh.uncompressed_sizeHI = HL.HIWORD And &HFFFF
 lfh.uncompressed_sizeLO = HL.LOWORD And &HFFFF
 lfh.compressed_sizeHI = HL.HIWORD And &HFFFF
 lfh.compressed_sizeLO = HL.LOWORD And &HFFFF
 lfh.filename_length = Len(fname)
 lfh.extra_length = 0
 
 cds.signature = &H2014B50
 cds.made_by = 20           'MSDOS=0, PKZIP 2.0 =20
 cds.ver_needed = 10
 cds.flags = 0
 cds.method = 0
 cds.lastmod_time = (st.wHour) * (2 ^ 11) Or (st.wMinute * (2 ^ 5)) Or (st.wSecond / 2)
 cds.lastmod_date = ((st.wYear - 1980) * (2 ^ 9)) Or (st.wMonth * (2 ^ 5)) Or (st.wDay)
 cds.compressed_size = sz
 cds.uncompressed_size = sz
 cds.filename_length = Len(fname)
 cds.extra_length = 0
 cds.comment_length = 0
 cds.disk_nums = 0
 cds.local_offs = 0
 cds.internal_attr = 0      'Datos Binarios
 cds.external_attrLO = &H20 'FAT_32 (&H20=32)
 cds.external_attrHI = &H0
 
 Call SetFilePointer(hFile, 0, 0, FILE_BEGIN)
 FPtr = GlobalAlloc(GPTR, sz)
 If (FPtr = 0) Then Zipea = False: GoTo Cierra
 
  Call ReadFile(hFile, ByVal FPtr, sz, dw, ByVal 0)
  If (dw = 0) Then Zipea = False: GoTo Cierra
 
  File = Space$(dw)
  CopyMemory ByVal File, ByVal FPtr, dw
 
 Call SetCRCTable
 
 CRC32 = GetCRC32(File)
 
 CopyMemory ByVal HL, CRC32, 4
 lfh.crcLO = HL.LOWORD And &HFFFF
 lfh.crcHI = HL.HIWORD And &HFFFF
 
 cds.crc = CRC32
 
 Call WriteFile(hZip, ByVal lfh, Len(lfh), dw, ByVal 0&)
 Call WriteFile(hZip, ByVal fname, Len(fname), dw, ByVal 0&)
 Call WriteFile(hZip, ByVal File, sz, dw, ByVal 0&)
 
 GlobalFree (FPtr)
 o = o + (Len(lfh) + Len(fname) + sz)
 
 ecd.dir_offs = o
 
 Call WriteFile(hZip, ByVal cds, Len(cds), dw, ByVal 0&)
 Call WriteFile(hZip, ByVal fname, Len(fname), dw, ByVal 0&)
 o = o + (Len(cds) + Len(fname))
 
 ecd.signature = &H6054B50
 ecd.disk_nums = 0
 ecd.disk_dirstart = 0
 ecd.disk_dir_entries = 1
 ecd.dir_entries = 1
 ecd.dir_size = o - ecd.dir_offs
 ecd.comment_length = 0
 Call WriteFile(hZip, ByVal ecd, Len(ecd), dw, ByVal 0&)
 
 Zipea = True
Cierra:
 CloseHandle (hFile): CloseHandle (hZip)
End Function
 
 

Si estoy dandole permisos, la verdad me parece mas que es un error en la llama da a la funcion VirtualAllocEx, que si no estoy mal ubica un espacio en memoria, he escuchado algo sobre la addresbase del exe, no se si estoy en lo correcto, quiero saber si alguien ha inyectado code en otro proceso, y si hay errores en mi code saberlo o como hacerlo funcionar. Bueno NO se trata de inyeccion DLL, sino inyección De un EXE en otro EXE.

gracias

El tema es inyeccion de EXE.la inyeccion Dll no me da problemas, necesito es inyectar mi EXE dentro de otro por ejemplo explorer, entiendo que se inyecta la direccion a una funcion de mi EXE. el problema es que cuando lo ejecuto me dice que la memoria no se puede escribir.

tengo una duda, la inyección de code solo se puede hacer a otro ejecutable en VB, oh podria inyectar mi code a explorer.exe?

podria alguien postear algun code que sirva.

Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function VirtualAllocEx Lib "kernel32" (ByVal ProcessHandle As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal ProcessHandle As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function CreateRemoteThread Lib "kernel32" (ByVal ProcessHandle As Long, lpThreadAttributes As Long, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Public Declare Function GetModuleHandleA Lib "kernel32" (ByVal ModName As String) As Long
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal ProcessHandle As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nsize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpname As String) As Long
Public Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hmodule As Integer, ByVal lpFileName As String, ByVal nsize As Integer) As Integer
Public Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Const MEM_COMMIT = &H1000
Const MEM_RESERVE = &H2000
Const MEM_RELEASE = &H8000
Const PAGE_EXECUTE_READWRITE = &H40&
Const IMAGE_NUMBEROF_DIRECTIRY_ENRIES = 16
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SYNCHRONIZE = &H100000
Const PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
 
Type IMAGE_DATA_DIRECTORY
    VirtualAddress As Long
    Size As Long
End Type
 
Type IMAGE_FILE_HEADER
    Machine As Integer
    NumberOfSections As Integer
    TimeDataStamp As Long
    PointerToSymbolTable As Long
    NumberOfSymbols As Long
    SizeOfOptionalHeader As Integer
    Characteristics As Integer
End Type
 
Type IMAGE_OPTIONAL_HEADER32
    Magic As Integer
    MajorLinkerVersion As Byte
    MinorLinkerVersion As Byte
    SizeOfCode As Long
    SizeOfInitalizedData As Long
    SizeOfUninitalizedData As Long
    AddressOfEntryPoint As Long
    BaseOfCode As Long
    BaseOfData As Long
    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
    LoaerFlags As Long
    NumberOfRvaAndSizes As Long
    DataDirectory(IMAGE_NUMBEROF_DIRECTIRY_ENRIES - 1) As IMAGE_DATA_DIRECTORY
End Type
 
Type test
    t1 As Long
End Type
 
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_onvo 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
Const szTarget As String = "project1"
Dim szSharedData As String * 261
Public Sub Main()
' Sub that will start when the program is run
Dim PID As Long, ProcessHandle As Long
Dim Size As Long, BytesWritten As Long, TID As Long, Module As Long, NewModule As Long
Dim PImageOptionalHeader As IMAGE_OPTIONAL_HEADER32, PImageDosHeader As IMAGE_DOS_HEADER, TImageFileHeader As IMAGE_FILE_HEADER, TestType As test
 
GetModuleFileName 0, szSharedData, 261
 
GetWindowThreadProcessId FindWindow(vbNullString, szTarget), PID
 
ProcessHandle = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
 
Module = GetModuleHandleA(vbNullString)
 
CopyMemory PImageDosHeader, ByVal Module, Len(PImageDosHeader)
 
CopyMemory PImageOptionalHeader, ByVal (Module + PImageDosHeader.e_lfanew + 4 + Len(TImageFileHeader)), Len(PImageOptionalHeader)
 
Size = PImageOptionalHeader.SizeOfImage
 
 
VirtualFreeEx ProcessHandle, Module, 0, MEM_RELEASE
 
NewModule = VirtualAllocEx(ProcessHandle, Module, Size, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
 
WriteProcessMemory ProcessHandle, ByVal NewModule, ByVal Module, Size, BytesWritten
 
CreateRemoteThread ProcessHandle, ByVal 0, 0, ByVal GetAdd(AddressOf HijackModule), ByVal Module, 0, TID
 
MsgBox "Handle of the process is: " & ProcessHandle & vbCrLf & "Callback of HijackModule is: " & GetAdd(AddressOf HijackModule) & vbCrLf & "Handle of module is: " & Module & vbCrLf & "Size of module is: " & Size & vbCrLf & "Memory was allocated at: " & NewModule & vbCrLf & "Thread created with handle: " & TID
End Sub
 
Private Function GetAdd(Entrypoint As Long) As Long
GetAdd = Entrypoint
End Function
 
Public Function HijackModule(Stuff As Long) As Long
MessageBox 0, "I am inside a hijacked application", "Hello!", 0
MessageBox 0, "Close the ""Inject"" message box and then delete me", "Hello!", 0
MessageBox 0, "You see? I am still running even if you deleted me.", "Hello!", 0
End Function
 
 

he estado intentando pero sin exito, agradeceria cualquier aporte que me puedan brindar,

Gracias.

sera que live mesenger no acepta el envio de una URL mediante sendkeys

Bueno la verdad para mi era nuevo, no encontre referencias sobre esta funcion.

quisiera saber si hay alguna forma de enviar una URL a la ventana de chat del live messenger, de esta forma


lo que quiero es mediante sendkeys enviar la URL

...