How to patch Adobe Flash Player (ocx v.11.2.202.233)

Since less than a year ago I patched the v10, today I wanted to also patch Adobe Flash Player v11 since it prevents you from saving data audio-video to disk.
One of the many functions CreateFileW of the ocx Adobe Flash Player prevent from reading the temporary files (xxx.tmp) having blocked the share in read-write, but this small modification changes the parameters for CreateFileW so that now the files are permanently on the temp folder and can also be read as you download a flv video streaming (beware: the temp files should be deleted every time, otherwise the folder temp is filled)

Works only who has the flash version 11.2.202.233.
Path: "C:\WINDOWS\system32\Macromed\Flash\Flash32_11_2_202_233.ocx"

Attention, if you make changes, remember to make a copy!

- v. 11.2.202.233 - not patched (from hex editor)-

  - v.11.2.202.233 - patched (from hex editor  2 bytes modified)-

 
 
 
 
 
 
 
 
   -view from debugger (parameters for CreateFileW) -

 
 
 

splitter horizontal from hooking mouse (with hook-subclassing shellcode)

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function CreateBitmapIndirect Lib "gdi32" (lpBitmap As BITMAP) As Long
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Const PATINVERT = &H5A0049       ' (DWORD) dest = pattern XOR dest
Private Const DSTINVERT = &H550009       ' (DWORD) dest = (NOT dest)
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long

Private dist As Integer

Private m_lPattern(0 To 3) As Long
Private m_hBrush As Long

Private Type BITMAP '24 bytes
   bmType As Long
   bmWidth As Long
   bmHeight As Long
   bmWidthBytes As Long
   bmPlanes As Integer
   bmBitsPixel As Integer
   bmBits As Long
End Type

Private Type RECT
   left As Long
   top As Long
   right As Long
   bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type


Dim cHookMouse As cHookCallback

Private Sub Form_Unload(Cancel As Integer)
    Set cHookMouse = Nothing
End Sub

Private Sub Form_Load()
    Dim tbm As BITMAP
    Dim hBm As Long
    
    Set cHookMouse = New cHookCallback
    Call cHookMouse.shk_SetHook(WH_MOUSE, , eMsgWhen.MSG_AFTER, , 1, Me)
    
   For i = 0 To 3
      m_lPattern(i) = &HAAAA5555
   Next i
   
   DestroyBrush
      
   ' Create a monochrome bitmap containing the desired pattern:
   tbm.bmType = 0
   tbm.bmWidth = 16
   tbm.bmHeight = 8
   tbm.bmWidthBytes = 2
   tbm.bmPlanes = 1
   tbm.bmBitsPixel = 1
   tbm.bmBits = VarPtr(m_lPattern(0))
   hBm = CreateBitmapIndirect(tbm)

   ' Make a brush from the bitmap bits
   m_hBrush = CreatePatternBrush(hBm)

   '// Delete the useless bitmap
   DeleteObject hBm
   
   dist = (pic2.top - pic1.Height)

End Sub

Private Sub DestroyBrush()
   If Not (m_hBrush = 0) Then
      DeleteObject m_hBrush
      m_hBrush = 0
   End If
End Sub

Private Sub PicContainer_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        Dim rc As RECT
        Dim rc2 As RECT
        
        GetWindowRect PicContainer.hwnd, rc
        GetWindowRect pic1.hwnd, rc2
        
        lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
        hOldBrush = SelectObject(lhDC, m_hBrush)
        
        PicContainer.Refresh
        PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT
        SelectObject lhDC, hOldBrush
        DeleteDC lhDC
    End If
End Sub

Private Sub PicContainer_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        Dim rc As RECT
        Dim rc2 As RECT
        
        GetWindowRect PicContainer.hwnd, rc
        GetWindowRect pic1.hwnd, rc2
        
        lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
        hOldBrush = SelectObject(lhDC, m_hBrush)
        
        PicContainer.Refresh
        PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT
        SelectObject lhDC, hOldBrush
        DeleteDC lhDC
        
        mouse_y = y
        If y < 10 Then Exit Sub
        If y >= PicContainer.Height - 10 Then Exit Sub
        pic1.Height = y
        pic2.top = pic1.Height + dist
        pic2.Height = PicContainer.Height - pic1.Height - dist
        
    End If
End Sub

Private Sub PicContainer_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        Dim rc As RECT
        Dim rc2 As RECT
        
        GetWindowRect PicContainer.hwnd, rc
        GetWindowRect pic1.hwnd, rc2
        
        lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
        hOldBrush = SelectObject(lhDC, m_hBrush)
        
        PicContainer.Refresh
        PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT 'doppio si riazzera
        PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT
        SelectObject lhDC, hOldBrush
        DeleteDC lhDC
    End If
End Sub

' ordinal #1 from vtable function VB (subclassing shellcode)
Private Sub HookProcMouse(ByVal bBefore As Boolean, _
                        ByRef bHandled As Boolean, _
                        ByRef lReturn As Long, _
                        ByVal nCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long, _
                        ByVal lHookType As eHookType, _
                        ByRef lParamUser As Long)

        If nCode > 0 Then
            Dim hwnd As Long
            Dim pt As POINTAPI
            
            GetCursorPos pt
            hwnd = WindowFromPoint(pt.x, pt.y)
            If hwnd = frm.PicContainer.hwnd Then
                MousePointer = 99
                MouseIcon = imgCursorSplitterHorizontal.Picture
            Else
                MousePointer = 0
            End If
        End If
End Sub

avoiding flicker from form child mdi when one child is maximized

frms() is a array of child form mdi

EnumChildWindows frmMdi.hWnd, AddressOf EnumChildProc, 0

Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
    Dim strClass As String

    strClass = Space(255)
    ret = GetClassName(hWnd, strClass, 255)
    If Left(strClass, 9) = "MDIClient" Then
        hwndMDI = hWnd ' << hwndMDI is handle of Mdi client
        EnumChildProc = False
    Else
        EnumChildProc = True
    End If
End Function



Private Sub TabStrip_Click()
        .......
    If frms(TabStrip.Tag).WindowState = 2 Then
        ret = ShowWindow(hwndMDI, SW_HIDE)
        frms(TabStrip.SelectedItem.Index).WindowState = 2
        frms(TabStrip.SelectedItem.Index).Hide
        frms(TabStrip.SelectedItem.Index).ZOrder
        frms(TabStrip.SelectedItem.Index).Show
        ret = ShowWindow(hwndMDI, SW_SHOWNA)
    Else
        frms(TabStrip.SelectedItem.Index).ZOrder
    End If
        ........
End Sub

VB6: get PEB - LDR_MODULE - RTL_USER_PROCESS_PARAMETERS

module

************************************************************************
' BY DAVIDE CHIAPPETTA 'THE JOHNNYMNEMONIC'
' http://www.facebook.com/davide.chiappetta
'***********************************************************************


Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As Long, ByVal ByteLen As Long)
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As String, ByRef hWnd As Long, 
ByRef msg As Long, ByRef wParam As Long, ByRef lParam As Long) As Long

'typedef struct _PEB_LDR_DATA {
'  ULONG                   Length;
'  BOOLEAN                 Initialized;                      //warning!! -> DWORD
'  PVOID                   SsHandle;
'  LIST_ENTRY              InLoadOrderModuleList;            //Doubly linked list containing pointers to LDR_MODULE structure for 
previous and next module in load order.
'  LIST_ENTRY              InMemoryOrderModuleList;          //As above, but in memory placement order.
'  LIST_ENTRY              InInitializationOrderModuleList;  //As InLoadOrderModuleList, but in initialization order.
'} PEB_LDR_DATA;
'
' typedef struct LIST_ENTRY
' {
'   struct LIST_ENTRY *Flink;  //FORWARD LINK CHAIN
'   struct LIST_ENTRY *Blink;  //BACK LINK CHAIN
'};


'  typedef struct _LDR_MODULE {
'  LIST_ENTRY              InLoadOrderModuleList;            //Pointers to previous and next LDR_MODULE in load order.
'  LIST_ENTRY              InMemoryOrderModuleList;          //Pointers to previous and next LDR_MODULE in memory placement order.
'  LIST_ENTRY              InInitializationOrderModuleList;  //Pointers to previous and next LDR_MODULE in initialization order.
'  PVOID                   BaseAddress;
'  PVOID                   EntryPoint;
'  ULONG                   SizeOfImage;
'  UNICODE_STRING          FullDllName;
'  UNICODE_STRING          BaseDllName;
'  ULONG                   Flags;
'  SHORT                   LoadCount;                        //quante volte è stato caricato in memoria (reference_count++)
'  SHORT                   TlsIndex;
'  LIST_ENTRY              HashTableEntry;                   //LIST_ENTRY contains pointer to LdrpHashTable. Both prev and next 
values are the same. LdrpHashTable it is table of LIST_ENTRY structures points to LDR_MODULE for current process.
'
'  ULONG                   TimeDateStamp;                    //lo stesso che si trova nel PE della DLL
'
'}LDR_MODULE;


Public Type LIST_ENTRY
    Flink As Long
    Blink As Long
End Type

 Public Type PEB_LDR_DATA
    Length As Long
    Initialized As Long
    SsHandle As Long
    InLoadOrderModuleList As LIST_ENTRY
    InMemoryOrderModuleList As LIST_ENTRY
    InInitializationOrderModuleList As LIST_ENTRY
 End Type
 
 Public Type UNICODE_STRING
    Length As Integer
    MaximumLength As Integer
    buffer As Long
 End Type
 
 Public Type LDR_MODULE
    a_InLoadOrderModuleList As LIST_ENTRY          '//Pointers to previous and next LDR_MODULE in load order.
    b_InMemoryOrderModuleList As LIST_ENTRY           '//Pointers to previous and next LDR_MODULE in memory placement order.
    c_InInitializationOrderModuleList As LIST_ENTRY   '//Pointers to previous and next LDR_MODULE in initialization order.
    d_BaseAddress As Long
    e_vEntryPoint As Long
    f_SizeOfImage As Long
    g_FullDllName As UNICODE_STRING
    h_BaseDllName As UNICODE_STRING
    i_Flags As Long
    l_LoadCount As Integer                      '//quante volte è stato caricato in memoria (reference_count++)
    m_TlsIndex As Integer
    n_HashTableEntry As LIST_ENTRY                   '//LIST_ENTRY contains pointer to LdrpHashTable. Both prev and next values are 
the same. LdrpHashTable it is table of LIST_ENTRY structures points to LDR_MODULE for current process.
    o_TimeDateStamp As Long                   '//lo stesso che si trova nel PE della DLL
End Type

'typedef struct RTL_DRIVE_LETTER_CURDIR
' {
'  USHORT Flags;
'  USHORT Length;
'  ULONG TimeStamp;
'  UNICODE_STRING DosPath;
'} RTL_DRIVE_LETTER_CURDIR, *PRTL_DRIVE_LETTER_CURDIR;

'typedef struct _RTL_USER_PROCESS_PARAMETERS  //RTL_USER_PROCESS_PARAMETERS is located at address 0x20000 (for all processes created 
by call WIN32 API CreateProcess).
'{
'  ULONG                   MaximumLength;            //Should be set before call RtlCreateProcessParameters.
'  ULONG                   Length;                   //Length of valid structure.
'  ULONG                   Flags;
'  ULONG                   DebugFlags;
'  PVOID                   ConsoleHandle;            //HWND to console window associated with process (if any).
'  ULONG                   ConsoleFlags;
'  HANDLE                  StdInputHandle;
'  HANDLE                  StdOutputHandle;
'  HANDLE                  StdErrorHandle;
'  UNICODE_STRING          CurrentDirectoryPath;     //Specified in DOS-like symbolic link path, ex: "C:\WinNT\SYSTEM32"
'  HANDLE                  CurrentDirectoryHandle;   //Handle to FILE object.
'  UNICODE_STRING          DllPath;                  //DOS-like paths separated by ';' where system shoult search for DLL files.
'  UNICODE_STRING          ImagePathName;            //Full path in DOS-like format to process'es file image.
'  UNICODE_STRING          CommandLine;              //Command line.
'  PVOID                   Environment;              //Pointer to environment block (see RtlCreateEnvironment).
'  ULONG                   StartingPositionLeft;
'  ULONG                   StartingPositionTop;
'  ULONG                   Width;
'  ULONG                   Height;
'  ULONG                   CharWidth;
'  ULONG                   CharHeight;
'  ULONG                   ConsoleTextAttributes;
'  ULONG                   WindowFlags;
'  ULONG                   ShowWindowFlags;
'  UNICODE_STRING          WindowTitle;
'  UNICODE_STRING          DesktopName;              //Name of WindowStation and Desktop objects, where process is assigned.
'  UNICODE_STRING          ShellInfo;
'  UNICODE_STRING          RuntimeData;
'  RTL_DRIVE_LETTER_CURDIR DLCurrentDirectory[0x20];
'} RTL_USER_PROCESS_PARAMETERS, *PRTL_USER_PROCESS_PARAMETERS;

Public Type RTL_DRIVE_LETTER_CURDIR
    Flags As Integer
    Length As Integer
    TimeStamp As Long
    DosPath As UNICODE_STRING
End Type

Public Type RTL_USER_PROCESS_PARAMETERS            'is located at address 0x20000 (for all processes created by call WIN32 API 
CreateProcess).
    a_MaximumLength As Long                           '//Should be set before call RtlCreateProcessParameters.
    b_Length As Long                                  '//Length of valid structure.
    a_Flags As Long
    a_DebugFlags As Long
    c_ConsoleHandle As Long                           '//HWND to console window associated with process (if any).
    d_ConsoleFlags As Long
    e_StdInputHandle As Long
    f_StdOutputHandle As Long
    g_StdErrorHandle As Long
    h_CurrentDirectoryPath As UNICODE_STRING          '//Specified in DOS-like symbolic link path, ex: "C:\WinNT\SYSTEM32"
    i_CurrentDirectoryHandle As Long                  '//Handle to FILE object.
    l_DllPath As UNICODE_STRING                       '//DOS-like paths separated by ';' where system shoult search for DLL files.
    m_ImagePathName As UNICODE_STRING                 '//Full path in DOS-like format to process'es file image.
    n_CommandLine As UNICODE_STRING                   '//Command line.
    o_Environment As Long                             '//Pointer to environment block (see RtlCreateEnvironment).
    p_StartingPositionLeft As Long
    q_StartingPositionTop As Long
    r_Width As Long
    s_Height As Long
    t_CharWidth As Long
    u_CharHeight As Long
    v_ConsoleTextAttributes As Long
    z_WindowFlags As Long
    z1_ShowWindowFlags As Long
    z2_WindowTitle As UNICODE_STRING
    z3_DesktopName As UNICODE_STRING                   '//Name of WindowStation and Desktop objects, where process is assigned.
    z4_ShellInfo As UNICODE_STRING
    z5_RuntimeData As UNICODE_STRING
    z6_DLCurrentDirectory(&H20) As RTL_DRIVE_LETTER_CURDIR ' array of 0x20
End Type

Public Function getBuffUNICODE_STRING(us As UNICODE_STRING) As String
    Dim tmpBuff() As Byte
    
    'essendo gia unicode (0 alternati a caratteri) nel vb diventa stringa senza conversione perche il vb ha le stringhe unicode, (il C/C++ mentre le stringhe sono ascii e allora ci vuole la conversione unicode ascii)
    ReDim tmpBuff(us.Length) As Byte
    CopyMemory tmpBuff(0), ByVal us.buffer, us.Length
    getBuffUNICODE_STRING = tmpBuff
End Function 


form

************************************************************************
' BY DAVIDE CHIAPPETTA 'THE JOHNNYMNEMONIC'
' http://www.facebook.com/davide.chiappetta
'***********************************************************************

Private Sub Form_Load()
    Dim asm As String
    Dim lngRet As Long
    Dim ped_data  As PEB_LDR_DATA
    Dim ldr As LDR_MODULE
    Dim ptrAddrNext As Long
    Dim rtlUserProc As RTL_USER_PROCESS_PARAMETERS

'*************************************************************************
    'get PEB and then LDR_MODULE
    
    '7C881AFB    55                  PUSH EBP
    '7C881AFC    8BEC                MOV EBP,ESP
    '7C881AFE    64:A1 30000000      MOV EAX,FS:[30] '<<<< PEB
    '7C881B04    8B40 0C             MOV EAX,[EAX+C] '<<<< LDR_MODULE
    '7C881B07    8BE5                MOV ESP,EBP
    '7C881B09    5D                  POP EBP
    '7C881B0A    C3                  RETN    

    asm = makeAsm("55")
    asm = asm & makeAsm("8BEC")
    asm = asm & makeAsm("64A130000000") '<<<< PEB
    asm = asm & makeAsm("8B400C")       '<<<< LDR_MODULE
    asm = asm & makeAsm("8BE5")
    asm = asm & makeAsm("5D")
    asm = asm & makeAsm("C3")
'*************************************************************************    
    lngRet = CallWindowProc(asm, 0, 0, 0, 0)
    
    CopyMemory ped_data, ByVal lngRet, Len(ped_data)
    
    ptrAddrNext = ped_data.InLoadOrderModuleList.Flink
    
    Do While (True)
        a = a + 1
        CopyMemory ldr, ByVal ptrAddrNext, Len(ldr)
        
        With ldr
        
            If .d_BaseAddress = 0 Then
                Exit Do
            End If
            
            Debug.Print Hex(.a_InLoadOrderModuleList.Flink)
            Debug.Print Hex(.b_InMemoryOrderModuleList.Flink)
            Debug.Print Hex(.c_InInitializationOrderModuleList.Flink)
            Debug.Print Hex(.d_BaseAddress)
            Debug.Print Hex(.e_vEntryPoint)
            Debug.Print Hex(.f_SizeOfImage)
            Debug.Print getBuffUNICODE_STRING(.g_FullDllName)
            Debug.Print getBuffUNICODE_STRING(.h_BaseDllName)
            Debug.Print Hex(.i_Flags)
            Debug.Print "dll caricata " & Hex(.l_LoadCount) & " volte"
            Debug.Print Hex(.m_TlsIndex)
            Debug.Print Hex(.n_HashTableEntry.Flink)
            Debug.Print Hex(.o_TimeDateStamp)
            
            'next structure LDR_MODULE
            ptrAddrNext = .a_InLoadOrderModuleList.Flink
        End With
    Loop
    
'*************************************************************************    
 'get PEB and then RTL_USER_PROCESS_PARAMETERS
    
    '7C881AFB    55                  PUSH EBP
    '7C881AFC    8BEC                MOV EBP,ESP
    '7C881AFE    64:A1 30000000      MOV EAX,FS:[30]  '<<<< PEB
    '........    8B40 10             MOV EAX,[EAX+10] '<<<< RTL_USER_PROCESS_PARAMETERS
    '7C881B07    8BE5                MOV ESP,EBP
    '7C881B09    5D                  POP EBP
    '7C881B0A    C3                  RETN
    
    asm = makeAsm("55")
    asm = asm & makeAsm("8BEC")
    asm = asm & makeAsm("64A130000000") '<<<< PEB
    asm = asm & makeAsm("8B4010")       '<<<< RTL_USER_PROCESS_PARAMETERS
    asm = asm & makeAsm("8BE5")
    asm = asm & makeAsm("5D")
    asm = asm & makeAsm("C3")
'*************************************************************************
    lngRet = CallWindowProc(asm, 0, 0, 0, 0) 'ret usually is address 0x2000
    
    CopyMemory rtlUserProc, ByVal lngRet, Len(rtlUserProc)
    
    With rtlUserProc
        Debug.Print Hex(.a_MaximumLength)
        Debug.Print Hex(.b_Length)
        Debug.Print Hex(.a_Flags)
        Debug.Print Hex(.a_DebugFlags)
        Debug.Print Hex(.c_ConsoleHandle)
        Debug.Print Hex(.d_ConsoleFlags)
        Debug.Print Hex(.e_StdInputHandle)
        Debug.Print Hex(.f_StdOutputHandle)
        Debug.Print Hex(.g_StdErrorHandle)
        Debug.Print getBuffUNICODE_STRING(.h_CurrentDirectoryPath)
        Debug.Print Hex(.i_CurrentDirectoryHandle)
        Debug.Print getBuffUNICODE_STRING(.l_DllPath)
        Debug.Print getBuffUNICODE_STRING(.m_ImagePathName)
        Debug.Print getBuffUNICODE_STRING(.n_CommandLine)
        Debug.Print Hex(.o_Environment)
        Debug.Print Hex(.p_StartingPositionLeft)
        Debug.Print Hex(.q_StartingPositionTop)
        Debug.Print Hex(.r_Width)
        Debug.Print Hex(.s_Height)
        Debug.Print Hex(.t_CharWidth)
        Debug.Print Hex(.u_CharHeight)
        Debug.Print Hex(.v_ConsoleTextAttributes)
        Debug.Print Hex(.z_WindowFlags)
        Debug.Print Hex(.z1_ShowWindowFlags)
        Debug.Print getBuffUNICODE_STRING(.z2_WindowTitle)
        Debug.Print getBuffUNICODE_STRING(.z3_DesktopName)
        Debug.Print getBuffUNICODE_STRING(.z4_ShellInfo)
        Debug.Print getBuffUNICODE_STRING(.z5_RuntimeData)
        
        'RTL_DRIVE_LETTER_CURDIR
        For a = 0 To &H20 - 1
            If .z6_DLCurrentDirectory(a).DosPath.Length > 0 Then
                Debug.Print Hex(.z6_DLCurrentDirectory(a).Flags)
                Debug.Print Hex(.z6_DLCurrentDirectory(a).TimeStamp)
                Debug.Print getBuffUNICODE_STRING(.z6_DLCurrentDirectory(a).DosPath)
            End If
        Next a
    End With
    
End Sub
Function makeAsm(ByVal riga) As String
    For a = 1 To Len(riga) Step 2
        strAsm = strAsm & Chr("&H" & Mid(riga, a, 2))
    Next a
    makeAsm = strAsm
End Function

VB6: Get Keys and SubKeys recursively and get Values

'***************************************
' by Davide Chiappetta
'***************************************

Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)

Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

   Public Declare Function RegEnumValue Lib "advapi32.dll" _
                   Alias "RegEnumValueA" _
                   (ByVal hKey As Long, _
                   ByVal dwIndex As Long, _
                   ByVal lpValueName As String, _
                   lpcbValueName As Long, _
                   ByVal lpReserved As Long, _
                   lpType As Long, _
                   lpData As Any, _
                   lpcbData As Long) As Long

Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Public Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, ByRef lpcbClass As Long, ByRef lpReserved As Long, ByRef lpcSubKeys As Long, ByRef lpcbMaxSubKeyLen As Long, ByRef lpcbMaxClassLen As Long, ByRef lpcValues As Long, ByRef lpcbMaxValueNameLen As Long, ByRef lpcbMaxValueLen As Long, ByRef lpcbSecurityDescriptor As Long, ByRef lpftLastWriteTime As FILETIME) As Long

            
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" _
   Alias "RegEnumKeyExA" (ByVal hCurKey As Long, _
   ByVal dwIndex As Long, ByVal lpName As String, _
  lpcbName As Long, ByVal lpReserved As Long, _
   ByVal lpClass As String, lpcbClass As Long, _
  lpftLastWriteTime As FILETIME) As Long

            
Public Const ERROR_SUCCESS = 0&
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003

Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const SYNCHRONIZE = &H100000
Public Const KEY_ALL_ACCESS = _
    ((STANDARD_RIGHTS_ALL Or _
    KEY_QUERY_VALUE Or _
    KEY_SET_VALUE Or _
    KEY_CREATE_SUB_KEY Or _
    KEY_ENUMERATE_SUB_KEYS Or _
    KEY_NOTIFY Or KEY_CREATE_LINK) And _
    (Not SYNCHRONIZE))
    
Public Const KEY_READ = 131097
Public Const ERROR_NO_MORE_ITEMS = 259&
Public Const MAX_LENGTH As Long = 2048
Public m_SelectedSection As Long

Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_EXPAND_SZ = 2
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_NONE = 0
Public Const REG_RESOURCE_LIST = 8
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Public Const REG_SZ = 1

Public g_sSubKey As String



Public Sub GetRecursiveSubkeys(ByVal hRoot As Long, ByVal key_name As String)
Dim hKey As Long
Dim subkeys As Collection
Dim subkey_num As Long
Dim length As Long
Dim subkey_name As String

    ' Open the key.
    If RegOpenKeyEx(hRoot, key_name, 0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS Then
        Exit Sub
    End If
    ' Enumerate the subkeys.
    Set subkeys = New Collection
    subkey_num = 0
    
    Do
        ' Enumerate subkeys until we get an error.
        length = 256
        subkey_name = Space$(length)
        If RegEnumKey(hKey, subkey_num, subkey_name, length) <> ERROR_SUCCESS Then
            RegCloseKey hKey
            Exit Do
        End If
        
        subkey_num = subkey_num + 1
        subkey_name = Left$(subkey_name, InStr(subkey_name, Chr$(0)) - 1)
        subkeys.Add subkey_name
    Loop
    For subkey_num = 1 To subkeys.Count
        DoEvents
        'trovo ora i valori di ogni sottochiave trovata sopra e le associo per lo show con le varie sottochiavi trovate
        g_sSubKey = g_sSubKey & key_name & "\" & subkeys(subkey_num) & vbCrLf
        sValue = GetEnumValue(hRoot, key_name & "\" & subkeys(subkey_num))
        If sValue <> "" Then
            g_sSubKey = g_sSubKey & sValue & vbCrLf
        End If
        GetRecursiveSubkeys hRoot, key_name & "\" & subkeys(subkey_num)
    Next subkey_num
    RegCloseKey hKey
End Sub


Public Sub GetKeyAndSubKey(ByVal hRoot As Long, ByVal key_name As String)
Dim pos As Integer
Dim parent_key_name As String
Dim parent_hKey As Long
    If Right$(key_name, 1) = "\" Then key_name = Left$(key_name, Len(key_name) - 1)

    'value first time for root key
    g_sSubKey = key_name & vbCrLf
    sValueRoot = GetEnumValue(hRoot, key_name) 'find the value root key
    If sValueRoot <> "" Then
        g_sSubKey = g_sSubKey & sValueRoot & vbCrLf
    End If
    'start recursion
    GetRecursiveSubkeys hRoot, key_name
    
End Sub

 Function GetEnumValue(ByVal hRoot As Long, ByVal key_name As String) As String
     Dim res As Long
      
     Dim Index As Long
     Dim ValueString As String
     Dim ValueStringLen As Long
      
     Dim DataType As Long
      
     Dim DataString As String
     Dim DataStringLen As Long
     Dim hKey As Long
     Dim sNameAndValue As String
    
     If RegOpenKeyEx(hRoot, key_name, 0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS Then Exit Function
    
     Index = 0
     Do
      'Initialise Strings each time
      ValueStringLen = MAX_LENGTH
      ValueString = Space(ValueStringLen)
        
      DataType = 0
        
      DataStringLen = MAX_LENGTH
      DataString = Space(DataStringLen)
     
      'The ByVal Keyword before the DataString is essential
      res = RegEnumValue(hKey, Index, ValueString, ValueStringLen, 0, DataType, ByVal DataString, DataStringLen)
      If res = ERROR_NO_MORE_ITEMS Then Exit Do
      
      If (res = ERROR_SUCCESS And ValueStringLen > 0) Or (res = ERROR_SUCCESS And DataStringLen > 0) Then

            Dim ptrWord As Long
            
            Select Case DataType
             Case REG_BINARY
              sType = "REG_BINARY"
                sValue = ""
                For a = 1 To DataStringLen - 1
                  If a = 20 Then Exit For
                  chars = Mid(DataString, a, 1)
                  If chars < Chr(32) Then chars = "."
                  sValue = sValue & chars
                Next a
             Case REG_DWORD
                sType = "DWORD"
                CopyMemory ptrWord, ByVal DataString, 4
                sValue = "0x" & Hex(ptrWord)
             Case REG_NONE
                sType = "REG_NONE"
             Case REG_LINK
                sType = "REG_LINK"
             Case REG_RESOURCE_REQUIREMENTS_LIST
                sType = "REG_RESOURCE_REQUIREMENTS_LIST"
                sValue = Mid(DataString, 1, InStr(DataString, Chr(0)) - 1)
             Case REG_RESOURCE_LIST
                sType = "REG_RESOURCE_LIST"
                sValue = Mid(DataString, 1, InStr(DataString, Chr(0)) - 1)
             Case REG_EXPAND_SZ
                sType = "REG_EXPAND_SZ"
                sValue = Mid(DataString, 1, InStr(DataString, Chr(0)) - 1)
             Case REG_SZ
                sType = "REG_SZ"
                sValue = Mid(DataString, 1, InStr(DataString, Chr(0)) - 1)
             Case REG_MULTI_SZ
                sType = "REG_MULTI_SZ"
                sValue = Mid(DataString, 1, InStr(DataString, Chr(0)) - 1)
             Case Else
                sType = "UNKNOWN"
                sValue = Left(DataString, DataStringLen - 1)
            End Select
            
      sName = Left(ValueString, ValueStringLen)
      
      If sName = "" Then sName = "(Default)"
        sNameAndValue = sNameAndValue & vbTab & sName & ": " & vbTab & sValue & vbTab & " [" & sType & "]" & vbCrLf
      End If

      Index = Index + 1
     Loop While res <> ERROR_NO_MORE_ITEMS
RegCloseKey hKey
GetEnumValue = sNameAndValue
End Function

Private Sub DeleteSubkeys(ByVal section As Long, ByVal key_name As String)
Dim hKey As Long
Dim subkeys As Collection
Dim subkey_num As Long
Dim length As Long
Dim subkey_name As String

    ' Open the key.
    If RegOpenKeyEx(section, key_name, _
        0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS _
    Then
        MsgBox "Error opening key '" & key_name & "'"
        Exit Sub
    End If

    ' Enumerate the subkeys.
    Set subkeys = New Collection
    subkey_num = 0
    Do
        ' Enumerate subkeys until we get an error.
        length = 256
        subkey_name = Space$(length)
        If RegEnumKey(hKey, subkey_num, _
            subkey_name, length) _
                <> ERROR_SUCCESS Then Exit Do
        subkey_num = subkey_num + 1

        subkey_name = Left$(subkey_name, InStr(subkey_name, Chr$(0)) - 1)
        subkeys.Add subkey_name
    Loop
    
    ' Recursively delete the subkeys and their subkeys.
    For subkey_num = 1 To subkeys.Count
        ' Delete the subkey's subkeys.
        DeleteSubkeys section, key_name & "\" & subkeys(subkey_num)

        ' Delete the subkey.
        RegDeleteKey hKey, subkeys(subkey_num)
    Next subkey_num

    ' Close the key.
    RegCloseKey hKey
End Sub

' Delete this key.
Public Sub RecursiveDeleteKey(ByVal section As Long, ByVal key_name As String)
Dim pos As Integer
Dim parent_key_name As String
Dim parent_hKey As Long

    If Right$(key_name, 1) = "\" Then key_name = Left$(key_name, Len(key_name) - 1)

    ' Delete the key's subkeys.
    DeleteSubkeys section, key_name

    ' Get the parent's name.
    pos = InStrRev(key_name, "\")
    If pos = 0 Then
        ' This is a top-level key.
        ' Delete it from the section.
        RegDeleteKey section, key_name
    Else
        ' This is not a top-level key.
        ' Find the parent key.
        parent_key_name = Left$(key_name, pos - 1)
        key_name = Mid$(key_name, pos + 1)

        ' Open the parent key.
        If RegOpenKeyEx(section, _
            parent_key_name, _
            0&, KEY_ALL_ACCESS, parent_hKey) <> ERROR_SUCCESS _
        Then
            MsgBox "Error opening parent key"
        Else
            ' Delete the key from its parent.
            RegDeleteKey parent_hKey, key_name

            ' Close the parent key.
            RegCloseKey parent_hKey
        End If
    End If
End Sub

'******************************************************
' main: (create button and textbox etc.)
' example:
' HKEY_CLASSES_ROOT = &H80000000 
' GetKeyAndSubKey &H80000000 , "CLSID"  'es: lista all CLSID and Values
' RecursiveDeleteKey &H80000000 , "Excel.Sheet.5"  'es: delete all Excel.Sheet.5 and Values
'******************************************************

how to use OleCreatePictureIndirect for ResizePicture (...)

Public Type PictGuid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Public Type PictDescGeneric
pdgSize As Long
pdcPicType As Long
pdcHandle As Long
pdcExtraA As Long
pdcExtraB As Long
End Type

Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDescGeneric, riid As PictGuid, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long

Public Function ResizePicture(Pic As StdPicture, lWidth As Long, lHeight As Long) As StdPicture
Dim PicDC As Long
Dim PicBM As Long
Dim PicOBJ As Long
Dim Pic2DC As Long
Dim PicGUID As PictGuid
Dim PicDesc As PictDescGeneric
PicDC = CreateCompatibleDC(0)
PicBM = CreateCompatibleBitmap(0, lWidth, lHeight)
PicOBJ = SelectObject(PicDC, PicBM)
Pic2DC = CreateCompatibleDC(0)
SelectObject Pic2DC, Pic.Handle
StretchBlt PicDC, 0, 0, lWidth, lHeight, Pic2DC, 0, 0, Pic.Width, Pic.Height, vbSrcCopy
DeleteDC Pic2DC
SelectObject PicDC, PicOBJ
With PicGUID
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(3) = &HAA
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
With PicDesc
.pdgSize = Len(PicDesc)
.pdcPicType = 1
.pdcHandle = PicBM
End With
OleCreatePictureIndirect PicDesc, PicGUID, 1, ResizePicture
DeleteDC PicDC
DeleteObject PicBM
End Function

2 way to create a VB Picture from a GDI Picture Handle

*********************
1: (es: Picture added to ImageList)
*********************

    Dim hndRsrc As Long
    Dim tPicConv As PictDesc
    Dim IGuid As GUID
    Dim arrNewPic As Picture


    hndRsrc = ExtractIcon(App.hInstance, filenameAppz, indexIcon)

    With tPicConv
        .cbSizeofStruct = Len(tPicConv)
        .PicType = TYPE_ICON
        .hImage = hndRsrc '<<<< associate to tPicConv(PictDesc)
    End With

    With IGuid
        .Data1 = &H7BF80980 'IPicture    {7BF80980-BF32-101A-8BBB-00AA00300CAB}  interface
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With

    OleCreatePictureIndirect tPicConv, IGuid, True, arrNewPic
    indexImageList = indexImageList + 1
    Form1.ImageList.ListImages.Add indexImageList, , arrNewPic               
    Form1.List.ListItems.Add , , "string blabla", , , indexImageList

*********************
2: (create a control Picture1 on Form as store temporary)
*********************
* es: indexIcon=-123 (-123 must really match in the icon)

    hndRsrc = ExtractIcon(App.hInstance, filenameAppz, indexIcon)
    ret = DrawIconEx(Form1.Picture1.hdc, 0, 0, hndRsrc, 24, 24, 0, 0, 3)
    Form1.Picture1.Refresh
    indexImageList = indexImageList + 1
    Form1.ImageList.ListImages.Add indexImageList, , Form1.Picture1.Image
    Form1.List.ListItems.Add , , "string blabla", , indexImageList


************************************************
* Format IPicture (COM)

'IPicture    {7BF80980-BF32-101A-8BBB-00AA00300CAB}  interface
'              Prop Get  Handle  (), Ret:VT_INT
'              Prop Get  hPal    (), Ret:VT_INT
'              Prop Get  Type    (), Ret:VT_I2
'              Prop Get  Width   (), Ret:VT_I4
'              Prop Get  Height  (), Ret:VT_I4
'              Method    Render  (hdc:VT_INT, x:VT_I4, y:VT_I4, cx:VT_I4, cy:VT_I4, xSrc:VT_I4, ySrc:VT_I4, cxSrc:VT_I4, cySrc:VT_I4, prcWBounds:VT_VOID), Ret:VT_HRESULT
'              Prop Put  hPal    (), Ret:VT_INT
'              Prop Get  CurDC   (), Ret:VT_INT
'              Method    SelectPicture   (hdcIn:VT_INT, phdcOut:VT_INT, phbmpOut:VT_INT), Ret:VT_HRESULT
'              Prop Get  KeepOriginalFormat  (), Ret:VT_BOOL
'              Prop Put  KeepOriginalFormat  (), Ret:VT_BOOL
'              Method PictureChanged(), ret: VT_HRESULT
'              Method    SaveAsFile  (pstm:VT_VOID, fSaveMemCopy:VT_BOOL, pcbSize:VT_I4), Ret:VT_HRESULT
'              Prop Get  Attributes  (), Ret:VT_I4
'              Method    SetHdc  (hdc:VT_INT), Ret:VT_HRESULT

*****************************************************************
** Result: Icon On ListView
*****************************************************************