PureBasic Forums - English

Posted: **Fri Aug 24, 2007 6:49 pm**

It's not finished nor polished, but it works well for simple help file projects. You simply create a bunch of HTML files and this program creates the document "tree" at the left hand when you browse chm files. If you make a folder it becomes a sub-folder in the tree. Other files are simply listed. If there is an index.html in the folder, that file is shown when you click the "branch opener" (book icon) and is not shown in the list.
Set Directory to the correct directory, run this program and then run "hhc _project.hhp" in the same directory.

Here's a tip with css files: Instead of copying your css file into every folder, place a css file with only this code in in all of the subfolders:

@import "../style.css";

Then the real style.css should be in the main folder.

Code: Select all


Global Directory.s = "C:\Documents and Settings\Trond\Mine dokumenter\Docs\rbdocs\"
Global ChmFilename.s = "out.chm"
Global Title.s = "Title"

Procedure.s FolderFromList(List.s())
  Protected A.s
  ForEach List()
    A + List() + "\"
  Next
  ProcedureReturn A
EndProcedure

Procedure.s LineTrim(A.s)
  ProcedureReturn Trim(RemoveString(RemoveString(RemoveString(A, #CR$), #LF$), #TAB$))
EndProcedure

Procedure Min(A, B)
  If A < B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure ExamineDirectoryRecursive(Path.s, Pattern.s, List.s())
  Protected Dir = ExamineDirectory(#PB_Any, Path, Pattern)
  If Dir
    AddElement(List())
    List() = ">" + GetFilePart(Left(Path, Len(Path)-1))
    While NextDirectoryEntry(Dir)
      AddElement(List())
      List() = Path + DirectoryEntryName(Dir)
    Wend
    FinishDirectory(Dir)
  EndIf
  Dir = ExamineDirectory(#PB_Any, Path, "")
  If Dir
    While NextDirectoryEntry(Dir)
      If DirectoryEntryType(Dir) = #PB_DirectoryEntry_Directory
        If DirectoryEntryName(Dir) <> "." And DirectoryEntryName(Dir) <> ".."
          ExamineDirectoryRecursive(Path + DirectoryEntryName(Dir) + "\", Pattern, List())
        EndIf
      EndIf
    Wend
    FinishDirectory(Dir)
  EndIf
  AddElement(List())
  List() = "<"
EndProcedure

Procedure.s ExtractTitle(Filename.s)
  Protected File = OpenFile(#PB_Any, Filename)
  Protected BufLen = Min(Lof(File), 1024*4)
  Protected Buf.s = Space(BufLen)
  Protected Pos
  ReadData(File, @Buf, BufLen)
  Pos = FindString(Buf, "<title>", 0)
  If Pos
    Pos + 7
    ProcedureReturn LineTrim(Mid(Buf, Pos, FindString(Buf, "</title>", Pos)-Pos))
  EndIf
EndProcedure

Macro QT
  + #DOUBLEQUOTE$ +
EndMacro

Procedure WriteItem(File, Title.s, Filename.s)
	WriteStringN(0, "<LI> <OBJECT type=" QT "text/sitemap" QT ">")
	WriteStringN(0, "<param name=" QT "Name" QT " value=" QT Title QT ">")
	If Filename
	  WriteStringN(0, "<param name=" QT "Local" QT " value=" QT Filename.s QT ">")
	EndIf
	WriteStringN(0, "</OBJECT>")
EndProcedure

SetCurrentDirectory(Directory)

;- _project.hpp

OpenPreferences("_project.hhp")
PreferenceGroup("OPTIONS")
WritePreferenceString("Compatibility", "1.1 or later")
WritePreferenceString("Compiled file", ChmFilename)
WritePreferenceString("Contents file", "_toc.hhc")
WritePreferenceString("Default topic", "index.html")
WritePreferenceString("Full-text search", "Yes")
WritePreferenceString("Index file", "_index.hhk")
WritePreferenceString("Language", "0x809")
WritePreferenceString("Title", Title)
ClosePreferences()

;- _toc.hhc

CreateFile(0, "_toc.hhc")
WriteStringN(0, "<!DOCTYPE HTML PUBLIC " + #DOUBLEQUOTE$ + "-//IETF//DTD HTML//EN" + #DOUBLEQUOTE$ + ">")
WriteStringN(0, "<html><head><!-- Sitemap 1.0 --></head><body>")
WriteStringN(0, "<ul>")

NewList Files.s()
NewList CurrentFolder.s()
ExamineDirectoryRecursive(Directory, "*.html", Files())
FirstElement(Files())
DeleteElement(Files())
ForEach Files()
  Select Left(Files(), 1)
    Case ">"
      LastElement(CurrentFolder())
      AddElement(CurrentFolder())
      CurrentFolder() = Right(Files(), Len(Files())-1)
      PrintFolder.s = CurrentFolder()
      Index.s = FolderFromList(CurrentFolder()) + "index.html"
      If FileSize(Index) <> -1
        WriteItem(0, PrintFolder, Index)
      Else
        WriteItem(0, PrintFolder, "")
      EndIf
      WriteStringN(0, "<ul>")
    Case "<"
      If CountList(CurrentFolder()) > 0
        LastElement(CurrentFolder())
        DeleteElement(CurrentFolder())
        WriteStringN(0, "</ul>")
      EndIf
    Default
      If FileSize(Files()) > 0
        If GetFilePart(Files()) <> "index.html" Or CountList(CurrentFolder()) = 0
          WriteItem(0, ExtractTitle(Files()), Files())
        EndIf
      EndIf
  EndSelect
Next

WriteStringN(0, "</ul></body></html>")
CloseFile(0)

;- _index.hhk
CreateFile(0, "_index.hhk")
WriteStringN(0, "<!DOCTYPE HTML PUBLIC " + #DOUBLEQUOTE$ + "-//IETF//DTD HTML//EN" + #DOUBLEQUOTE$ + ">")
WriteStringN(0, "<HTML><HEAD>")
WriteStringN(0, "<!-- Sitemap 1.0 -->")
WriteStringN(0, "</HEAD><BODY>")
WriteStringN(0, "<UL></UL></BODY></HTML>")

;- Run compiler

PureBasic Forums - English

HelpMaker

HelpMaker