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