PureBoard

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

Code: Alles auswählen

jaPBe - Compiler Fehler
Line 17 - GetRegKey() is not a function, array, macro or linked list