Attribute VB_Name = "Tidy"
'Tidy.bas - Integration von Tidy in FrontPage 2000
'
'(c) Christoph Schneegans <mailto:Christoph@Schneegans.de>
'
'Weitere Infos unter <http://www.schneegans.de/frontpage-vba/tidy.html>

Option Explicit

'Kompletter Pfad zur Datei tidy.exe
Const TIDY_PROGRAM_FILE = "C:\Tidy\tidy.exe"

'Konfigurations-Datei für Tidy.
Const TIDY_CONFIG_FILE = "C:\Tidy\default.cfg"

'Datei, in die Tidy ggf. Fehlermeldungen und Probleme schreibt.
Const TIDY_ERROR_FILE = "C:\Tidy\errors.txt"

'Datei, in die Tidy temporär Ausgaben speichern kann.
Const TIDY_TEMP_FILE = "C:\Tidy\tidy.tmp"

Sub Tidy_File()

If ActivePageWindow Is Nothing Then
  MsgBox "Öffnen Sie zuerst eine Datei im FrontPage-Editor.", _
    vbOKOnly Or vbCritical
  Exit Sub
End If

If Not ActivePageWindow.ViewMode = fpPageViewNormal Then
  If MsgBox("Das Makro muß in der Normalansicht ausgeführt werden. Soll jetzt zur Normalansicht gewechselt werden?", vbQuestion Or vbYesNo) = vbYes Then
    ActivePageWindow.ViewMode = fpPageViewNormal
  Else
    Exit Sub
  End If
End If

Dim doc As FPHTMLDocument
Set doc = ActivePageWindow.Document

Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Dim ts
Set ts = fs.CreateTextFile(TIDY_TEMP_FILE)
    
'HTML in temporäre Datei schreiben.
ts.Write doc.DocumentHTML
ts.Close
  
Dim strCmd As String
strCmd = TIDY_PROGRAM_FILE & " -f " & TIDY_ERROR_FILE & _
  " -config " & TIDY_CONFIG_FILE & " " & TIDY_TEMP_FILE

'Tidy-Aufruf zusammenstellen und *seriell* ausführen.
'<http://support.microsoft.com/support/kb/articles/Q129/7/96.asp>
ExecCmd strCmd

'HTML wieder aus temporärer Datei laden.
Set ts = fs.OpenTextFile(TIDY_TEMP_FILE, ForReading)

'Einfacher Fehlerbehandlung bei schwerwiegenden HTML-Fehlern,
'die FrontPage nicht akzeptiert.
On Error GoTo TidyError
doc.DocumentHTML = ts.ReadAll
On Error GoTo 0
  
If MsgBox("Sollen die Meldungen von Tidy angezeigt werden?", _
  vbYesNo Or vbQuestion) = vbYes Then
  Shell Environ("WINDIR") & "\notepad.exe " & TIDY_ERROR_FILE
End If

Exit Sub

TidyError:
  MsgBox "Tidy konnte nicht ausgeführt werden. Es wurden keine Änderungen vorgenommen.", vbOKOnly Or vbCritical

End Sub

Sub Tidy_Web()

'Ohne Web geht es nicht...
If ActiveWeb Is Nothing Then
  MsgBox "Öffnen Sie zuerst ein Web.", vbOKOnly Or _
    vbCritical
  Exit Sub
End If

'Alle Editor-Fenster müssen geschlossen sein.
If Not ActivePageWindow Is Nothing Then
  MsgBox "Schließen Sie zuerst alle offenen Editor-Fenster.", _
    vbOKOnly Or vbCritical
  Exit Sub
End If

'Das Verzeichnis, in dem das Web gespeichert ist.
Dim WebDir As String

'Speichert alle Dateien inklusive Pfad.
Dim FileList As String

Dim strCmd As String

With ActiveWeb.Properties
  
  'Es muß zwischen datenträger- und serverbasierten Webs
  'unterschieden werden.
  'Datenträgerbasierte Webs sind einfach.
  If .Item("vti_webservertype") = "diskweb" Then
    WebDir = ActiveWeb.RootFolder.Name
    
  'Bei serverbasierten Webs läßt sich der Speicherordner
  'nicht automatisch feststellen.
  Else
      
    On Error GoTo NotFound
    WebDir = .Item("Speicherordner")
    On Error GoTo 0
    GoTo Continue
      
NotFound:
    On Error GoTo 0
    Do
      WebDir = InputBox("Geben Sie das Verzeichnis an, " & _
        "in dem das aktuelle Web gespeichert wird " & _
        "(z.B. c:\inetpub\wwwroot\meinweb).", "Tidy")
      If WebDir = "" Then
        Exit Sub
      ElseIf Dir(WebDir, vbDirectory) = "" Then
        MsgBox "Der Verzeichnisname ist ungültig.", _
          vbOKOnly Or vbCritical
      Else
        Exit Do
      End If
    Loop
    .Add "Speicherordner", WebDir
    .ApplyChanges

  End If
  
End With
  
Continue:
  
'Rekursiv alle Ordner des Webs durchlaufen.
AddFiles ActiveWeb.RootFolder, FileList, WebDir

'Tidy-Aufruf zusammenstellen.
strCmd = TIDY_PROGRAM_FILE & " -f " & TIDY_ERROR_FILE & _
  " -config " & TIDY_CONFIG_FILE & FileList

'Tidy starten.
ExecCmd strCmd

If MsgBox("Sollen die Meldungen von Tidy angezeigt werden?", _
  vbYesNo Or vbQuestion) = vbYes Then
  Shell Environ("WINDIR") & "\notepad.exe " & TIDY_ERROR_FILE
End If
  
End Sub

Private Sub AddFiles(ByRef myFolder As WebFolder, ByRef _
  FileList As String, ByVal WebDir As String)

  Dim wf As WebFile
  Dim sf As WebFolder

  For Each wf In myFolder.Files
    If IsHTMLFile(wf.Name) Then
      FileList = FileList & " """ & WebDir & "\" & _
        wf.Name & """"
    End If
  Next
  
  For Each sf In myFolder.Folders
    If Not sf.IsWeb Then
      AddFiles sf, FileList, WebDir & "\" & sf.Name
    End If
  Next
  
End Sub

'Bestimmt, ob eine Datei ein HTML-Dokument sein kann.
'Geprüft wird, ob die Erweiterung "htm", "html" oder "asp" ist.
Function IsHTMLFile(ByVal Filename As String) As Boolean
 
IsHTMLFile = ( _
 LCase(Right(Filename, 4)) = "html" Or _
 LCase(Right(Filename, 3)) = "htm" Or _
 LCase(Right(Filename, 3)) = "asp")

End Function