Показать сообщение отдельно
Старый 05.08.2011, 21:42   #1
impersonalis
Зануда с интернетом
 
Аватар для impersonalis
 
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений
(для 20,935 пользователей)
Пути к системным директориям.

решение проблемы http://forum.boolean.name/showthread.php?t=15211

;decls-file:
;.lib "Shell32.dll"
;Api_SHGetFolderPath(hwndOwner%,nFolder%,hToken%,dwFlags%,pszPath*):"SHGetFolderPathA"
;=====================================================
;info:
;http://msdn.microsoft.com/en-us/library/bb762181(VS.85).aspx
;http://netcode.ru/cpp/?lang=&katID=20&skatID=182&artID=5201

;author lib for Blitz3D: impersonalis (icq 11-999-51-51)
;url: http://forum.boolean.name/showthread.php?p=198149
;Расширение возможностей функции GetEnv$ путём добавления новых временных
;(локальных) переменных окружения через SetEnv и SHGetFolderPathA (Shell32.dll)
;=====================================================

Dim imp_AddFolderPathList$(0)
;список добавленных имён (под индексами с 1), максимальное кол-во имён в элементе с индексом 0

Function imp_AddFolderPath%()
	;Заполняет список, вызывает SetEnv для добавления новых путей. 
	;Если система не определяет один из путей - он не добавляется в лист и не применяется в SetEnv.
	;Функция возвращает число успешно добавленных путей. В нулевом элементе списка
	;хранится его размер (максимальное число добавляемых путей).

	;Для расширения увеличьте значение переменной dir_num
	; и добавьте обработчик в Select i. 
	;Перезапись ключей в рамках функции не допускается (будет выдана ошибка).
	;При необходимости измените значение 
	;переменной BankSize_ (максимальная длина пути в байтах).

	Local dir_num%=56;Max Add-Dir num
	Local dir_name$
	Local dir_code%
	Local dir_rl_name$
	Local byte%,i%,j%
	Local BankSize_%=1024;MAX_PATH
	Local dir_act_num%=0
	Dim imp_AddFolderPathList$(dir_num)
	imp_AddFolderPathList(0)=Str(dir_num)
	Local CSIDLBank%=CreateBank(BankSize_)
	For i=1 To dir_num
		Select i
			Case 1
				dir_name="CSIDL_ADMINTOOLS"
				dir_code=48
			Case 2
				dir_name="CSIDL_ALTSTARTUP"
				dir_code=29
			Case 3
				dir_name="CSIDL_APPDATA"
				dir_code=26
			Case 4
				dir_name="CSIDL_BITBUCKET"
				dir_code=10
			Case 5
				dir_name="CSIDL_COMMON_ADMINTOOLS"
				dir_code=47
			Case 6
				dir_name="CSIDL_COMMON_ALTSTARTUP"
				dir_code=30
			Case 7
				dir_name="CSIDL_COMMON_APPDATA"
				dir_code=35
			Case 8
				dir_name="CSIDL_COMMON_DESKTOPDIRECTORY"
				dir_code=25
			Case 9
				dir_name="CSIDL_COMMON_DOCUMENTS"
				dir_code=46
			Case 10
				dir_name="CSIDL_COMMON_FAVORITES"
				dir_code=31
			Case 11
				dir_name="CSIDL_COMMON_PROGRAMS"
				dir_code=23
			Case 12
				dir_name="CSIDL_COMMON_STARTMENU"
				dir_code=22
			Case 13
				dir_name="CSIDL_COMMON_STARTUP"
				dir_code=24
			Case 14
				dir_name="CSIDL_COMMON_TEMPLATES"
				dir_code=45
			Case 15
				dir_name="CSIDL_CONTROLS"
				dir_code=3
			Case 16
				dir_name="CSIDL_COOKIES"
				dir_code=33
			Case 17
				dir_name="CSIDL_DESKTOP"
				dir_code=0
			Case 18
				dir_name="CSIDL_DESKTOPDIRECTORY"
				dir_code=16
			Case 19
				dir_name="CSIDL_DRIVES"
				dir_code=17
			Case 20
				dir_name="CSIDL_FAVORITES"
				dir_code=6
			Case 21
				dir_name="CSIDL_FONTS"
				dir_code=20
			Case 22
				dir_name="CSIDL_HISTORY"
				dir_code=34
			Case 23
				dir_name="CSIDL_INTERNET"
				dir_code=1
			Case 24
				dir_name="CSIDL_INTERNET_CACHE"
				dir_code=32
			Case 25
				dir_name="CSIDL_LOCAL_APPDATA"
				dir_code=28
			Case 26
				dir_name="CSIDL_MYMUSIC"
				dir_code=13
			Case 27
				dir_name="CSIDL_MYPICTURES"
				dir_code=39
			Case 28
				dir_name="CSIDL_NETHOOD"
				dir_code=19
			Case 29
				dir_name="CSIDL_NETWORK"
				dir_code=18
			Case 30
				dir_name="CSIDL_PERSONAL"
				dir_code=5
			Case 31
				dir_name="CSIDL_PRINTERS"
				dir_code=4
			Case 32
				dir_name="CSIDL_PRINTHOOD"
				dir_code=27
			Case 33
				dir_name="CSIDL_PROFILE"
				dir_code=40
			Case 34
				dir_name="CSIDL_PROGRAM_FILES"
				dir_code=38
			Case 35
				dir_name="CSIDL_PROGRAM_FILES_COMMON"
				dir_code=43
			Case 36
				dir_name="CSIDL_PROGRAMS"
				dir_code=2
			Case 37
				dir_name="CSIDL_RECENT"
				dir_code=8
			Case 38
				dir_name="CSIDL_SENDTO"
				dir_code=9
			Case 39
				dir_name="CSIDL_STARTMENU"
				dir_code=11
			Case 40
				dir_name="CSIDL_STARTUP"
				dir_code=7
			Case 41
				dir_name="CSIDL_SYSTEM"
				dir_code=37
			Case 42
				dir_name="CSIDL_TEMPLATES"
				dir_code=21
			Case 43
				dir_name="CSIDL_WINDOWS"
				dir_code=36
			Case 44
				dir_name="CSIDL_MYVIDEO"
				dir_code=14
			Case 45
				dir_name="CSIDL_SYSTEMX86"
				dir_code=41
			Case 46
				dir_name="CSIDL_PROGRAM_FILESX86"
				dir_code=42
			Case 47
				dir_name="CSIDL_PROGRAM_FILES_COMMONX86"
				dir_code=44	
			Case 48
				dir_name="CSIDL_CONNECTIONS"
				dir_code=49
			Case 49
				dir_name="CSIDL_COMMON_MUSIC"
				dir_code=53	
			Case 50
				dir_name="CSIDL_COMMON_PICTURES"
				dir_code=54	
			Case 51
				dir_name="CSIDL_COMMON_VIDEO"
				dir_code=55
			Case 52
				dir_name="CSIDL_RESOURCES"
				dir_code=56	
			Case 53
				dir_name="CSIDL_RESOURCES_LOCALIZED"
				dir_code=57	
			Case 54
				dir_name="CSIDL_COMMON_OEM_LINKS"
				dir_code=58	
			Case 55
				dir_name="CSIDL_CDBURN_AREA"
				dir_code=59	
			Case 56
				dir_name="CSIDL_COMPUTERSNEARME"
				dir_code=61
		End Select
		If Len(GetEnv(dir_name))>0
			RuntimeError dir_name+" is already exist!"
		EndIf
		Api_SHGetFolderPath(0,dir_code,0,0,CSIDLBank)
		dir_rl_name=""
		For j=0 To BankSize_-1
			byte=PeekByte(CSIDLBank,j)
			If byte=0 Then Exit
			dir_rl_name=dir_rl_name+Chr(byte)
		Next
		If j>0
			SetEnv(dir_name,dir_rl_name)
			;=
			dir_act_num=dir_act_num+1
			imp_AddFolderPathList(dir_act_num)=dir_name
		EndIf
	Next
	FreeBank(CSIDLBank)
	Return dir_act_num
End Function


;democode:
Local rc%=imp_AddFolderPath()
DebugLog "add "+rc+" / "+imp_AddFolderPathList(0)
For i=1 To rc
	DebugLog imp_AddFolderPathList(i)+" : "+GetEnv(imp_AddFolderPathList(i))
Next
WaitKey()
End


Просьба потестить. Для запуска необходим деклс файл следующего содержания:
.lib "Shell32.dll"
Api_SHGetFolderPath(hwndOwner%,nFolder%,hToken%,dwFlags%,pszPath*):"SHGetFolderPathA"
Демо использования кода представлено выше (вместе с основным кодом)
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
(Offline)
 
Ответить с цитированием
Эти 3 пользователя(ей) сказали Спасибо impersonalis за это полезное сообщение:
Mr_F_ (05.08.2011), SBJoker (05.08.2011), Tadeus (07.08.2011)