Website To CHM

Put your website in a chm file

option explicit
'The generated CHM file is named jla.chm on your desktop.
'Your folder hosting the files has not to be on c:
Dim WshShell,fso
Dim HHC,RepBase,FicHHP,t,c
Set WshShell=WScript.CreateObject("WScript.Shell")
Set fso=CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Err.Number=0
HHC=WshShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\HTML Help Workshop\InstallDir")
If Err.Number<>0 Then
	Wscript.Echo "In order to use this script, you need HTML Help Workshop" & _
	vbCrLf & "https://msdn.microsoft.com/library/en-us/htmlhelp/html/vsconhh1start.asp"
	wscript.Quit
End If
On Error Goto 0
HHC=fso.BuildPath(HHC,"hhc.exe")

If Not fso.FileExists(HHC) Then
	Wscript.Echo "Warning, the workshop is registered but the compiler was not found"
	WScript.Quit
End If

If 1=MsgBox("This script creates a .CHM file on the desktop from a folder having lots of html files.",1) Then
	RepBase=B("Choose the folder hosting your website")
	If IsNull(RepBase) Then
	    MsgBox "Please choose a Folder"
	Else
		T=Recurs(RepBase)
		FicHHP=fso.BuildPath(RepBase,"JLA.HHP")
		Set c=fso.CreateTextFile(FicHHP,True)
		c.WriteLine "[OPTIONS]"
		c.WriteLine "Compatibility=1.1 or later"
		c.WriteLine "Compiled file=" & fso.BuildPath(WshShell.SpecialFolders("Desktop"),"jla.chm")
		c.WriteLine "Default topic=" & Mid(Debut(T),Len(RepBase)+2)
		c.WriteLine "Display compile progress=No"
		c.WriteLine "Language=0x40c Fran�ais (standard)"
		c.WriteLine "Title=(c) 2001 JLA"
		c.WriteLine vbCrLf & "[FILES]"
		c.WriteLine T
		c.WriteLine vbCrLf & "[INFOTYPES]" & vbCrLf
		c.Close
		Set c=Nothing
		'wshShell.Run "notepad.exe " & FicHHP,3 ,-1
		wshShell.Run Chr(34) & HHC & Chr(34) & Chr(32) & FicHHP,3 ,-1
		fso.DeleteFile FicHHP
	End If
End If
Set fso=Nothing
Set WshShell=Nothing

Function B(Msg)
	Dim a,f,i
	Set a=WScript.CreateObject("Shell.Application")
	On Error Resume Next
	Set f=a.BrowseForFolder(&H0&, Msg, &h1&)
	B=f.ParentFolder.ParseName(f.Title).Path
	If Err.Number<>0 Then
		B=Null
		If f.Title="Desktop" Then B=WshShell.SpecialFolders("Desktop")
		i=InStr(f.Title,":")
		If i>0 Then B=Mid(f.Title,i-1,2) & "\"
	End If
	Set a=Nothing
End Function

Function Recurs(ByVal p)
	Dim f,k,s,t
	Set f = fso.GetFolder(p)
	For Each k in f.Files
		t = ucase(k.name)
		If (Right(t,3) = "HTM") or (Right(t,4)="HTML") Then
			s = s & fso.BuildPath(k.parentfolder, k.name) & vbCrLf
		End If
		if (Right(t,3) = "MOV") or (Right(t,2)="AU") Then
			s = s & fso.BuildPath(k.parentfolder, k.name) & vbCrLf
		End If
	Next
	For Each k in f.subFolders
		s = s & Recurs(k)
	Next
	Recurs = s
End Function

Function Debut(byval k)
	Dim s
	s=Trim(InputBox("Rentrez le nom du fichier (sans chemin) du fichier HTML principal - input the root filename"))
	if (InStr(ucase(k),ucase(s))=0) Or (Len(s)=0) Then
		MsgBox "Le nom du fichier HTML pr�cis� est invalide - file not found"
	Else
		If s<>"" Then
			k = vbCrLf & k
			k = Left(k,InStr(ucase(k),ucase(s))+Len(s))
			s = Len(k)
			While Mid(k,s,1)<>Chr(10)
				s = s -1
			Wend
			s = Mid(k,s+1)
		End If
	end If
	Debut = s
End Function

'Remember : to decompile a chm file, use hh -decompile dest_dir source.chm