Option ExplicitPrivate Type BrowseInfo hwndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End TypeConst BIF_RETURNONLYFSDIRS = 1 Const MAX_PATH = 260Private Declare Function SHObjectProperties Lib "Shell32" Alias "#178" _ (ByVal hwndOwner As Long, _ ByVal uFlags As Long, _ ByVal lpstrName As String, _ ByVal lpstrPar As String) As LongPrivate Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi _ As BrowseInfo) As Long Private Declare Function SHFindFiles Lib "Shell32" Alias "#90" _ (ByVal pIDLRoot As Long, _ ByVal pidlSavedSearch As Long) As Long
Private Declare Function GetFileNameFromBrowse Lib "Shell32" Alias "#63" ( _ ByVal hwndOwner As Long, _ ByVal lpstrFile As String, _ ByVal nMaxFile As Long, _ ByVal lpstrInitDir As String, _ ByVal lpstrDefExt As String, _ ByVal lpstrFilter As String, _ ByVal lpstrTitle As String) As LongPrivate Declare Sub PickIconDlg Lib "Shell32" Alias "#62" (ByVal hwndOwner As Long, _ ByVal lpstrFile As String, ByVal nMaxFile As Long, lpdwIconIndex As Long)Private Declare Function SHRunFileDlg Lib "Shell32" Alias "#61" _ (ByVal hOwner As Long, _ ByVal hIcon As Long, _ ByVal lpstrDirectory As String, _ ByVal szTitle As String, _ ByVal szPrompt As String, _ ByVal uFlags As Long) As LongPrivate Sub Command1_Click() SHRunFileDlg Form1.hWnd, Form1.Icon.Handle, "c:\windows", "运行程序演示", _ "在文本框中输入程序名或按浏览键查找程序", 0 End SubPrivate Sub Command2_Click() Dim a As Long Dim astr As String
astr = "c:\windows\notepad.exe" PickIconDlg Form1.hWnd, astr, 1, a End SubPrivate Sub Command3_Click() Dim astr As String * 256 Dim bstr As String
bstr = "c:\windows" GetFileNameFromBrowse Form1.hWnd, astr, 256, bstr, "*.txt", _ "文本文件 *.txt", "Open Sample" Debug.Print astr End SubPrivate Sub Command4_Click() Dim lpIDList As Long Dim udtBI As BrowseInfo '初试化udtBI结构 With udtBI .hwndOwner = Form1.hWnd .ulFlags = BIF_RETURNONLYFSDIRS End With
'弹出文件夹查看窗口 lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then '查找文件 SHFindFiles lpIDList, 0 Call CoTaskMemFree(lpIDList) End If End SubPrivate Sub Command5_Click() SHObjectProperties Form1.hWnd, 2, "c:\windows\notepad.exe", "Samples" End SubPrivate Sub Form_Load() Command1.Caption = "运行程序" Command2.Caption = "更改图标" Command3.Caption = "打开文件" Command4.Caption = "查找文件" Command5.Caption = "显示文件属性" End Sub
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End TypeConst BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260Private Declare Function SHObjectProperties Lib "Shell32" Alias "#178" _
(ByVal hwndOwner As Long, _
ByVal uFlags As Long, _
ByVal lpstrName As String, _
ByVal lpstrPar As String) As LongPrivate Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi _
As BrowseInfo) As Long
Private Declare Function SHFindFiles Lib "Shell32" Alias "#90" _
(ByVal pIDLRoot As Long, _
ByVal pidlSavedSearch As Long) As Long
Private Declare Function GetFileNameFromBrowse Lib "Shell32" Alias "#63" ( _
ByVal hwndOwner As Long, _
ByVal lpstrFile As String, _
ByVal nMaxFile As Long, _
ByVal lpstrInitDir As String, _
ByVal lpstrDefExt As String, _
ByVal lpstrFilter As String, _
ByVal lpstrTitle As String) As LongPrivate Declare Sub PickIconDlg Lib "Shell32" Alias "#62" (ByVal hwndOwner As Long, _
ByVal lpstrFile As String, ByVal nMaxFile As Long, lpdwIconIndex As Long)Private Declare Function SHRunFileDlg Lib "Shell32" Alias "#61" _
(ByVal hOwner As Long, _
ByVal hIcon As Long, _
ByVal lpstrDirectory As String, _
ByVal szTitle As String, _
ByVal szPrompt As String, _
ByVal uFlags As Long) As LongPrivate Sub Command1_Click()
SHRunFileDlg Form1.hWnd, Form1.Icon.Handle, "c:\windows", "运行程序演示", _
"在文本框中输入程序名或按浏览键查找程序", 0
End SubPrivate Sub Command2_Click()
Dim a As Long
Dim astr As String
astr = "c:\windows\notepad.exe"
PickIconDlg Form1.hWnd, astr, 1, a
End SubPrivate Sub Command3_Click()
Dim astr As String * 256
Dim bstr As String
bstr = "c:\windows"
GetFileNameFromBrowse Form1.hWnd, astr, 256, bstr, "*.txt", _
"文本文件 *.txt", "Open Sample"
Debug.Print astr
End SubPrivate Sub Command4_Click()
Dim lpIDList As Long
Dim udtBI As BrowseInfo '初试化udtBI结构
With udtBI
.hwndOwner = Form1.hWnd
.ulFlags = BIF_RETURNONLYFSDIRS
End With
'弹出文件夹查看窗口
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
'查找文件
SHFindFiles lpIDList, 0
Call CoTaskMemFree(lpIDList)
End If
End SubPrivate Sub Command5_Click()
SHObjectProperties Form1.hWnd, 2, "c:\windows\notepad.exe", "Samples"
End SubPrivate Sub Form_Load()
Command1.Caption = "运行程序"
Command2.Caption = "更改图标"
Command3.Caption = "打开文件"
Command4.Caption = "查找文件"
Command5.Caption = "显示文件属性"
End Sub