Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для компьютеров > Blitz3D > Полезные функции

Полезные функции Выкладываем полезные функции, чтоб не изобретать велосипед заново...

Ответ
 
Опции темы
Старый 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)
Старый 07.08.2011, 14:42   #2
Randomize
[object Object]
 
Аватар для Randomize
 
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,354
Написано 2,470 полезных сообщений
(для 6,850 пользователей)
Ответ: Пути к системным директориям.

Прошу простить, что не написал своё решение ранее (меня долго не было в сети):
Используемый DECLS файл "shell32.decls"
.lib "shell32.dll" 
api_CommandLineToArgv% (lpCmdLine$, pNumArgs%) : "CommandLineToArgvW" 
api_DoEnvironmentSubst% (szString$, cbString%) : "DoEnvironmentSubstA" 
api_DragAcceptFiles (hwnd%, fAccept%) : "DragAcceptFiles" 
api_DragFinish (hDrop%) : "DragFinish" 
api_DragQueryFile% (HDROP%, UINT%, lpStr$, ch%) : "DragQueryFileA" 
api_DragQueryPoint% (HDROP%, lpPoint*) : "DragQueryPoint" 
api_DuplicateIcon% (hInst%, hIcon%) : "DuplicateIcon" 

api_ExtractAssociatedIcon% (hInst%, lpIconPath$, lpiIcon%) : "ExtractAssociateIconA" 
api_ExtractIcon% (hInst%, lpszExeFileName$, nIconIndex%) : "ExtractIconA" 
api_ExtractIconEx% (lpszFile$, nIconIndex%, phiconLarge%, phiconSmall%, nIcons%) : "ExtractIconExA" 

api_FindEnvironmentString$ (szEnvVar$) : "FindEnvironmentStringA" 
api_FindExecutable% (lpFile$, lpDirectory$, lpResult$) : "FindExecutableA" 


api_Shell_NotifyIcon% (dwMessage%, lpData*) : " Shell_NotifyIconA" 
api_ShellAbout% (hwnd%, szApp$, szOtherStuff$, hIcon%) : "ShellAboutA" 
api_ShellExecute% (hwnd%, lpOperation$, lpFile$, lpParameters$, lpDirectory$, nShowCmd%) : "ShellExecuteA" 

api_SHAppBarMessage% (dwMessage%, pData*) : "SHAppBarMessage" 
api_SHFileOperation% (lpFileOp*) : " SHFileOperationA" 
api_SHFreeNameMappings (hNameMappings%) : "SHFreeNameMappings" 
api_SHGetFileInfo% (pszPath$, dwFileAttributes%, psfi*, cbFileInfo%, uFlags%) : " SHGetFileInfoA" 
api_SHGetNewLinkInfo% (pszLinkto$, pszDir$, pszName$, pfMustCopy%, uFlags%) : "SHGetNewLinkInfoA" 
api_SHGetFolderPath%(hwndp1p2p3out*) : "SHGetFolderPathA"

api_WinExecError (hwnd%, error%, lpstrFileName$, lpstrTitle$) : "WinExecErrorA" 
Код Blitz3D:
Function GetMyDocumentsPath$()
	Local bank = CreateBank(256)	
	Local s$  = ""

	api_SHGetFolderPath(0, $5, 0, 0, bank)
	
	For i = 0 To 255
		b = PeekByte(bank, i)
		If b = 0 Then Exit
		s$ = s$ + Chr$(b)
	Next
	FreeBank(bank)
	If Right$(s$, 1) <> "\" Then s$ = s$ + "\"
	Return s$
End Function

Print GetMyDocumentsPath$()
WaitKey()	
End
__________________
Retry, Abort, Ignore? █
Intel Core i7-9700 4.70 Ghz; 64Gb; Nvidia RTX 3070
AMD Ryzen 7 3800X 4.3Ghz; 64Gb; Nvidia 1070Ti
AMD Ryzen 7 1700X 3.4Ghz; 8Gb; AMD RX 570
AMD Athlon II 2.6Ghz; 8Gb; Nvidia GTX 750 Ti
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
L-ee-X (08.08.2011)
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 20:08.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com