Private Type st
    ss As String
    ll As Long
End Type

Private Sub Form_Load()
    Dim stt As st
    stt.ss = "aaaaaa"
    stt.ll = 500
    MsgBox Len(stt)
    End
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

Option Explicit

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
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 WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

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 Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Sub CopyMemory Lib "MSVBVM60" Alias "__vbaCopyBytes" (ByVal Size As Long, Dest As Any, Source As Any)

Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PAGE_READWRITE = &H4
Private Const INFINITE = &HFFFFFFFF

Public Function ExecuteDll(lPid As Long) As Boolean
    Dim hVictim As Long
    Dim hInject As Long
    Dim lParamAddress As Long
    Dim lStartAddress As Long
    Dim bB() As Byte
    
    hVictim = OpenProcess(PROCESS_ALL_ACCESS, 0, lPid)
    If hVictim = 0 Then Exit Function
    '===
    Call PutThunk("68" & GetLng(500) & "68" & GetLng(500), bB)
    '===
    lStartAddress = GetProcAddress(GetModuleHandle("KERNEL32"), "Beep"): If lStartAddress = 0 Then GoTo Error
    lParamAddress = VirtualAllocEx(hVictim, 0&, UBound(bB), MEM_COMMIT, PAGE_READWRITE): If lParamAddress = 0 Then GoTo Error
    Call WriteProcessMemory(hVictim, ByVal lParamAddress, ByVal VarPtr(bB(0)), UBound(bB), ByVal 0&)
    '===
    hInject = CreateRemoteThread(hVictim, ByVal 0&, 0&, ByVal lStartAddress, ByVal lParamAddress, 0, ByVal 0&)
    If hInject = 0 Then: GoTo Error
    '===
    
    Call WaitForSingleObject(hInject, INFINITE)
    Call CloseHandle(hVictim)
    Call CloseHandle(hInject)
    
    ExecuteDll = True
    Exit Function
    
Error:
    Call CloseHandle(hInject)
    Call CloseHandle(hVictim)
    
    ExecuteDll = False
End Function

Private Function GetLng(ByVal lLng As Long) As String
    Dim lTMP                        As Long
 
    lTMP = (((lLng And &HFF000000) \ &H1000000) And &HFF&) Or ((lLng And &HFF0000) \ &H100&) Or ((lLng And &HFF00&) * &H100&) Or ((lLng And &H7F&) * &H1000000) ' by Mike D Sutton
    If (lLng And &H80&) Then lTMP = lTMP Or &H80000000
 
    GetLng = String$(8 - Len(Hex$(lTMP)), "0") & Hex$(lTMP)
End Function
 
Private Sub PutThunk(ByVal sThunk As String, ByRef bvRet() As Byte)
    Dim i As Long
    
    ReDim bvRet((Len(sThunk) \ 2) - 1)
    
    For i = 0 To Len(sThunk) - 1 Step 2
        bvRet(i / 2) = CByte("&H" & Mid$(sThunk, i + 1, 2))
    Next i
End Sub

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 GetMenu Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "USER32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "USER32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Const MF_BYPOSITION = &H400&

Public Sub SetMenuIcon(cForm As Form, cMenu As Long, cSubMenu As Long, cBitmap As ListImage)
    On Error Resume Next
    Dim hMenu As Long
    Dim hSubMenu As Long
    Dim Ret As Long
     
     hMenu = GetMenu(cForm.hwnd)
     hSubMenu = GetSubMenu(hMenu, cMenu)
     Ret = SetMenuItemBitmaps(hSubMenu, cSubMenu, MF_BYPOSITION, Val(cBitmap.Picture), Val(cBitmap.Picture))
     
End Sub