Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Sub Command1_Click()
    
  On Error Resume Next
    Dim s_hwnd&, i&, s_path$, pid&
    
    s_hwnd& = FindWindow(vbNullString, "Form1") 'or
    's_hwnd& = FindWindow("ThunderRT6FormDC", vbNullString)
    
    i = GetWindowThreadProcessId(s_hwnd, pid)    'Pid
    s_path = GetProcessPathByProcessID(pid)      '获取程序全路径
    'i = ExtractIcon(s_hwnd&, s_path, -1)        '取图标数量
    i = ExtractIcon(s_hwnd&, s_path, 0)
    Me.Print
    Me.AutoRedraw = -1
    DrawIcon Me.hdc, 25, 25, i
    Me.Refresh
End Sub
Private Function GetProcessPathByProcessID(pid As Long) As String
     On Error GoTo Z
     Dim cbNeeded As Long
     Dim szBuf(1 To 250) As Long
     Dim Ret As Long
     Dim szPathName As String
     Dim nSize As Long
     Dim hProcess As Long
     hProcess = OpenProcess(&H400 Or &H10, 0, pid)
     If hProcess <> 0 Then
        Ret = EnumProcessModules(hProcess, szBuf(1), 250, cbNeeded)
        If Ret <> 0 Then
            szPathName = Space(260)
            nSize = 500
            Ret = GetModuleFileNameExA(hProcess, szBuf(1), szPathName, nSize)
            GetProcessPathByProcessID = Left(szPathName, Ret)
        End If
     End If

     Ret = CloseHandle(hProcess)
     If GetProcessPathByProcessID = "" Then
        GetProcessPathByProcessID = "SYSTEM  "
     End If
Z:
End Function

Option Explicit

Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

Private Sub Form_Load()
    Me.OLEDropMode = 1
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Cls
    Dim nIndex%, nCounter%, nIconCount&, i&
    With Data
        If .GetFormat(15) = True Then
            nCounter = .Files.Count
            For nIndex = 1 To nCounter
                Debug.Print Data.Files(nIndex)
                nIconCount = ExtractIcon(App.hInstance, Data.Files(nIndex), -1)
                If nIconCount > 0 Then
                    For i = 0 To nIconCount - 1 Step 1
                        Dim hIcon&
                        hIcon& = ExtractIcon(App.hInstance, Data.Files(nIndex), i)
                        DrawIcon Me.hdc, 10 + 40 * i, 10 + 40 * (nIndex - 1), hIcon&
                        DestroyIcon hIcon&
                    Next
                Else
                    Debug.Print "没有图标! "; Data.Files(nIndex)
                    Print "没有图标! "; Data.Files(nIndex)
                End If
            Next
        End If
    End With
End Sub