- UID
- 4456
- 积分
- 0
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2002-4-28
- 最后登录
- 1970-1-1
|
发表于 2003-11-20 19:06:35
|
显示全部楼层
Option Explicit
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'API函数SHBrowseForFolder提供文件列表,它需要用到一个BROWSEINFO类型,此类型包括了列表框使用的参数,
'此类型的声明见下面的程序,其中这里用到的几个参数简单说明一下:
' 此函数返回值是指向项目(ITEM)的一个指针,有了这个数值,再用API函数SHGetPathFromIDList可以获得具体的路径,如果用户按的是“取消”按钮,则返回值为NULL。
Private Type BROWSEINFO
hOwner As Long '当前窗口的句柄。
pidlRoot As Long 'pidlRoot—从何根路径开始展开文件夹,缺省情况下从“桌面”开始展开。
pszDisplayName As String
lpszTitle As String 'lpszTitle—目录树上方的标题,用来给用户一些提示信息。
ulFlags As Long 'ulFlags—显示标志控制项:比如若赋值为
' BIF_BROWSEFORCOMPUTER,则只有当用户选择“我的电脑”时“确定”按钮才有效,
' 这里我们需要的是BIF_RETURNONLYFSDIRS,只有用户选择的是文件夹时“确定”按钮才有效。
lpfn As Long
lParam As Long
iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = &H1
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Function GetPath(hwnd As Long) As String
Dim bi As BROWSEINFO '声明必要的变量
Dim rtn$, pidl$, path$, pos%, t, SpecIn, SpecOut
bi.hOwner = hwnd '使对话框处于屏幕中心
bi.lpszTitle = "选择目录..." '设置标题文字
bi.ulFlags = BIF_RETURNONLYFSDIRS '返回文件夹的类型
pidl$ = SHBrowseForFolder(bi) '显示对话框
path = Space(512) '设置字符数的最大值
t = SHGetPathFromIDList(ByVal pidl$, ByVal path) '获得所选的路径
pos% = InStr(path$, Chr$(0)) '从字符串中提取路径
SpecIn = Left(path$, pos - 1)
If Right$(SpecIn, 1) = "\" Then
SpecOut = SpecIn
Else
SpecOut = SpecIn + "\"
End If
GetPath = SpecOut
End Function
Public Function GetFile(hwnd As Long) As String
Dim ofn As OPENFILENAME
Dim rtn As String
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = hwnd
ofn.hInstance = App.hInstance
ofn.lpstrFilter = "所有文件"
ofn.lpstrFile = Space(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = App.path
ofn.lpstrTitle = "打开文件"
ofn.flags = 6148
rtn = GetOpenFileName(ofn)
If rtn >= 1 Then
GetFile = ofn.lpstrFile
Else
GetFile = ""
End If
End Function
Public Function GetTempName() As String
Dim TempFileName As String * 256
Dim TmpFilePrefix As String
Dim x As Long
Dim DriveName As String
DriveName = Mid(App.path, 1, 2)
TmpFilePrefix = "Tmp"
x = GetTempFileName(DriveName, TmpFilePrefix, 0, TempFileName)
GetTempName = Left$(TempFileName, InStr(TempFileName, Chr(0)) - 1)
End Function |
|