设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 1819|回复: 1
打印 上一主题 下一主题

[模块/函数] [原创]获取系统的特定目录地址:我的文档、桌面。。。

[复制链接]
跳转到指定楼层
1#
发表于 2005-8-17 02:02:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
'=====================================

'下面的模块是获取“我的文档”等的路径的,


'需要请自己改最后的函数集合就行了,

'还有。。。您看着吧,绝对好用   

'By 狠狠活 2005-08-16                                                               

'========================

Option Compare Database

Option Explicit

'程序有点长.所有的定义全在 模块中..

'如果要显示 我的文档 的路径只要这么使用

'me.caption= GetSysDirPath(CSIDL_PERSONAL)


'SHGetSpecialFolderLocation获得某一个特殊的目录的位置,如果函数调用成功返回NOERROR

'或者一个OLE错误


Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _

(ByVal hwndOwner As Long, _

ByVal nFolder As SHSpecialFolderIDs, _

pidl As Long) As Long

'SHGetPathFromIDList函数将一个Item转换为文件路径

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _

(ByVal pidl As Long, _

ByVal pszPath As String) As Long

'SHGetFileInfoPidl函数获得某个文件对象的信息。

Declare Function SHGetFileInfoPidl Lib "shell32" Alias "SHGetFileInfoA" _

(ByVal pidl As Long, _

ByVal dwFileAttributes As Long, _

psfib As SHFILEINFOBYTE, _

ByVal cbFileInfo As Long, _

ByVal uFlags As SHGFI_flags) As Long



Public Const MAX_PATH = 260

Public Const NOERROR = 0



Public Enum SHSpecialFolderIDs '列出所有Windows下特殊文件夹的ID

CSIDL_DESKTOP = &H0         '桌面

CSIDL_INTERNET = &H1

CSIDL_PROGRAMS = &H2        '程序

CSIDL_CONTROLS = &H3

CSIDL_PRINTERS = &H4

CSIDL_PERSONAL = &H5       '我的文档

CSIDL_FAVORITES = &H6

CSIDL_STARTUP = &H7         '开始

CSIDL_RECENT = &H8

CSIDL_SENDTO = &H9

CSIDL_BITBUCKET = &HA

CSIDL_STARTMENU = &HB

CSIDL_DESKTOPDIRECTORY = &H10

CSIDL_DRIVES = &H11

CSIDL_NETWORK = &H12

CSIDL_NETHOOD = &H13       '网上邻居

CSIDL_FONTS = &H14

CSIDL_TEMPLATES = &H15

CSIDL_COMMON_STARTMENU = &H16

CSIDL_COMMON_PROGRAMS = &H17

CSIDL_COMMON_STARTUP = &H18

CSIDL_COMMON_DESKTOPDIRECTORY = &H19

CSIDL_APPDATA = &H1A

CSIDL_PRINTHOOD = &H1B

CSIDL_ALTSTARTUP = &H1D

CSIDL_COMMON_ALTSTARTUP = &H1E

CSIDL_COMMON_FAVORITES = &H1F

CSIDL_INTERNET_CACHE = &H20

CSIDL_COOKIES = &H21

CSIDL_HISTORY = &H22            '历史文件夹

End Enum

Enum SHGFI_flags

SHGFI_LARGEICON = &H0

SHGFI_SMALLICON = &H1

SHGFI_OPENICON = &H2

SHGFI_SHELLICONSIZE = &H4

SHGFI_PIDL = &H8

SHGFI_USEFILEATTRIBUTES = &H10

SHGFI_ICON = &H100

SHGFI_DISPLAYNAME = &H200

SHGFI_TYPENAME = &H400

SHGFI_ATTRIBUTES = &H800

SHGFI_ICONLOCATION = &H1000

SHGFI_EXETYPE = &H2000

SHGFI_SYSICONINDEX = &H4000

SHGFI_LINKOVERLAY = &H8000

SHGFI_SELECTED = &H10000

End Enum

Public Type SHFILEINFOBYTE

hIcon As Long

iIcon As Long

dwAttributes As Long

szDisplayName(1 To MAX_PATH) As Byte

szTypeName(1 To 80) As Byte

End Type

Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" _

(ByVal pszPath As String, _

ByVal dwFileAttributes As Long, _

psfi As SHFILEINFO, _

ByVal cbFileInfo As Long, _

ByVal uFlags As SHGFI_flags) As Long

Public Type SHFILEINFO

hIcon As Long

iIcon As Long

dwAttributes As Long

szDisplayName As String * MAX_PATH

szTypeName As String * 80

End Type

'根据一个特定文件夹对象的ID获得它的目录pidl

Public Function GetPIDLFromFolderID(hOwner As Long, nFolder As SHSpecialFolderIDs) As Long

Dim pidl As Long

If SHGetSpecialFolderLocation(hOwner, nFolder, pidl) = NOERROR Then

GetPIDLFromFolderID = pidl

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2009-10-24 15:21:10 | 只看该作者
收藏了。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-28 09:54 , Processed in 0.127415 second(s), 25 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表