Mensajes

DWORD = LONG

.

[EDITO:]

Código [Seleccionar] Expandir

http://advancevb.com.ar/?p=521

Ya lo había visto, tenia un conflictos al iniciar el form con un control, pero puse el control en otro form que nunca se muestra y no hay problema, gracias Karcrack

EDITO:
El problema con el control sigue , aca subo un zip con un ejemplo del error por si alguien quiere ayudarme

http://www.box.net/shared/pdhdchnqc4

Gracias

Vamos chicas!! 

Hola gente, hago este thread para ver si alguien puede hacer un codigo decente para crear threads y que se pueda acceder a todos los recursos normales de VB6 sin que crashe.

-Este es el codigo que utilizo algún tiempo, pero tiene limitaciones, al crear un thread con un nuevo FORM VISIBLE crashea (.Show,.Visible=True, de cualquier manera, inluyendo el api.).
-Tambien la simple llamada a MsgBox crashea, pero se puede solucionar llamando al api.

Yo creo que esos dos problemas estan relacionados, si alguien tiene el conocimiento y tiempo, le agradecería que intentara crear un codigo para crear varios threads sin problemas. Seria el UNICO en toda la internet, porque no lo hay, almenos en VB6

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Function CreateThread Lib "KERNEL32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByRef lpParameter As Any, ByVal dwCreationFlags As Long, ByRef lpThreadId As Long) As Long
Private Declare Sub ExitThread Lib "KERNEL32" (ByVal dwExitCode As Long)
Private Declare Function TlsGetValue Lib "KERNEL32" (ByVal dwTlsIndex As Long) As Long
Private Declare Function TlsSetValue Lib "KERNEL32" (ByVal dwTlsIndex As Long, ByRef lpTlsValue As Any) As Long

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Declare Function GetProcAddress Lib "KERNEL32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibrary Lib "KERNEL32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "KERNEL32" (ByVal hLibModule As Long) As Long

Private MemAddress As Long
Private TlsAddress As Long
Private TlsIndex As Long

Public Function CreateNewThread(ByVal hThreadProc As Long, Optional ByVal Param As Long = 0) As Long
   If (MemAddress + TlsIndex) = 0 Then
       Call InitTlsIndex: Call CopyMemory(TlsIndex, ByVal TlsAddress, Len(TlsIndex)) 'Retrieve TlsIndx from TlsAddress
       MemAddress = TlsGetValue(TlsIndex)
   End If

   CreateNewThread = CreateThread(0, 0, hThreadProc, ByVal Param, 0, 0)
End Function

Public Sub InitThread()
   Call TlsSetValue(TlsIndex, ByVal MemAddress) 'VB will use this address to store DLL error information and etcs.
End Sub

Private Sub InitTlsIndex()
   'Tls Index's address of our thread.
   Dim bB(40) As Byte, St As String
   Dim hProc As Long, hLib As Long, i As Integer, j As Integer

   hLib = LoadLibrary("MSVBVM60")
   hProc = GetProcAddress(hLib, "__vbaSetSystemError")
   Call CopyMemory(bB(0), ByVal (hProc), 40)
   
   While bB(i) <> &HC3 'RETN
       If bB(i) = &HFF And bB(i + 1) = &H35 Then
           For j = i + 2 To i + 5
               St = Hex(bB(j)) & St
           Next
           TlsAddress = Val("&H" & St): Exit Sub
       End If
       i = i + 1
   Wend
   
   Call FreeLibrary(hProc)
End Sub

Public Sub TerminateThread(ByVal dwExitCode As Long)
   Call ExitThread(dwExitCode)
End Sub

Abrazo

Ese tipo de modificaciones serian sobre el fichero compilado y en este proyecto me intereso en el codigo

Por cierto, estuve haciendo un poco de research y lanzo una buenisima idea para aquel que tenga tiempo ... Desde el header de un fichero compilado de VB6 se puede acceder a las cadenas de las APIs importadas, se cifran, se modifica tambien el header para que haga al Loader de VB6 ejecutar una pequeña shellcode que descifrará las cadenas de las APIs... para que quede mas claro:

• Abrimos el fichero compilado
• Leemos la cabecera del VB6 y recorremos las cadenas de las APIs cifrando cada una
• Inyectamos una shellcode en uno de los muchos huecos que quedan en el ejecutable
• Modificamos la cabecera del VB6 para que haga ejecutar al Loader nuestra shellcode primero
• La shellcode se encargará de descifrar las cadenas y saltar al EntryPoint original que había en el header del VB6

De esta forma las APIs serian descifradas en Runtime y en Scantime nuestras APIs serian irreconocibles

Es facil para los que saben como hacer shellcodes, yo sé muy pocas instrucciones y por ahi me quedo..

[Val()]

Buenas, algo chiquito pero bueno seria, remplazar cualquier valor numérico por su equivalente string, pero llamando a la funcion Val() para que retorne lo que se necesita:

bB(0) = &H1 >>> bB(0) = Val("&H1")
call dd(1,2) >>> call dd(Val("&H1"),Val("&H2")
, y agregarle la posibilidad de cifrar ese string tambien 

Despues estaria muy bueno agregale algo que limpie la ***** que agrega VB6, jugar con las estructuras que utilizo BlackZero (sino me equivoco), lo pensé hace tiempo, y creo que seria posible.

Que anden bien, Saludos  

Al final lo conseguiste
A ver si con lo que te dije se puede extener a cualquier estructura

Lo intenté, te mande un PM hace unos dias con el codigo; la funcion __vbaPutOwner3 recibe directamente el valor de la primer variable de la estructura y no lo demás datos, es raro :S

Como dije, no es difícil agregarle soporte con otros tipos de variables, en unos dias lo hago y posteo 

[mStruct:]

mStruct:

Código [Seleccionar] Expandir

Option Explicit

Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long) As Long

Private Type SA1D_STRUCT
   Struct(23) As Byte
   bData() As Byte
   Length As Long
End Type

Private SA1D() As SA1D_STRUCT

Public Sub ByteToStruct(ByVal StructPtr As Long, ByRef bArray() As Byte)
   Dim Count As Long
   Dim i As Long
   
   Do
       ReDim Preserve SA1D(i): Call CopyMemory(SA1D(i).Length, bArray(Count), 4)
       ReDim SA1D(i).bData(SA1D(i).Length)
   
       Call CopyMemory(SA1D(i).bData(0), bArray(Count + 4), SA1D(i).Length)
       Count = Count + 4 + SA1D(i).Length: i = i + 1
   Loop Until (UBound(bArray) + 1 = Count)
   
   For i = 0 To UBound(SA1D)
       Call CopyMemory(SA1D(i).Struct(12), VarPtr(SA1D(i).bData(0)), 4) 'DataPtr
       Call CopyMemory(SA1D(i).Struct(16), SA1D(i).Length, 4) 'LBound
       Call CopyMemory(SA1D(i).Struct(0), 1, 2) 'Dims
       Call CopyMemory(SA1D(i).Struct(4), 1, 4) 'ElementSize
             
       Call CopyMemory(ByVal StructPtr + (i * 4), VarPtr(SA1D(i).Struct(0)), 4) 'SA1D Struct
   Next i
End Sub

Public Sub StructToByte(ByVal StructPtr As Long, ByRef bReturn() As Byte, ParamArray VarType() As Variant)
   Dim SafeArrayPtr As Long
   Dim ArrayLength As Long
   Dim ArrayPtr As Long
   Dim i As Long
       
   ReDim bReturn(0)
   For i = 0 To UBound(VarType)
       Select Case VarType(i)
           Case vbByte:
               'SafeArray1D Struct
               Call CopyMemory(SafeArrayPtr, ByVal StructPtr + (i * 4), 4)
               Call CopyMemory(ArrayPtr, ByVal SafeArrayPtr + 12, 4) 'DataPtr
               Call CopyMemory(ArrayLength, ByVal SafeArrayPtr + 16, 4) 'LBound
               'Data Size + Data
               ReDim Preserve bReturn(UBound(bReturn) + 4 + ArrayLength)
               Call CopyMemory(ByVal VarPtr(bReturn(UBound(bReturn) - 4 - ArrayLength)), ArrayLength, 4)
               Call CopyMemory(ByVal VarPtr(bReturn(UBound(bReturn) - ArrayLength)), ByVal ArrayPtr, ArrayLength)
       End Select
   Next i
   ReDim Preserve bReturn(UBound(bReturn) - 1)
End Sub

Ejemplo:

Código [Seleccionar] Expandir

Private Type dd
   ss() As Byte
   jj() As Byte
   tt() As Byte
End Type

Sub Main()
   Dim told As dd
   Dim tnew As dd
   Dim bB() As Byte
   
   told.ss = StrConv("hola", vbFromUnicode)
   told.jj = StrConv("jeje", vbFromUnicode)
   told.tt = StrConv("wakawaka", vbFromUnicode)
   
   Call StructToByte(VarPtr(told), bB, vbByte, vbByte, vbByte)
   Call ByteToStruct(VarPtr(tnew), bB)
   
   MsgBox StrConv(tnew.jj, vbUnicode)
   MsgBox StrConv(tnew.ss, vbUnicode)
   MsgBox StrConv(tnew.tt, vbUnicode)
End Sub

PD: funciona solo con arrays de bytes, ya que es lo que yo necesito , pero se puede agregar "soporte" con otros tipos de variables facilmente  

Suerte

Hay 2 apis nativas @NTDLL para hacer lo mismo