{TO-DO
- What if I don't call .Free() on a .Create() stuff? Memory leak, or gets destroyed after function returns?
- FTP
}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, ExtCtrls, StrUtils;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses RegExpr;

const
  inputdir : String = '.\input\';
  templatesdir : String = '.\templates\';
  outputdir : String = '.\output\';
  datafile : String = '.\data.txt';

{$R *.dfm}

//========================================================================

{function GetFileDate(TheFileName: string): string;
var
  f: integer;
begin
  f := FileOpen(TheFileName, 0);
  try
    //Result := DateTimeToStr(FileDateToDateTime(FileGetDate(f)));
    Result := DateToStr(FileDateToDateTime(FileGetDate(f)));
  finally
    FileClose(f);
  end;
end;}

function GetFileDate(TheFileName: string): TDateTime;
var
  f: integer;
begin
  f := FileOpen(TheFileName, 0);
  try
    Result := FileDateToDateTime(FileGetDate(f));
  finally
    FileClose(f);
  end;
end;

procedure WriteFile (const MyFile: String; const MyStuff: String);
var
  MyFileHdl : TextFile;
begin
  AssignFile(MyFileHdl, MyFile);
  ReWrite(MyFileHdl);
  Write(MyFileHdl,MyStuff);
  CloseFile(MyFileHdl);
end;

function ReadFile (const MyFile: String): String;
var
  MyFileHdl : TextFile;
  MyStuff : String;
  text : String;
begin
  AssignFile(MyFileHdl, MyFile);
  Reset(MyFileHdl);
  while not Eof(MyFileHdl) do begin
    ReadLn(MyFileHdl, text);
    MyStuff := MyStuff + text + #13#10;
  end;
  CloseFile(MyFileHdl);
  Result := MyStuff;
end;

//========================================================================

procedure TForm1.Button1Click(Sender: TObject);
const
  running : Boolean = False; //True = Already clicked
var
  searchResult : TSearchRec;
  MyHeader : String;
  MyFooter : String;
  MyArticle : String;
  MyStuff : String;
  MyTitle : String;
  MyIndexB4 : String;
  MyIndexAfter : String;

  subdirectories : TStringList;
  i : Integer;
  OrigDate : TDateTime;
  CurrentDate : TDateTime;
  f: integer;
  filedata : TStringList;
  MyKeywords : String;
  MyClassification : String;
  MyFile : String;
  indexclassifications : TStringList;
  data : TStringList;
  LastModified : String;
begin
  //Check if already running
  If (running) then begin
    running := False;
    Button1.Caption := 'Build Site';
    ListBox1.Clear;
    ListBox1.Items.Add('Hit Cancel: Stopping.');
    ListBox1.Perform(WM_VSCROLL, SB_BOTTOM, 0);
  end else begin
    running := True;
    Button1.Caption := 'Cancel';
    ListBox1.Clear;
    ListBox1.Items.Add('Started work @ ' + TimeToStr(Time));
    ListBox1.Perform(WM_VSCROLL, SB_BOTTOM, 0);
  end;

  //Check that directories exist
  if not DirectoryExists(inputdir) then begin
    Button1.Caption := 'Build Site';
    ListBox1.Clear;
    ListBox1.Items.Add(inputdir + ' does not exist');
    ListBox1.Perform(WM_VSCROLL, SB_BOTTOM, 0);
    Exit;
  end;

  if not DirectoryExists(templatesdir) then begin
    Button1.Caption := 'Build Site';
    ListBox1.Clear;
    ListBox1.Items.Add(templatesdir + ' does not exist');
    ListBox1.Perform(WM_VSCROLL, SB_BOTTOM, 0);
    Exit;
  end;

  If not DirectoryExists(outputdir) then begin
    CreateDir(outputdir);
  end;

  //If exists, read .\data.txt which is used to hold TITLE and CAT for all .\output HTML files
  data := TStringList.Create;
  if FileExists(datafile) then begin
    data.LoadFromFile(datafile);
    //Set file to empty in case we make any change before rewriting to the file with SaveToFile()
    DeleteFile(datafile);
  //Deleting datafile triggers regeneration of site
  end else begin
    FindFirst(outputdir + '*.htm?', faAnyFile+faReadOnly, searchResult);
    DeleteFile(outputdir + searchResult.Name);
    while FindNext(searchResult)=0 do begin
      DeleteFile(outputdir + searchResult.Name);
    end;
    FindClose(searchResult);
  end;

  //========================================================================
  screen.cursor:=crHourGlass;

  //List sub-directories
  if FindFirst(inputdir + '*', faDirectory, searchResult) = 0 then begin
    subdirectories := TStringList.Create;
    repeat
      //User clicked on Cancel?
      Application.ProcessMessages;
      if not running then begin
        screen.cursor := crDefault;
        Exit;
      end;
      // Only show directories
      if ((searchResult.attr and faDirectory) = faDirectory) and (searchResult.Name <> '.') and (searchResult.Name <> '..') then begin
        subdirectories.Add(searchResult.Name + '\');
      end;
    until FindNext(searchResult) <> 0;
    // Must free up resources used by these successful finds
    FindClose(searchResult);
  end;

  //Check if any valid subdirectory found under .\input
  If subdirectories.Count = 0 then begin
    screen.cursor:=crHourGlass;
    ListBox1.Clear;
    ListBox1.Items.Add('No sub-directory(ies) found under ' + inputdir);
    ListBox1.Perform(WM_VSCROLL, SB_BOTTOM, 0);
    Button1.Caption := 'Build Site';
    Exit;
  end;

  //========================================================================

  //Read templates
  MyHeader := ReadFile(templatesdir + 'header.html');
  MyFooter := ReadFile(templatesdir + 'footer.html');
  MyArticle := ReadFile(templatesdir + 'article.html');

  for i := 0 to subdirectories.Count-1 do begin
    //User clicked on Cancel?
    Application.ProcessMessages;
    if not running then begin
      screen.cursor := crDefault;
      Exit;
    end;

    //Massage each file in current sub-folder
    if FindFirst(inputdir + subdirectories[i] + '*.htm?', faAnyFile, searchResult) = 0 then begin

      repeat
        //User clicked on Cancel?
        Application.ProcessMessages;
        if not running then begin
          screen.cursor := crDefault;
          Exit;
        end;

        //Compare FileDate in .\input and .\output: If .\input is more recent, rebuild
        OrigDate := GetFileDate(inputdir + subdirectories[i] + searchResult.Name);
        if FileExists(outputdir + searchResult.Name) then begin
          CurrentDate := GetFileDate(outputdir + searchResult.Name);
        end else begin
          //If file doesn't exit, set CurrentDate to dummy value;
          CurrentDate := 0;
        end;

        //Is .\input\<file> more recent that its brother in .\output, or brand new file?
        If (CurrentDate = 0) or (OrigDate > CurrentDate) then begin
          ListBox1.Items.Add('Adding/updating ' + inputdir + subdirectories[i] + searchResult.Name);

          MyStuff := ReadFile(inputdir + subdirectories[i] + searchResult.Name);

          with TRegExpr.Create do
            try
              //Make it case-insensitive
              ModifierI := True;

              Expression := '<title>(.*?)</title>';
              if Exec (MyStuff) then begin
                MyTitle := Match[1];
              end;
              //If user forgot to set TITLE...
              If Length(MyTitle) = 0 then begin
                ListBox1.Items.Add('! No TITLE found in ' + inputdir + subdirectories[i] + searchResult.Name);
                ListBox1.Perform(WM_VSCROLL, SB_BOTTOM, 0);
                MyTitle := '(This document has no TITLE section!)';
              end;

              Expression := '<meta name="keywords" content="(.*?)">';
              if Exec (MyStuff) then begin
                MyKeywords := Match[1];
              end;

              Expression := '<body.*?>(.*?)</body>';
              if Exec (MyStuff) then begin
                MyStuff := MyHeader + MyArticle + Match[1] + MyFooter;
              end;

              //Change TITLE in header.html to actual TITLE for this document
              MyStuff := ReplaceRegExpr ('<title>.*?</title>', MyStuff,
                '<title>' + MyTitle + '</title>');

              MyClassification := AnsiLeftStr(subdirectories[i], Length(subdirectories[i]) - 1);

              //For subdirectory, ignore trailing '\'
              MyStuff := ReplaceRegExpr ('</head>', MyStuff,
                #9 + '<title>' + MyTitle + '</title>' + #13#10 +
                #9 + '<meta name="keywords" content="' + MyKeywords + '">' + #13#10 +
                #9 + '<meta name="classification" content="' +
                MyClassification + '">' + #13#10 +
                '</head>');

              //LongDateFormat := 'dd mmmm yyyy';
              DateTimeToString(LastModified, 'dd-mm-yyyy', Date);
              MyStuff := ReplaceRegExpr ('###date###', MyStuff, LastModified);

              WriteFile (outputdir + searchResult.Name,MyStuff);

              //Save infos into data file in the form myfile.html=mycategory#Some nifty title
              //Check if key already exists, ie. existing article was modified, not created
              If data.Values[searchResult.Name] <> '' then begin
                data.Values[searchResult.Name] := MyClassification +'#' + MyTitle;
              end else begin
                data.Add(searchResult.Name + '=' + MyClassification +'#' + MyTitle);
              end;
          finally
            Free;
          end;

        end else begin
          ListBox1.Items.Add('No change for ' + inputdir + subdirectories[i] + searchResult.Name);
        end;
        Application.ProcessMessages;
        //ListBox1.ItemIndex := ListBox1.Items.Count - 1;
        ListBox1.Perform(WM_VSCROLL, SB_BOTTOM, 0);
      until FindNext(searchResult) <> 0;
      // Must free up resources used by these successful finds
      FindClose(searchResult);
    end;
  end;

  //========================================================================

  //Build .\output\index.html
  //In .\output\, delete index.html and open all other HTML files to rip their TITLE
  If FileExists(outputdir + 'index.html') then
    DeleteFile(outputdir + 'index.html');

  indexclassifications := TStringList.Create;

  for i := 0 to data.Count-1 do begin
    //Check if file was removed from .\output (we don't check but assume it's been also removed from .\input)
    If not FileExists(outputdir + data.Names[i]) then begin
      //Remove entry from data file
      data.Delete(i);
    end;
  end;

  for i := 0 to data.Count-1 do begin
    //User clicked on Cancel?
    Application.ProcessMessages;
    if not running then begin
      screen.cursor := crDefault;
      Exit;
    end;

    with TRegExpr.Create do
      try
        //Make it case-insensitive
        ModifierI := True;

        MyFile := data.Names[i];

        Expression := '(.*?)#(.*)';
        if Exec (data.ValueFromIndex[i]) then begin
          MyClassification := Match[1];
          MyTitle := Match[2];
        end;

        indexclassifications.Values[MyClassification] := indexclassifications.Values[MyClassification] +
          '<li><a href="' + MyFile + '">' + MyTitle + '</a></li>' + #13#10;
      finally
        Free;
    end;
  end;


  //=====================================

  //Let's build index.html for its constituting parts
  MyHeader := ReadFile(templatesdir + 'header.html');
  MyFooter := ReadFile(templatesdir + 'footer.html');
  MyIndexB4 := ReadFile(templatesdir + 'index-b4.html');
  MyIndexAfter := ReadFile(templatesdir + 'index-after.html');

  MyStuff := MyHeader + MyIndexB4;

  //One H3 section per classification
  // + AnsiUpperCase(indexclassifications.Names[i])
  for i := 0 to indexclassifications.Count-1 do begin
    //User clicked on Cancel?
    Application.ProcessMessages;
    if not running then begin
      screen.cursor := crDefault;
      Exit;
    end;

    indexclassifications.ValueFromIndex[i] := '<h3>'
      + indexclassifications.Names[i]
      + '</h3>' + #13#10
      + '<ul>' + #13#10
      + indexclassifications.ValueFromIndex[i]
      + '</ul>' + #13#10;
    MyStuff := MyStuff + indexclassifications.ValueFromIndex[i];
    Application.ProcessMessages;
  end;

  indexclassifications.Free;

  MyStuff := MyStuff + MyIndexAfter + MyFooter;

  WriteFile (outputdir + 'index.html',MyStuff);

  data.SaveToFile(datafile);

  data.Free;

  Button1.Caption := 'Build Site';
  screen.cursor := crDefault;

  ListBox1.Items.Add('Finished work @ ' + TimeToStr(Time));
  ListBox1.Perform(WM_VSCROLL, SB_BOTTOM, 0);

  running := False;
end;

end.