Mensajes

Código [Seleccionar] Expandir

http://www.leandroascierto.com.ar/categoria/M%C3%B3dulos/articulo/Google%20Traductor.php

Saludos

Código (vb) [Seleccionar] Expandir

Option Explicit

Public Type KERNEL_USER_TIMES
    liCreateTime            As Currency 'LARGE_INTEGER
    liExitTime              As Currency 'LARGE_INTEGER
    liKernelTime            As Currency 'LARGE_INTEGER
    liUserTime              As Currency 'LARGE_INTEGER
End Type

'NTDLL
Private Declare Function NtQueryInformationProcess Lib "NTDLL" (ByVal ProcessHandle As Long, ByVal ProcessInformationClass As Long, ByVal ProcessInformation As Long, ByVal ProcessInformationLength As Long, ReturnLength As Long) As Long

Private Const ProcessTimes  As Long = &H4
Public Const CurrentProcess As Long = -1

'---------------------------------------------------------------------------------------
' Procedure : GetProcessTimes
' Author    : Karcrack
' Date      : 290710
' Purpose   : Get some Process Time Info... like when it was created...
'---------------------------------------------------------------------------------------
'
Public Function GetProcessTimes(ByVal hProc As Long) As KERNEL_USER_TIMES
    Call NtQueryInformationProcess(hProc, ProcessTimes, VarPtr(GetProcessTimes), &H20, ByVal 0&)
End Function

Reemplazo nativo a GetProcessTimes@KERNEL32, permite por ejemplo, obtener la hora en la que se inicio un proceso

Saludos

 

Código (vb) [Seleccionar] Expandir

Option Explicit
Option Base 0
'---------------------------------------------------------------------------------------
' Module    : mCopyMemoryASM
' Author    : Karcrack
' Date      : 280710
' Purpose   : A kewl RtlMoveMemory/CopyMemory replacement using ASM :)
'---------------------------------------------------------------------------------------

'USER32
Private Declare Function CallWindowProcW Lib "USER32" (ByVal lpCodePointer As Long, Optional ByVal l1 As Long, Optional ByVal l2 As Long, Optional ByVal l3 As Long, Optional ByVal l4 As Long) As Long

Private bvCode(20)      As Byte
'{
'    PUSH ESI
'    PUSH EDI
'    MOV EDI,DWORD PTR SS:[ESP+C]
'    MOV ESI,DWORD PTR SS:[ESP+10]
'    MOV ECX,DWORD PTR SS:[ESP+14]
'    REP MOVS BYTE PTR ES:[EDI],BYTE PTR DS:[ESI]
'    POP EDI
'    POP ESI
'    RETN 10
'}
Private bInitialized    As Boolean

Public Function ASM_Initialize() As Boolean
    On Error GoTo Initialize_Error
    Dim i               As Long

    For i = 0 To 20
        bvCode(i) = CByte(Choose(i + 1, &H56, &H57, &H8B, &H7C, &H24, &HC, &H8B, &H74, &H24, &H10, &H8B, &H4C, &H24, &H14, &HF3, &HA4, &H5F, &H5E, &HC2, &H10, &H0))
    Next i
   
    bInitialized = True
    ASM_Initialize = True
   
    On Error GoTo 0
    Exit Function
Initialize_Error:
    ASM_Initialize = False
End Function

Public Sub ASM_CopyMemory(ByVal Source As Long, ByVal Destination As Long, ByVal Length As Long)
    If bInitialized = True Then
        Call CallWindowProcW(VarPtr(bvCode(0)), Destination, Source, Length)
    End If
End Sub

'PutMem4 Wrapper
Public Sub ASM_PutMem4(ByVal lLong As Long, ByVal Destination As Long)
    Call ASM_CopyMemory(VarPtr(lLong), Destination, &H4)
End Sub

'GetMem4 Wrapper
Public Function ASM_GetMem4(ByVal Source As Long) As Long
    Call ASM_CopyMemory(Source, VarPtr(ASM_GetMem4), &H4)
End Function

*Actualizado

Ejemplo:

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()
   Dim x       As Long
   Dim y       As Long
   Dim i       As String
   Dim n       As String
   
   If ASM_Initialize = True Then
       x = &H1337
       Call ASM_CopyMemory(VarPtr(x), VarPtr(y), &H4)
       Debug.Print Hex$(x), Hex$(y)
       y = 0
       Call ASM_PutMem4(x, VarPtr(y))
       Debug.Print Hex$(ASM_GetMem4(VarPtr(x)))
       Debug.Print Hex$(x), Hex$(y)
       i = "KARCRACK_ES_GUAY!!!!!!!"
       n = Space$(Len(i))
       Call ASM_CopyMemory(StrPtr(i), StrPtr(n), LenB(i))
       Debug.Print i
       Debug.Print n
   End If
End Sub

Saluuudos

No funciona 
Me pasa igual... ademas la cosa es que no queria depender de OCX...
Vi por ahi un modulo de Cobein, que hace algo similar, pero no encuentro un RichtTextBox.cls...

He estado leyendo, prueba a cambiar la Font del TextBox...

No te copio, solo me burlo

[rtcDoEvents@MSVBVM60!]

Prueba con RitchTextBox

rtcDoEvents@MSVBVM60!

Buen chiste!
-4 posee uno de mis nicks favoritos

Saludos Pokemaniacos!

I'd like to see the working code without Invoke, so I'll be able to see if you pass some pointers wrong..

Es un tema interesante el de las expresiones regulares, no tendreis un par de enlaces para que el tito Kar se entere mejor del tema?

Hay otra manera de hacer esto, se llama link spoofing y se puede compilar con ASM inline o cualquier otra cosa, pero obviamente requiere interceptar la llamada al linker y reemplazar el code en vb por asm.

Asi es como trabaja el ThunderVB por ejemplo, modifica los .obj antes de su linkeo. Estuve investigando, pero no me gusta para compartir codigos... ya que cada persona que quiera probarlo tendria que modificar su VB6...

Si usa APIs ¬¬", aun qué solo sea Una pero de que usa usa!¡.

Posiblemente se la tome ya enserió el Avira y meta una en la declaración API CallWindowProcW

Tranquilo, que si todo va bien y consigo reparar el problema de Stack que me genera __vbaGoSubReturn tenemos forma de cargar ASM Inline sin usar APIs fuera de MSVBVM60, es decir, no pueden poner ninguna firma