-
Notifications
You must be signed in to change notification settings - Fork 1
/
sysfolders.bas
69 lines (62 loc) · 3.44 KB
/
sysfolders.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Attribute VB_Name = "SysFolders"
' Klepsydra Project
' Get Windows Special Folders Path, using WinAPI call
Option Explicit
Private Declare Function SHGetFolderPath Lib "shfolder" Alias "SHGetFolderPathA" ( _
ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
ByVal hToken As Long, _
ByVal dwFlags As Long, _
ByVal pszPath As String _
) As Long
Public Enum FolderEnum
feCDBurnArea = 59 ' \Docs & Settings\User\Local Settings\Application Data\Microsoft\CD Burning
feCommonAppData = 35 ' \Docs & Settings\All Users\Application Data
feCommonAdminTools = 47 ' \Docs & Settings\All Users\Start Menu\Programs\Administrative Tools
feCommonDesktop = 25 ' \Docs & Settings\All Users\Desktop
feCommonDocs = 46 ' \Docs & Settings\All Users\Documents
feCommonPics = 54 ' \Docs & Settings\All Users\Documents\Pictures
feCommonMusic = 53 ' \Docs & Settings\All Users\Documents\Music
feCommonStartMenu = 22 ' \Docs & Settings\All Users\Start Menu
feCommonStartMenuPrograms = 23 ' \Docs & Settings\All Users\Start Menu\Programs
feCommonTemplates = 45 ' \Docs & Settings\All Users\Templates
feCommonVideos = 55 ' \Docs & Settings\All Users\Documents\My Videos
feLocalAppData = 28 ' \Docs & Settings\User\Local Settings\Application Data
feLocalCDBurning = 59 ' \Docs & Settings\User\Local Settings\Application Data\Microsoft\CD Burning
feLocalHistory = 34 ' \Docs & Settings\User\Local Settings\History
feLocalTempInternetFiles = 32 ' \Docs & Settings\User\Local Settings\Temporary Internet Files
feProgramFiles = 38 ' \Program Files
feProgramFilesCommon = 43 ' \Program Files\Common Files
feUser = 40 ' \Docs & Settings\User
feUserAdminTools = 48 ' \Docs & Settings\User\Start Menu\Programs\Administrative Tools
feUserAppData = 26 ' \Docs & Settings\User\Application Data
feUserCache = 32 ' \Docs & Settings\User\Local Settings\Temporary Internet Files
feUserCookies = 33 ' \Docs & Settings\User\Cookies
feUserDesktop = 16 ' \Docs & Settings\User\Desktop
feUserDocs = 5 ' \Docs & Settings\User\My Documents
feUserFavorites = 6 ' \Docs & Settings\User\Favorites
feUserMusic = 13 ' \Docs & Settings\User\My Documents\My Music
feUserNetHood = 19 ' \Docs & Settings\User\NetHood
feUserPics = 39 ' \Docs & Settings\User\My Documents\My Pictures
feUserPrintHood = 27 ' \Docs & Settings\User\PrintHood
feUserRecent = 8 ' \Docs & Settings\User\Recent
feUserSendTo = 9 ' \Docs & Settings\User\SendTo
feUserStartMenu = 11 ' \Docs & Settings\User\Start Menu
feUserStartMenuPrograms = 2 ' \Docs & Settings\User\Start Menu\Programs
feUserStartup = 7 ' \Docs & Settings\User\Start Menu\Programs\Startup
feUserTemplates = 21 ' \Docs & Settings\User\Templates
feUserVideos = 14 ' \Docs & Settings\User\My Documents\My Videos
feWindows = 36 ' \Windows
feWindowFonts = 20 ' \Windows\Fonts
feWindowsResources = 56 ' \Windows\Resources
feWindowsSystem = 37 ' \Windows\System32
End Enum
Public Function SpecialFolder(pfe As FolderEnum) As String
Const MAX_PATH = 260
Dim strPath As String
Dim strBuffer As String
strBuffer = Space$(MAX_PATH)
If SHGetFolderPath(0, pfe, 0, 0, strBuffer) = 0 Then strPath = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
If Right$(strPath, 1) = "\" Then strPath = Left$(strPath, Len(strPath) - 1)
SpecialFolder = strPath
End Function