|
Полезные функции Выкладываем полезные функции, чтоб не изобретать велосипед заново... |
05.08.2011, 21:42
|
#1
|
Зануда с интернетом
Регистрация: 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 за это полезное сообщение:
|
|
07.08.2011, 14:42
|
#2
|
[object Object]
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,361
Написано 2,473 полезных сообщений (для 6,856 пользователей)
|
Ответ: Пути к системным директориям.
Прошу простить, что не написал своё решение ранее (меня долго не было в сети):
Используемый 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%(hwnd, p1, p2, p3, out*) : "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 4090 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)
|
|
Сообщение было полезно следующим пользователям:
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 18:06.
|