请教：鼠标拖拽和搜索的综合问题？？

Question

在模块中
Public Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Public Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As Long, ByVal fAccept As Long)
Public Declare Sub DragFinish Lib "shell32.dll" (ByVal HDROP As Long)
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wparam As Long, ByVal lParam As Long) As Long
Fname = Open_File(Me.hwnd, "Open", _
            "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0))
    
Public IPREVWNDPROC As Long
Public HOOKWINDOW As Long
Public Const GWL_WNDPROC = -4
Public Const WM_DROPFILES = &H233
Public Function HOOKCALLBACK(ByVal hwnd As Long, ByVal wmsg As Long, ByVal wparam As Long, ByVal iparam As Long) As Long
Select Case hwnd
         Case HOOKWINDOW
         frmmain.Procmessage wmsg, wparam, iparam
End Select
HOOKCALLBACK = CallWindowProc(ByVal IPREVWNDPROC, ByVal hwnd, ByVal wmsg, ByVal wparam, ByVal iparam)
End Function
Public Sub sethook(ByVal hwnd As Long)
'***********************************
'设置钩子
'***********************************
HOOKWINDOW = hwnd
If HOOKWINDOW <> 0 Then clearhook
IPREVWNDPROC = SetWindowLong(ByVal HOOKWINDOW, GWL_WNDPROC, AddressOf HOOKCALLBACK)
End Sub
Public Sub clearhook()
'***********************************
'清除钩子
'***********************************
Dim lngret As Long
If HOOKWINDOW = 0 Then Exit Sub
If IsEmpty(HOOKWINDOW) = True Then Exit Sub
If IsNull(HOOKWINDOW) = True Then Exit Sub
lngret = SetWindowLong(ByVal HOOKWINDOW, GWL_WNDPROC, IPREVWNDPROC)
End Sub
在窗体中：
消息处理：
Public Sub Procmessage(wmsg As Long, wparam As Long, iparam As Long)
'*******************************************************************************
'处理拖放消息
'*******************************************************************************
Dim sfilename As String
Dim HDROP As Long
Dim lfilecount As Long
Dim iret As Long
Dim ndropcount As Long
Dim n As Integer
Dim bret As Boolean
Dim strcolkey As String
Dim vnt As Variant
   Select Case wmsg
                '消息类型
                Case WM_DROPFILES
                    '附加消息
                      HDROP = wparam
                      sfilename = Space$(255)
                      ndropcount = DragQueryFile(HDROP, -1, sfilename, 254)
                For n = 0 To ndropcount - 1
                           sfilename = Space$(255)
                            iret = DragQueryFile(HDROP, n, sfilename, 254)
'***************************************************************************************
               　　'因为处理含有中文字符的路径时会出错.至于原因
                       '还不清楚,以后研究.
'***************************************************************************************　　　　　　
　　　　　　　　　　　　　　　　'截取空格得到包括路径在内的文件名　　　　　　　　　　　　　　　　　　　　　‘用trim()会出错，不知为何
　　　　　　　　　　　　　sfilename = retrealfilename(sfilename)
                        bret = IsYesNoReval(lstsource, sfilename)
                           If bret Then GoTo chinaerr
                             lstsource.AddItem sfilename
                          '此时当被选定时会引发itemcheck事件
                             lstsource.Selected(lstsource.ListCount - 1) = True
chinaerr:
              Next
   '当拖动文件到窗口,并松开鼠标时,dropfile事件发生
                Call DragFinish(HDROP)
    End Select
End Sub

Answer 1

新建一个Dll
DLL的模块中：Option ExplicitPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Sub DragFinish Lib "shell32.dll" (ByVal HDROP As Long)
Public Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal Hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_DROPFILES = &H233
Public PrevWndFunc As LongPublic obj As CDrag_DropPublic Function WndProc(ByVal Hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    'Dim obj As New CDrag_Drop
    
    Dim n As Long, iLoop As Long, FileInfo As Long
    Dim Buffer As String * 256, tmp As String
    Dim length As Long
    If msg = WM_DROPFILES Then
        obj.ClearFileNames
        FileInfo = wParam
        n = DragQueryFile(FileInfo, -1&, vbNullString, 0)
        For iLoop = 0 To n - 1
            length = DragQueryFile(FileInfo, iLoop, ByVal Buffer, 256)
            Buffer = Trim(Buffer)
            obj.AddInFileNames Buffer
        Next
        
        obj.NowRaiseEvent
        
        DragFinish FileInfo 'wParam
        WndProc = 0
    Else
        WndProc = CallWindowProc(PrevWndFunc, Hwnd, msg, wParam, lParam)
    End If
    
    
End FunctionDLL的类模块中：Option ExplicitPublic Event FilesDroped()
Private m_DragHwnd As Long
Private m_FileCount As Integer
Private FileNames() As String
Private Working As Boolean
Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal Hwnd As Long, ByVal fAccept As Long)Friend Sub AddInFileNames(Buffer As String)
    ReDim Preserve FileNames(0 To m_FileCount)
    FileNames(m_FileCount) = Buffer
    m_FileCount = m_FileCount + 1End SubFriend Sub NowRaiseEvent()
    RaiseEvent FilesDroped
End SubFriend Sub ClearFileNames()
    ReDim FileNames(0)
    m_FileCount = 0
    
End Sub
Public Function StartDrag() As Long
    'This will start monitoring for the message of WM_DROPFILES
    'If already working then we wont subclass again
    If Working = False Then
        If m_DragHwnd > 0 Then
            DragAcceptFiles m_DragHwnd, True
            'Set obj = Me
            
            PrevWndFunc = SetWindowLong(m_DragHwnd, GWL_WNDPROC, AddressOf WndProc)
            StartDrag = 1 'Successfully started
            Working = True
            
        Else
            StartDrag = 0 'Unsuccessful, handle not given
            
        End If
    Else
        StartDrag = 2
    End If
    
End Function
Public Property Get DragHwnd() As Long
    m_DragHwnd = DragHwndEnd PropertyPublic Property Let DragHwnd(ByVal Hwnd As Long)
    
    If Not Working Then m_DragHwnd = Hwnd
    
End Property
Public Function StopDrag() As Long
    'Stop subclassing and monitoring of WM_DROPFILES message.
    
    If Working = True Then
        SetWindowLong m_DragHwnd, GWL_WNDPROC, PrevWndFunc
        DragAcceptFiles m_DragHwnd, False
        Working = False
        StopDrag = 1 'successfully stoped subclassing
        
    Else
        StopDrag = 0 'It was already not subclassed so no need to unsubclass
        
    End If
End Function
Public Function FileName(index As Integer) As String
    If index >= 0 And index <= m_FileCount Then
        FileName = FileNames(index)
    Else
        FileName = ""
    End If
    
End FunctionPrivate Sub Class_Initialize()
    m_DragHwnd = 0
    m_FileCount = 0
    'obj is declared in BAS- <CDrag_Drop_Module> of type CDrag_Drop
    Set obj = Me
    
End SubPrivate Sub Class_Terminate()
    If Working = True Then StopDrag
    
End SubPublic Property Get FileCount() As Integer
    FileCount = m_FileCount
    
End Property新建一个EXE工程，引用上面的DLL
窗体中，List1,Command1,Command2,Label1：
Option ExplicitPrivate WithEvents iClass As CDrag_DropPrivate Sub Command1_Click()
    iClass.DragHwnd = List1.hWnd
    iClass.StartDrag
    Label1 = "Component Working..."
    
End SubPrivate Sub Command2_Click()
    iClass.StopDrag
    Label1 = "Component Not Working"
    
End SubPrivate Sub Form_Load()
    Set iClass = New CDrag_Drop
    With size
        .hParam = Me.Height
        .wParam = Me.Width
        .Map Command1, RS_LeftOnly
        .Map Command2, RS_Top_Left
        .Map Label1, RS_LeftOnly
        .Map List1, RS_Height_Width
    End With
    
End SubPrivate Sub Form_Unload(Cancel As Integer)
    iClass.StopDrag
    
End SubPrivate Sub iClass_FilesDroped()
    Dim i As Integer
'    List1.Clear
    
    With iClass
        For i = 0 To .FileCount - 1
            List1.AddItem .FileName(i)
        Next
    End With
    
End SubOK，运行！搞定！

Answer 2

搜索用Windows的就行了！关键想了解的是如何将搜索出来的列表拖拽到程序中！