PureBasic Forums - English

Posted: **Mon May 05, 2003 2:39 am**

Somebody was asking (don't remember who or when) about getting a hard drive tree into a treegadget and at the time, I didn't know how.

With the help of Timo who knew what he was doing (grin), I have been playing with the below code and it gets up a directory tree of 3 of my hard drives and if I click on a node in the tree, shows the files in that node in the ListIconGadget on the right.

I have used some icons for the nodes, you might want to comment them out and also made some extensions for IncrediMail files that you miht want to comment out.

As always if you like it, use it, if you don't too bad!

Code: Select all

;
#Tree = 1
#List = 2
#Text = 3

#folder = 4
#drive = 5
#imail = 6
;
Global fver.s,fid0.s,fname.s,ftype.s,fcat.s,fcoll.s,fdisp.s,tmark.s,tlink.s,fid1.s,fid2.s,fid3.s,fid4.s,fid5.s
;
Declare DirScan(DirectoryID.l, DirectoryName.s)
Declare FileScan(FilePath.s)
Declare ProcessFile(FileInfo.s) 
Declare.s GetIni(Key.s, section.s)                          ; Get data from content.ini file
;
NewList FullPaths.s()
;
OpenWindow(0, 0, 0, 800, 600, #PB_Window_SystemMenu | #PB_Window_Screencentered, "Dir Scan...")
CreateGadgetList(WindowID())
TreeGadget(#Tree,  10,  10, 180, 530, #PB_Tree_AlwaysShowSelection) 
ListIconGadget(#List, 200, 10, 590, 530, "File", 150, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
  AddGadgetColumn(#List, 1, "Size", 50)
  AddGadgetColumn(#List, 2, "Attr", 50)
  AddGadgetColumn(#List, 3, "Type", 80)
  AddGadgetColumn(#List, 4, "Cat",  80)
  AddGadgetColumn(#List, 5, "Col", 80)

TextGadget(#Text,  10, 550, 770,  40, "", #PB_Text_Border)
;
AddGadgetItem(#Tree, -1, "C:", CatchImage(#drive,?drive)) : DirScan(0, "C:\")
AddGadgetItem(#Tree, -1, "D:", CatchImage(#drive,?drive)) : DirScan(0, "D:\")
AddGadgetItem(#Tree, -1, "E:", CatchImage(#drive,?drive)) : DirScan(0, "E:\")
;
SetGadgetItemState(#Tree, 0, #PB_Tree_Expanded | #PB_Tree_Selected)
  SelectElement(FullPaths(), 0)
  FileScan(FullPaths())
;
Repeat
  EventID = WaitWindowEvent()
    If EventID = #PB_EventGadget
      Select EventGadgetID()
        Case #Tree  : Gosub TreeClicked
      EndSelect
    EndIf
Until EventID = #PB_EventCloseWindow
End
;
TreeClicked:
  If EventType() = #PB_EventType_LeftClick And GetGadgetState(#Tree) <> -1
    ClearGadgetItemList(#List)
    CurrentLine = GetGadgetState(#Tree)
    SelectElement(FullPaths(), CurrentLine)
    FileScan(FullPaths())
  EndIf
Return
;
Procedure DirScan(DirectoryID.l, DirectoryName.s)
  AddElement(FullPaths())
  FullPaths() = DirectoryName
  SetGadgetText(#Text, DirectoryName)
  
  OpenTreeGadgetNode(#Tree)
  If ExamineDirectory(DirectoryID, DirectoryName, "*.*")
    Repeat
      entry.l = NextDirectoryEntry()
      If entry = 1  ; AddGadgetItem(#Tree, -1, DirectoryEntryName()) (Filename found)
      ElseIf entry = 2
        name.s = DirectoryEntryName()
        If name <> "." And name <> ".."
          While WindowEvent():Wend
          AddGadgetItem(#Tree, -1, name, CatchImage(#folder,?folder))
          DirScan(DirectoryID + 1, DirectoryName + name + "\")
          UseDirectory(DirectoryID)
        EndIf
      EndIf
    Until entry = 0
  EndIf
  CloseTreeGadgetNode(#Tree)
EndProcedure
;
Procedure FileScan(FilePath.s)
  If ExamineDirectory(1024, FilePath.s, "*.*")
    Repeat
      FileType     = NextDirectoryEntry() 
      FileName.s   = DirectoryEntryName()
      FileSize     = FileSize(FilePath.s + "\" + DirectoryEntryName()) 
      Mattribute   = DirectoryEntryAttributes()
      LetrType.s   = UCase(Right(FileName, 4))

      If Mattribute & #PB_FileSystem_Normal         : Attributes.s = "-----"
      ElseIf Mattribute & #PB_FileSystem_ReadOnly   : Attributes.s = "R----"
      ElseIf Mattribute & #PB_FileSystem_Archive    : Attributes.s = "-A---"
      ElseIf Mattribute & #PB_FileSystem_System     : Attributes.s = "--S--"
      ElseIf Mattribute & #PB_FileSystem_Hidden     : Attributes.s = "---H-"
      ElseIf Mattribute & #PB_FileSystem_Compressed : Attributes.s = "----C"
      EndIf

;      Select LetrType
;        Case ".IMF" : ProcessFile(FilePath.s + "\" + FileName.s)
;        Case ".IMA" : ProcessFile(FilePath.s + "\" + FileName.s)
;        Case ".IME" : ProcessFile(FilePath.s + "\" + FileName.s)
;        Case ".IMI" : ProcessFile(FilePath.s + "\" + FileName.s)
;        Case ".IMN" : ProcessFile(FilePath.s + "\" + FileName.s)
;        Case ".IMS" : ProcessFile(FilePath.s + "\" + FileName.s)
;        Case ".IMW" : ProcessFile(FilePath.s + "\" + FileName.s)
;        Default     : ftype.s = ""  : fcat.s = "" : fcoll.s = ""
;      EndSelect
      
      If FileType = 1
        While WindowEvent():Wend
        AddGadgetItem(#List, -1, FileName.s + Chr(10) + Str(FileSize) + Chr(10) + Attributes + Chr(10) + ftype.s + Chr(10) + fcat.s + Chr(10) + fcoll.s)
      EndIf 
    Until FileType = 0 
  EndIf
EndProcedure
;
; Process the files found during the directory search
;

Procedure ProcessFile(FileInfo.s)

  If ReadFile(0, FileInfo.s)
    ;
    unpacker.s = "C:\iCat2\cabarc.exe"                        ; Drive and directory for extract.exe
    params.s = " -o x " + Chr(34) + FileInfo.s + Chr(34) + " content.ini C:\iCat2\"

    If RunProgram(unpacker.s, params.s, "", 1 | 2) <> 0
    EndIf

    section.s   = "Version"
      fver.s    = getini("Number", section.s)
    section.s   = "General"
      fid0.s    = getini("ID", section.s)
      fname.s   = getini("File", section.s)
      ftype.s   = getini("Type", section.s)
      fcat.s    = getini("Category", section.s)
      fcoll.s   = getini("Collection", section.s)
      fdisp.s   = getini("Display", section.s)
    section.s   = "Trademark"
      tmark.s   = getini("TradeMark", section.s)
    section.s   = "X-Extensions"
      tlink.s   = getini("TradeMarkLink", section.s)
    section.s   = "Depend"
      fid1.s    = getini("id0", section.s)
      fid2.s    = getini("id1", section.s)
      fid3.s    = getini("id2", section.s)
      fid4.s    = getini("id3", section.s)
      fid5.s    = getini("id4", section.s)

  DeleteFile("C:\iCat2\content.ini")
  
  EndIf

EndProcedure

; API procedure for INI file reading

Procedure.s GetIni(Key.s, section.s)                                            ; Procedure returns a string

  Empty.s = ""                                                                   ; Default value if nothing found
  ReturnSpace.s = Space(255)                                                     ; Make sure the variable has plenty of room
  IniData = GetPrivateProfileString_(section.s, Key.s, Empty.s, @ReturnSpace.s, 255, "C:\iCat2\content.ini")
  
  ProcedureReturn ReturnSpace.s                                                ; Return the data to the calling line

EndProcedure

DataSection

  folder: IncludeBinary "icons\Folder.ico"
  drive:  IncludeBinary "icons\Drive.ico"
  imail:  IncludeBinary "icons\IncrediMail.ico"
  
EndDataSection

PureBasic Forums - English

Directory tree and file tree

Directory tree and file tree