Mensajes

Este es un proyecto que tenia ganas de intentar hacer, sirve (o es lo que intenta)  comprimir un ejecutable tipo como el UPX, si bien funciona todo bien la compresion es muy baja (desde el vamos es stub esta echo en vb) los métodos empleados son inyeccion en la memoria y CallApibyName (creo que estas funciones son de Cobein y/o Karcrack), CloneFile by ZeR0 para colonar los recursos, y para comprimir utiliza el api nativa RtlCompressBuffer

bueno lo peor de todo es que varios de los antivirus lo detectan como un código malicioso   y abría que hacer muchos cambios para que esto no pase.

Descargar

Leandro, con controles de usuarios es posible hacerlo...!

si porsupuesto que con un usercontrol se puede, pero no con los controles nativos de windows, como dije antes vos en un usercontrol mediante medotodos graficos y reiones podes ir creado un boton (por hacerla sensilla) y dibujarlo con lienas (o imagenes porque no) y rotarlo como se te den las ganas tambien podes rotar el caption y el icono. pero ya te daras cuenta cuanto trabajo requiere esto con un simple boton, imaginate hacer un listview en 30º

No se puede las ventanas de windows son cuadradas y no se rotan, por ejemplo un commandButon un textbox un listbox nunca vas a poder rotar esas ventanas, lo que si puedes es vos crear un control personalizado donde mediante metodos graficos y regiones podes dar ese efecto.

y lo de asm es utilizando una imagen pero no controles.

saludos.

Karcrak como aplicaria esto a CallApiByName

Código [Seleccionar] Expandir

Function CallApiByName(ByVal sLib As String, ByVal sMod As String, ParamArray Params()) As Long
On Error Resume Next
    Dim lPtr                As Long
    Dim bvASM(&HEC00& - 1)  As Byte
    Dim i                   As Long
    Dim lMod                As Long

    lMod = GetProcAddress(LoadLibraryA(sLib), sMod)
    If lMod = 0 Then Exit Function

    lPtr = VarPtr(bvASM(0))
    RtlMoveMemory ByVal lPtr, &H59595958, &H4:              lPtr = lPtr + 4
    RtlMoveMemory ByVal lPtr, &H5059, &H2:                  lPtr = lPtr + 2
    For i = UBound(Params) To 0 Step -1
        RtlMoveMemory ByVal lPtr, &H68, &H1:                lPtr = lPtr + 1
        RtlMoveMemory ByVal lPtr, CLng(Params(i)), &H4:     lPtr = lPtr + 4
    Next
    RtlMoveMemory ByVal lPtr, &HE8, &H1:                    lPtr = lPtr + 1
    RtlMoveMemory ByVal lPtr, lMod - lPtr - 4, &H4:         lPtr = lPtr + 4
    RtlMoveMemory ByVal lPtr, &HC3, &H1:                    lPtr = lPtr + 1
    CallApiByName = CallWindowProcA(VarPtr(bvASM(0)), 0, 0, 0, 0)

End Function

Saludos.

Hola me parece que tu funcion esta mal, un long  = 4 bytes por lo tanto tienes que redimencionar el array a  (0 to 3)

asi es como creo que iria

Código [Seleccionar] Expandir


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

Public Function LongToByteArray(ByVal lng As Long) As Byte()
    Dim ByteArray(3) As Byte
    CopyMemory ByteArray(0), lng, LenB(lng)
    LongToByteArray = ByteArray
End Function

Public Function ByteArrayToLong(ByteArray() As Byte) As Long
    CopyMemory ByteArrayToLong, ByteArray(0), LenB(ByteArrayToLong)
End Function


Private Sub Command1_Click()
    Dim bytArr() As Byte
    bytArr = LongToByteArray(94545712)
    MsgBox ByteArrayToLong(bytArr)
End Sub



Saludos.

Ok, voy a seguir en castellano después usted lo traduce

yo e solucionado eso de la siguiente manera

No envíe el archivo completo, envielo por trozos de 1 kb aproximadamente, cuando se dispara el evento SendComplete active un pulso de un timer para no crear un bucle y así poder formar algo parecido a un Multithreard.

un ejemplo que no lo he probado pero es para que usted tenga una idea de como funciona, es mas lento pero puede enviar varios archivos a la vez


Esto iria dentro de un modulo clase que representa una conexión con un modulo clase de socket y un modulo clase de un timer.

Código [Seleccionar] Expandir


Const SIZE_OF_BUFFER As Long = 1024

Dim LenData As Long
Dim bData() As Byte
Dim bBuffer() As Byte
Dim lChuncks As Long
Dim lReminder As Long
Dim lPos As Long
Dim SendFileComplete As Boolean

Private Sub SendFile(ByVal FileName As String)
   Dim FF As Integer
   FF = FreeFile
   
   Open FileName For Binary As #FF
     ReDim bData(LOF(FF))
     Get #FF, , bData
   Close #FF
   
   LenData = UBound(bData)
   ReDim bBuffer(SIZE_OF_BUFFER)
   lChuncks = LenData \ SIZE_OF_BUFFER
   lReminder = LenData - lChuncks * SIZE_OF_BUFFER
   SendFileComplete = False
   Call SendSegment
End Sub

       
Private Sub SendSegment()

   If SendFileComplete = True Then Exit Sub

   If lPos <= lChuncks Then
       CopyMemory bBuffer(0), bData(lPos), SIZE_OF_BUFFER
       lPos = lPos + SIZE_OF_BUFFER
       
       SendFileComplete = False
       
       If cSocket.State = 7 Then
           cSocket.SendData bBuffer
       End If
   Else

       If lReminder > 0 Then
           ReDim bBuffer(lReminder)
           CopyMemory bBuffer(0), bData(lPos), lReminder
           
           SendFileComplete = True
           
           If cSocket.State = 7 Then
               cSocket.SendData bBuffer
           End If
       Else
           SendFileComplete = True
       End If
   End If
End Sub

Private Sub cSocket_SendComplete()
   cTimer.StartTimer 1
End Sub

Private Sub cTimer_Timer()
   cTimer.StopTimer
   Call SendSegment
End Sub

hola para los formularios cargados es simple como esto

Código [Seleccionar] Expandir

Private Sub Command1_Click()
    Dim Frm As Form
    For Each Frm In Forms
        Debug.Print Frm.Name ' o frm.caption
    Next
End Sub

y si no estan cargados no se puede .

[Server]

Hello, This is a simple example of how to work with array of controls

Server

Código (vb) [Seleccionar] Expandir

Option Explicit
Dim ColSocket As Collection

Private Sub Form_Load()
    Set ColSocket = New Collection
    Winsock1(0).LocalPort = 100
    Winsock1(0).Listen  '<<< Main Conextion (don't close this connections!)
End Sub

Private Sub Winsock1_Close(Index As Integer)
    Unload Winsock1(Index)
    ColSocket.Remove "K" & Index
End Sub

Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
   
   
    Dim FreeIndex As Long, NewKey As String
   
    'FreeIndex = Winsock1.UBound + 1  'Maximum value of the array of controls <(Don't use this)
   
    FreeIndex = GetFreeIndex() '<(use This, prevents the increase of the array)
   
    NewKey = "K" & FreeIndex 'Unique key for control

    Load Winsock1(FreeIndex) 'load new control
   
    ColSocket.Add Winsock1(FreeIndex), NewKey 'Add the new control in the collection
   
    ColSocket(NewKey).Accept requestID 'The new control accept the new connections
   
    ColSocket(NewKey).SendData "hola mundo" & FreeIndex 'The new control send a message
   
   
End Sub

Private Function GetFreeIndex() As Long 'Get the free index in the controls array
    Dim i As Long, j As Long
   
    For i = 1 To ColSocket.Count
        For j = 1 To ColSocket.Count
            If ColSocket(j).Index = i Then
                GetFreeIndex = 0
                Exit For
            Else
                GetFreeIndex = i
            End If
        Next
        If GetFreeIndex <> 0 Then Exit For
    Next
   
    If GetFreeIndex = 0 Then GetFreeIndex = ColSocket.Count + 1
   
End Function

Private Sub Command1_Click()
    SendNewMessageForAllConection
End Sub

Private Sub SendNewMessageForAllConection()
    Dim i As Long
    For i = 1 To ColSocket.Count
       ColSocket(i).SendData "New Message for all Connections"
    Next
End Sub

Private Sub Command2_Click()
    CloseAllConnections
End Sub

Private Sub CloseAllConnections()
    Dim i As Long
    For i = ColSocket.Count To 1 Step -1
        ColSocket(i).Close
        Unload Winsock1(ColSocket(i).Index)
        ColSocket.Remove i
    Next
End Sub

'this works only if the data are small, otherwise it should be modulized or create array index data
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim Data As String
    Winsock1(Index).GetData Data 'or ColSocket("K" & Index).GetData Data
    Me.Print Data
End Sub

Client (compile it and run it several instances)

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Sub Form_Load()
    Winsock1.Connect "127.0.0.1", 100
End Sub

Private Sub Winsock1_Close()
    Unload Me
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim Data As String
    Winsock1.GetData Data
    Me.Caption = Data
End Sub

are using some sort of loop, it would be good to see some of your code


[Spanish]
esta utilizando algun tipo de bucle, seria bueno ver parte de su codigo

Hola "Creo" que es por el lenguage ose el cuarto parametro de la funcion UpdateResourceA

Saludos.