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

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

Private Type ControlVB
    sType As String
    sName As Strin
End Type
Private Declare Function CopyBytes Lib "MSVBVM60" Alias "__vbaCopyBytes" (ByVal Size As Long, Dest As Any, Source As Any) As Long

Private Sub main()
    Dim dd As ControlVB
    Dim bb As ControlVB
    Dim aa As Variant
    
    dd.sName = "aaaaa"
    dd.sType = "TextBox"
    
    aa = StructToVariant(VarPtr(dd), LenB(dd))
    Call VariantToStruct(aa, VarPtr(bb))
    
    MsgBox bb.sName
End Sub

Private Function StructToVariant(ByVal StructPtr As Long, ByVal Size As Long) As Variant
    Dim Bin() As Byte
    
    ReDim Bin(Size)

    Call CopyBytes(Size, ByVal VarPtr(Bin(0)), ByVal StructPtr)
    StructToVariant = Bin
End Function

Private Function VariantToStruct(ByRef vVariant As Variant, ByVal StructPtr As Long)
    Call CopyBytes(LenB(vVariant) - 1, ByVal StructPtr, ByVal StrPtr(vVariant))
End Function

Private Declare Function GetModuleHandle Lib "KERNEL32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "KERNEL32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function HeapAlloc Lib "KERNEL32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "KERNEL32" () As Long
Private Declare Function HeapFree Lib "KERNEL32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByRef lpMem As Any) As Long
Private Declare Function VirtualAllocEx Lib "KERNEL32" (ByVal hProcess As Long, ByRef lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function WriteProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "MSVBVM60" Alias "__vbaCopyBytes" (ByVal Size As Long, Dest As Any, Source As Any)

Private Declare Function CreateRemoteThread Lib "KERNEL32" (ByVal hProcess As Long, lpThreadAttributes As Any, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

Private Const MEM_COMMIT = &H1000
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Const HEAP_ZERO_MEMORY As Long = &H8

Private Function CreateRemoteThreadEx(hProcess As Long, _
                                      lpThreadAttributes As Variant, _
                                      dwStackSize As Long, _
                                      lpStartAddress As Long, _
                                      dwCreationFlags As Long, _
                                      lpThreadId As Long, _
                                      ParamArray vParameters() As Variant)
    Dim ASM_CALLGATE(39) As Byte
    Dim lpLocal As Long
    Dim lpRemote As Long
    Dim lpData As Long
    Dim lpCode As Long
    Dim dwAmount  As Long
    Dim dwDataSize As Long
    Dim dwCallSize  As Long
    Dim dwWritten  As Long
    
    Dim i As Long
    
   '{
        ' CALL $+0x1D
        ' PUSH EAX
        ' PUSH 90C35858 (code for POP EAX\nPOP EAX\nRETN)"
        ' PUSH MEM_RELEASE
        ' PUSH 1
        ' PUSH 00000000 (-> PUSH lpRemote)
        ' PUSH ESP
        ' ADD DWORD [ESP], 0x0C
        ' PUSH 00000000 (-> PUSH VirtualFree)
        ' RETN
        ' PUSH 00000000 (-> PUSH lpStartAddress)
        ' RETN
    '}
    
    For i = 0 To 39
        ASM_CALLGATE(i) = CByte(Choose(i + 1, &HE8, &H1D, &H0, &H0, &H0, &H50, &H68, &H58, &H58, &HC3, &H90, &H68, &H0, &H40, _
                                              &H0, &H0, &H6A, &H1, &H68, &H0, &H0, &H0, &H0, &H54, &H83, &H4, &H24, &HC, _
                                              &H68, &H0, &H0, &H0, &H0, &HC3, &H68, &H0, &H0, &H0, &H0, &HC3))
    Next i
    
    If UBound(vParameters) <> -1 Then
        dwAmount = UBound(vParameters)
        For i = 0 To dwAmount
            dwDataSize = dwDataSize + LenB(vParameters(i))
        Next i
        dwCallSize = UBound(ASM_CALLGATE) + dwAmount * (4 + 1) + dwDataSize
        
        'Allocate memory for callgate constructing (local process)
        lpLocal = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, dwCallSize)
        If lpLocal = 0 Then: GoTo Error
        
        'Allocate memory from remote process
        lpRemote = VirtualAllocEx(hProcess, 0&, dwCallSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
        If lpRemote = 0 Then: GoTo Error
        
        Call CopyMemory(4, ByVal VarPtr(ASM_CALLGATE(19)), lpRemote)
        Call CopyMemory(4, ByVal VarPtr(ASM_CALLGATE(35)), lpStartAddress)
        Call CopyMemory(4, ByVal VarPtr(ASM_CALLGATE(29)), GetProcAddress(GetModuleHandle("KERNEL32"), "VirtualFree"))
    End If
    
    Call WriteProcessMemory(hProcess, lpRemote, lpLocal, dwCallSize, dwWritten)
    Call HeapFree(GetProcessHeap(), 0, lpLocal)
    If dwWritten = 0 Then: GoTo Error

    CreateRemoteThreadEx = CreateRemoteThread(hProcess, lpThreadAttributes, dwStackSize, (lpRemote + dwDataSize), 0, dwCreationFlags, lpThreadId)
    Exit Function
Error:
    
End Function

Option Explicit

Private Declare Function socket Lib "WSOCK32" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function closesocket Lib "WSOCK32" (ByVal s As Long) As Long
Private Declare Function connect Lib "WSOCK32" (ByVal s As Long, addr As SOCKADDR, ByVal NameLen As Long) As Long
Private Declare Function send Lib "WSOCK32" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Private Declare Function recv Lib "WSOCK32" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function inet_addr Lib "WSOCK32" (ByVal cp As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32" (ByVal wVR As Long, lpWSAD As Long) As Long
Private Declare Function WSACleanup Lib "WSOCK32" () As Long
Private Declare Function WSAAsyncSelect Lib "WSOCK32" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long

Private Declare Function CreateWindowExA Lib "USER32" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function RegisterClassExA Lib "USER32" (pcWndClassEx As WNDCLASSEX) As Integer
Private Declare Function DefWindowProcA Lib "USER32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Type WNDCLASSEX
    cbSize As Long
    style As Long
    lpfnWndProc As Long
    cbClsExtra As Long
    cbWndExtra As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
    hIconSm As Long
End Type

Private Type SOCKADDR
    sin_family                      As Integer
    sin_port                        As Integer
    sin_addr                        As Long
    sin_zero                        As String * 8
End Type

Private Const AF_INET = 2
Private Const PF_INET = 2
Private Const FD_READ = &H1&
Private Const FD_WRITE = &H2&
Private Const FD_CONNECT = &H10&
Private Const FD_CLOSE = &H20&
Private Const SOCK_STREAM = 1
Private Const IPPROTO_TCP = 6
Private Const WINSOCK_MESSAGE = 1025

Private wHwnd As Long

Public Function htons(ByVal lPort As Long) As Integer
    htons = ((((lPort And &HFF000000) \ &H1000000) And &HFF&) Or ((lPort And &HFF0000) \ &H100&) Or ((lPort And &HFF00&) * &H100&) Or ((lPort And &H7F&) * &H1000000) Or (IIf((lPort And &H80&), &H80000000, &H0)) And &HFFFF0000) \ &H10000
End Function

'--------
Public Function ProcessMessage(ByVal hWnd As Long, ByVal lMessage As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If lMessage = WINSOCK_MESSAGE Then
        Dim bBuffer(1 To 1024) As Byte
    
        Select Case lParam
            Case FD_CONNECT: Call WsSendData(wParam, StrConv("AAAAAAAAAA", vbFromUnicode))
            Case FD_WRITE:
            Case FD_READ:
                    Call recv(wParam, bBuffer(1), 1024, 0)
                    MsgBox StrConv(bBuffer, vbUnicode)
            Case FD_CLOSE: 'Jmp connect Routine
        End Select
        Exit Function
    End If
    ProcessMessage = DefWindowProcA(hWnd, lMessage, wParam, lParam)
End Function
'--------

Public Function WsInitialize(ByVal MyWndProc As Long, ByVal szSocketName As String) As Boolean
    Dim WNDC As WNDCLASSEX
    
    If wHwnd = 0 Then
        WNDC.cbSize = LenB(WNDC)
        WNDC.lpfnWndProc = MyWndProc
        WNDC.hInstance = App.hInstance
        WNDC.lpszClassName = szSocketName
    
        Call RegisterClassExA(WNDC) '0: Exit Function
        wHwnd = CreateWindowExA(0&, szSocketName, "", 0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, 0&) '0: Call UnregisterClass(szSocketName, App.hInstance)
    End If
    
    Call WSAStartup(&H101, 0&)
    Initialize = True
End Function
Public Sub WsTerminate()
    Call WSACleanup
End Sub

Public Function WsConnect(lRemoteHost As String, lPort As Long) As Long
    Dim SockData As SOCKADDR
    Dim hSocket As Long
    Dim lWsMsg As Long
    
    SockData.sin_family = AF_INET
    SockData.sin_port = htons(lPort) 'If sockdata.sin_port = INVALID_SOCKET Then Exit Function
    SockData.sin_addr = inet_addr(lRemoteHost) 'If sockdata.sin_addr = INADDR_NONE Then Exit Function
    hSocket = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP) 'If hSocket < 0 Then Exit Function

    Call connect(hSocket, SockData, 16)  ' If hSocket Then WsClose   Exit Function
    
    If WSAAsyncSelect(hSocket, wHwnd, ByVal WINSOCK_MESSAGE, ByVal FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE) Then
        lWsMsg = FD_CLOSE
    Else
        lWsMsg = FD_CONNECT
    End If
    
    Call ProcessMessage(0, WINSOCK_MESSAGE, hSocket, FD_CONNECT): WsConnect = hSocket
End Function
Public Function WsSendData(ByVal SocketIndex As Long, bMessage() As Byte) As Long
    If UBound(bMessage) > -1 Then
        WsSendData = send(SocketIndex, bMessage(0), (UBound(bMessage) - LBound(bMessage) + 1), 0)
    End If
End Function

    Private Sub Main()
    If WsInitialize(AddressOf ProcessMessage, "Server") Then
        If WsConnect("127.0.0.1", 7777) Then
            Do
                DoEvents
            Loop
        End If
    End If
End Sub