Code: Alles auswählen
; StartMenü-Eintrag auswählen (PB4)
; by Thorsten Hoeppner (Thorsten1867)
;
#WindowID = 0
#TreeGadgetID = 1
NewList DirList.s()
Procedure.s Reg_GetValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
Protected lpData.s=Space(255), GetValue.s
Protected GetHandle.l, hKey.l, lReturnCode.l, lhRemoteRegistry.l, lpcbData.l, lType.l, lpType.l
Protected lpDataDWORD.l
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If GetHandle = #ERROR_SUCCESS
lpcbData = 255
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
If GetHandle = #ERROR_SUCCESS
Select lType
Case #REG_SZ
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
If GetHandle = 0
GetValue = Left(lpData, lpcbData - 1)
Else
GetValue = ""
EndIf
Case #REG_DWORD
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lpType, @lpDataDWORD, @lpcbData)
If GetHandle = 0
GetValue = Str(lpDataDWORD)
Else
GetValue = "0"
EndIf
EndSelect
EndIf
EndIf
RegCloseKey_(hKey)
ProcedureReturn GetValue
EndProcedure
Procedure.s GetPath(Type) ; - Return the path of some system-directorys
location$ = Space (#MAX_PATH+1)
Select Type
Case -1 : GetCurrentDirectory_(#MAX_PATH,@location$) ; Current
Case -2 : GetSystemDirectory_(@location$, #MAX_PATH) ; System
Case -3 : GetWindowsDirectory_(@location$, #MAX_PATH) ; Windows
Case -4 : GetTempPath_(#MAX_PATH,@location$) ; Temp
Case -5 : location$=GetPath($1A)+"Microsoft\Internet Explorer\Quick Launch\" ; QuickLaunch
Case -6 : location$=Reg_GetValue(#HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion","ProgramFilesDir","") ; ProgramFiles
Case $2B : location$=Reg_GetValue(#HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion","CommonFilesDir","") ; CommonFiles
Default ;{ SpecialFolder
*itemid.Long = #Null
If SHGetSpecialFolderLocation_ (0, Type, @*itemid) = #NOERROR
If SHGetPathFromIDList_ (*itemid, @location$)=#False
location$=""
EndIf
Else
location$=""
EndIf ;}
EndSelect
If location$ And Right(location$,1)<>"\" : location$+"\" : EndIf
ProcedureReturn location$
EndProcedure
Procedure EntryExists(entry.s, dir.s())
ForEach dir()
If dir() = entry
ProcedureReturn #True
EndIf
Next
ProcedureReturn #False
EndProcedure
Procedure GetStartMenu(directory.s, dir.s(), root.s)
If Right(directory,1) <> "\" : directory + "\" : EndIf
UsedDirectory = ExamineDirectory(#PB_Any, directory,"*.*")
While NextDirectoryEntry(UsedDirectory)
entryname.s = DirectoryEntryName(UsedDirectory)
If entryname = "." Or entryname = ".." : Continue : EndIf
If DirectoryEntryType(UsedDirectory) = 2
GetStartMenu(directory+entryname, dir(), root)
dir.s = RemoveString(directory+entryname, root)
If Not EntryExists(dir, dir())
AddElement(dir())
dir() = dir
EndIf
EndIf
Wend
FinishDirectory(UsedDirectory)
EndProcedure
Procedure JoinStartMenu(dir.s())
User$ = GetPath(#CSIDL_PROGRAMS)
AllUser$ = GetPath(#CSIDL_COMMON_PROGRAMS)
ClearList(dir())
GetStartMenu(User$, dir(), User$)
GetStartMenu(AllUser$, dir(), AllUser$)
SortList(dir(), 2)
EndProcedure
Procedure.s GetTreePath(GID.l)
If Not IsGadget(GID) : ProcedureReturn "" : EndIf
selected.l = GetGadgetState(GID)
path$ = GetGadgetText(GID)
level.b = GetGadgetItemAttribute(GID, selected, #PB_Tree_SubLevel)
Repeat
selected - 1
If GetGadgetItemAttribute(GID, selected, #PB_Tree_SubLevel) >= level : Continue : EndIf
path$ = GetGadgetItemText(GID, selected, #Null) + "\" + path$
level = GetGadgetItemAttribute(GID, selected, #PB_Tree_SubLevel)
Until level = 0 Or selected < 0
ProcedureReturn path$
EndProcedure
;- Fensteraufruf - Treegadget
If OpenWindow(#WindowID, 0, 0, 200, 180, "StartMenü", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(#WindowID))
TreeGadget(#TreeGadgetID, 10, 10, 180, 160)
JoinStartMenu(DirList()) ; Startmenü Benutzer & alle Benutzer auslesen
ForEach DirList() ; In TreeGadget eintragen
level.b = CountString(DirList(),"\")
AddGadgetItem (#TreeGadgetID, -1, StringField(DirList(),level+1,"\"), 0, level)
Next
Repeat
If WaitWindowEvent() = #PB_Event_Gadget
If EventGadget() = #TreeGadgetID
; Selektierter Treegadget-Eintrag
Debug "StartMenü: " + GetTreePath(#TreeGadgetID)
EndIf
EndIf
Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
)
