Question

如何使用VB建立一组资源管理器

如何使用VB建立一组资源管理器

Answer 1

'一、新建一个模块，复制下面代码到模块中
Option Explicit
Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "User32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetParent Lib "User32" (ByVal hWnd As Long) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Function GetPath() As String
Dim lu_POINT As POINTAPI, Curwindow As Long, parentWnd As Long
Dim S As String, Hwd As Long, i As Integer
Dim oShellApp, oShellAppWindows, oWin

Call GetCursorPos(lu_POINT)
Curwindow = WindowFromPoint(lu_POINT.X, lu_POINT.Y)
parentWnd = GetParent(Curwindow)
Do While parentWnd <> 0
Curwindow = GetParent(parentWnd)
If Curwindow = 0 Then Exit Do
parentWnd = Curwindow
Loop
Hwd = parentWnd

Set oShellApp = CreateObject("Shell.Application")
Set oShellAppWindows = oShellApp.Windows
For Each oWin In oShellAppWindows
Debug.Print TypeName(oWin.Document)
If TypeName(oWin.Document) = "IShellFolderViewDual2" Then
If oWin.hWnd = Hwd Then
S = oWin.LocationURL
S = Replace(S, "file:///", "", , , vbTextCompare)
S = Replace(S, "/", "\")
S = Replace(S, "%20", " ")
GetPath = S
Exit Function
End If
End If
Next
Set oWin = Nothing
Set oShellApp = Nothing
Set oShellAppWindows = Nothing
End Function

'二、当一个对象拖动到资源管理器后 ，调用下面函数即可完成复制文件工作：

Private Sub List1_OLECompleteDrag(Effect As Long)
Dim i As Integer, S As String
Dim Path As String
Path = GetPath
With List1
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
S = .List(i)
FileCopy S, Path & Path & Mid(S, InStrRev(S, "\"))
End If
DoEvents
Next
End With
MsgBox "文件复制完毕！"
End Sub