Content management system - Daemon

Der Hintergrund Service erledigt wiederkehrende Aufgaben und erkennt selber ob überhaupt welche anliegen:

  • einmal am Tag überprüft er ob alte Logfiles (älter als 7 Tage) im Verzeichnis /logging liegen und löscht diese
  • löscht Session-Files die älter als einer Stunde sind im Verzeichnis /sessions, sorgt also für das einhalten des Session-Timeout
  • überwacht das Verzeichnis /www/css ob Stylesheets neu hinzugefügt oder geändert wurden und legt sofort eine minimized Version an, die dann auch an Stelle des Original Stylesheets vom ISAPI-Filter ausgeliefert werden kann
  • überwacht das Verzeichnis /www/scripts ob Javascripts neu hinzugefügt oder geändert wurden und legt sofort eine minimized Version an, die dann auch an Stelle des Original Javascripts vom ISAPI-Filter ausgeliefert werden kann
  • überwacht das Verzeichnis /www/code ob neue Code-Dateien hinzugefügt oder geändert wurden und legt sofort eine HTML-Codierte Version mit Syntax highlighting an, um sie im Seiteninhalt einbetten zu können
  • einmal am Tag wird überprüft ob eine neue browscap.ini auf browscap.org zur Verfügung steht und gegebenenfalls die Datei browscap.ini im Verzeichnis /index aktualisiert 
  • überwacht das Verzeichnis /index/gocher und legt im Verzeichnis /index/gocher-pdf die PDF-Version ab
  • überwacht das Verzeichnis /www/downloads und legt im Verzeichnis /index/gocher-downloads die HTML-Version für die Volltextsuche ab
  • überwacht das Verzeichnis /www/media und optimiert geänderte oder neue Bilder

Also im allgemeinen Optimierungs- und Aktualisierungsaufgaben.

daemon.lpr Pascal (23,15 kByte) 14.07.2013 10:15
// *****************************************************************************
//  Title.............. :  ISAPI CMS Daemon
//
//  Modulname ......... :  cmsdaemon.lpr (project file)
//  Type .............. :  Unit
//  Author ............ :  Udo Schmal
//  Development Status  :  01.11.2012
//  Operating System .. :  Win32/Win64
//  IDE ............... :  Lazarus
// *****************************************************************************
program cmsdaemon;

{$mode objfpc}{$H+}

{ TODO 1 -ous : load project ini-File for settings }
{ TODO 2 -ous : reloade ini-File if changed }
{ TODO 3 -ous : create XML-File for image optimisation }
{ TODO 4 -ous : manage status flags }
{ TODO 5 -ous : send newsletters }
{ TODO 6 -ous : Webserver logfile analysis }
{ TODO 7 -ous : import data packages }

uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
  CThreads,
{$ENDIF} Cmem,{$ENDIF}
  Windows, Classes, SysUtils, EventLog, DateUtils, DaemonApp,
  UniParser, GMTUtils, {dExif,} CSS, JS, code2html, Inet, usIndexer;

type
  TCmsThread = class(TThread)
  private
    FList: TStringList;
    FLocalPath, FProj, FHost: string;
  public
    procedure Execute; override;
    property LocalPath: string read FLocalPath write FLocalPath;
    property Proj: string read FProj write FProj;
    property Host: string read FHost write FHost;
  end;

  TCmsDaemon = class(TCustomDaemon)
  private
    FThread: TCmsThread;
  public
    function Install: boolean; override;
    function UnInstall: boolean; override;
    function Start: boolean; override;
    function Stop: boolean; override;
    function Pause: boolean; override;
    function Continue: boolean; override;
    function Execute: boolean; override;
    function ShutDown: boolean; override;
  end;

  TCmsDaemonMapper = class(TCustomDaemonMapper)
  public
    constructor Create(AOwner: TComponent); override;
    procedure ToDoOnInstall(Sender: TObject);
    procedure ToDoOnRun(Sender: TObject);
    procedure ToDoOnUninstall(Sender: TObject);
    procedure ToDoOnDestroy(Sender: TObject);
  end;

var 
  path: string;

function BoolToStr(AVal: Boolean): String;
begin
  if AVal = True then result := 'true' else result := 'false';
end;

function WinExecAndWait(const ACmd: string; wVisibility: word = SW_HIDE): boolean;
var si : TStartUpInfo;
    pi : TProcessInformation;
    Proc: THandle;
begin
  Application.Log(etDebug, 'WinExecAndWait: ' + ACmd);
  result := false;
  FillChar(si, SizeOf(TStartUpInfo), 0);
  with si do
  begin
    cb := SizeOf(TStartUpInfo);
    dwflags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
    wShowWindow := wVisibility;
  end;
  if CreateProcess(nil,
                   PChar(ACmd),           {pointer to command line string}
                   nil,                   {pointer to process security attributes}
                   nil,                   {pointer to thread security attributes}
                   true,                  {handle inheritance flag}
                   Normal_Priority_Class, {creation flags}
                   nil,                   {pointer to new environment block}
                   nil,                   {pointer to current directory name}
                   si,                    {pointer to STARTUPINFO}
                   pi) then               {pointer to PROCESS_INF}
  begin
    Proc := pi.HProcess;
    CloseHandle(pi.hThread);
    if WaitForSingleObject(Proc, Infinite) <> Wait_Failed then result := true;
    CloseHandle(Proc);
  end;
end;

procedure TCmsThread.Execute;
  procedure Indexer();
  var
    Indexer: TIndexer;
    Index: TIndexFile;
  begin
    Indexer := TIndexer.Create(nil);
    try
      Index := TIndexFile.Create(nil);
      if FileExists(FLocalPath + 'index' + PathDelim + FProj + '.dat') then
        SysUtils.DeleteFile(FLocalPath + 'index' + PathDelim + FProj + '.dat');
      Index.FileName := FLocalPath + 'index' + PathDelim + FProj + '.dat';
      Index.Connect;
      Index.WriteOnCommit:=True;
      Indexer.Index := Index;
      Indexer.FileMask := '*.html'; //semicolon separated list
      Indexer.SearchRecursive := true;
      IgnoreListManager.LoadIgnoreWordsFromFile('de', FLocalPath + 'de.txt');
      Indexer.Language := 'de';
      Indexer.UseIgnoreList := true;
      Indexer.SearchPath := FLocalPath + 'index' + PathDelim + FProj;
      Application.Log(etInfo, 'CmsThread.Indexing: ' + IntToStr(Indexer.Execute()));
      Indexer.SearchPath := FLocalPath + 'index' + PathDelim + FProj + '-downloads';
      Application.Log(etInfo, 'CmsThread.Indexing: ' + IntToStr(Indexer.Execute()));
    finally
      Indexer.Index.free;
      FreeAndNil(Indexer);
    end;
  end;

  procedure Minimizer(minPath: string);
  var
    SearchRec: TSearchRec;
    sExt: string;
  begin
    if FindFirst(minPath + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      if ((SearchRec.FindData.dwFileAttributes and faDirectory) <> 0) and
         (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
        Minimizer(minPath + SearchRec.Name + PathDelim)
      else
      begin
        sExt := ExtractFileExt(SearchRec.Name);
        if ((lowercase(sExt)='.css') or (lowercase(sExt)='.js')) then
          if lowercase(ExtractFileExt(ChangeFileExt(SearchRec.Name, ''))) <> '.min' then
            if not FileExists(minPath + ChangeFileExt(SearchRec.Name, '.min'+sExt)) or
              (FileTimeGMT(SearchRec)<>FileTimeGMT(minPath + ChangeFileExt(SearchRec.Name, '.min'+sExt))) then
            begin
              Application.Log(etInfo, 'Thread.Execute: minimize ' + minPath + SearchRec.Name );
              if (lowercase(sExt)='.css') then
                CSSMinFile(minPath + SearchRec.Name)
              else //if (lowercase(sExt)='.js') then
                JSMinFile(minPath + SearchRec.Name);
              FileTimeCopy(minPath + SearchRec.Name, minPath + ChangeFileExt(SearchRec.Name, '.min'+sExt));
              Application.Log(etDebug, 'CmsThread.Execute: ' + sExt + 'min: ' + minPath + SearchRec.Name);
            end;
      end;
    until FindNext(SearchRec) <> 0;
    SysUtils.FindClose(SearchRec);
  end;

  procedure CodeToHtml(codePath: string);
  var
    SearchRec: TSearchRec;
    MemoryStream: TMemoryStream;
    sExt: string;
    sText: RawByteString;
  begin
    if FindFirst(codePath + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      if ((SearchRec.FindData.dwFileAttributes and faDirectory) <> 0) and
         (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
        CodeToHtml(codePath + SearchRec.Name + PathDelim)
      else
      begin
        sExt := ExtractFileExt(SearchRec.Name);
        if pos(lowercase(sExt), '.lpr.pas.pp.js.css.htm')>0 then
          if not FileExists(codePath + SearchRec.Name + '.html') or
            (FileTimeGMT(SearchRec)<>FileTimeGMT(codePath + SearchRec.Name + '.html')) then
          begin
            sText := ConvertCodeToHtml(codePath + SearchRec.Name);
            if (Length(sText) > 0) then
            begin
              sText := '<html>'#13#10'<head>'#13#10'<title>'+SearchRec.Name+'</title>'#13#10'</head>'#13#10'<body>'+sText+'</body>'#13#10'</html>';
              MemoryStream := TMemoryStream.Create;
              try
                MemoryStream.WriteBuffer(sText[1], Length(sText));
                MemoryStream.SaveToFile(codePath + SearchRec.Name + '.html');
{$ifdef info}WriteLog(etInfo, 'CodeToHtml: save html Version (' + ChangeFileExt(AFilename, sExt + '.html') + ')');{$endif}
              finally
                MemoryStream.Free;
              end;
            end;
          end;
      end;
    until FindNext(SearchRec) <> 0;
    SysUtils.FindClose(SearchRec);
  end;

{  procedure CheckImage(AFilename: string);
  var
    ImgData: TImgData;
    dt: TDateTime;
  begin
    if FileExists(AFilename) then
    begin
      ImgData := TimgData.Create;
      try
        ImgData.BuildList := GenAll;
        ImgData.ProcessFile(AFilename);
        dt := ImgData.ExifObj.GetImgDateTime;
        SetCreationTime(AFilename, dt);
      finally
        FreeAndNil(ImgData);
      end
    end;
  end;
}
  function FindTextInFile(FullPathName, TextToFind: string): boolean;
  var f: textfile;
      line, lcTextToFind: string;
  begin
    lcTextToFind := LowerCase(TextToFind);
    result := false;
    assignfile(f, FullPathName);
    reset(f);
    while (not eof(f)) and (not result) do
    begin
      readln(f, line);
      line := lowercase(line);
      result := (pos(lcTextToFind, line) > 0);
    end;
    closefile(f);
  end;

var
  i, iDay: integer;
  cssPath, jsPath, xinhaPath, imagesPath, downloadsPath, idxPath, pdfPath, idxdownloadsPath, codePath, sFile, s: string;
  SearchRec: TSearchRec;
  SEOFile: TStringList;
  dt: TDateTime;
  optimize, changed: boolean;
//  fChangeNotify : DWORD;
begin
  //inherited Execute;
  Application.Log(etDebug, 'CmsThread.Execute');
  try
    FList := TStringList.Create;
    cssPath := FLocalPath + 'wwwroot' + PathDelim + 'styles' + PathDelim;
    jsPath := FLocalPath + 'wwwroot' + PathDelim + 'scripts' + PathDelim;
    xinhaPath := FLocalPath + 'wwwroot' + PathDelim + 'Xinha' + PathDelim;
    downloadsPath := FLocalPath + 'wwwroot' + PathDelim + 'downloads' + PathDelim + FProj + PathDelim;
    imagesPath := FLocalPath + 'wwwroot' + PathDelim + 'images' + PathDelim + FProj + PathDelim;
    idxPath := FLocalPath + 'index' + PathDelim + FProj + PathDelim;
    pdfPath := FLocalPath + 'index' + PathDelim + FProj + '-pdf' + PathDelim;
    idxdownloadsPath := FLocalPath + 'index' + PathDelim + FProj + '-downloads' + PathDelim;
    codePath := FLocalpath + 'wwwroot' + PathDelim + 'code' + PathDelim;
    iDay := 0;

    FList.LoadFromFile(FLocalpath + 'index' + PathDelim + FProj + '-files.txt');
    repeat
      Sleep(5000); //milliseconds
      changed := false;

      if iDay <> DayOf(Now()) then
      begin
//        Application.Log(etInfo, 'CmsThread.Execute: delete old logfiles');
        Application.EventLog.Active := false;
        Application.EventLog.FileName := path + 'logging' + PathDelim + ChangeFileExt(ExtractFileName(ParamStr(0)), FormatDateTime('dd"."mm"."yyyy', Now) + '.log');
        Application.EventLog.Active := true;
        if FindFirst(FLocalPath + 'logging' + PathDelim + '*.log', 0, SearchRec) = 0 then
        repeat
          dt := FileTimeGMT(SearchRec);
          if (dt+7)<NowGMT() then
          begin
            sFile := FLocalPath + 'logging' + PathDelim + SearchRec.Name;
            Application.Log(etINfo, 'CmsThread.Exceute: delete: ' + sFile + ' ' + DateTimeToString(GMTToLocalTime(dt), tsLog));
            DeleteFile(sFile);
          end;
        until FindNext(SearchRec) <> 0;
        FindClose(SearchRec);

        dt := FileTimeGMT(FLocalPath + 'index' + PathDelim + 'browscap.ini');
        if (dt+1)<NowGMT() then
        begin
//          Application.Log(etInfo, 'CmsThread.Execute: get browscap.ini');
            sFile := FLocalPath + 'index' + PathDelim + 'browscap~.ini';
//          if Download('http://browsers.garykeith.com/stream.asp?BrowsCapINI', sFile) then
          if Download('http://tempdownloads.browserscap.com/stream.php?BrowsCapINI', sFile) then
          begin
            if not FindTextInFile(sFile, '<html') then
            begin
              Application.Log(etInfo, 'CmsThread.Execute: update: ' + FLocalPath + 'index' + PathDelim + 'browscap.ini');
              CopyFile(PChar(sFile), PChar(FLocalPath + 'index' + PathDelim + 'browscap.ini'), false);
            end
            else
              Application.Log(etError, 'CmsThread.Execute: update: ' + FLocalPath + 'index' + PathDelim +'browscap.ini failed!');
            DeleteFile(sFile);
          end;
        end;
        iDay := DayOf(Now());
      end;

//      Application.Log(etInfo, 'CmsThread.Execute: delete session files after session timeout');
      if FindFirst(FLocalPath + 'sessions' + PathDelim + '*.ini', 0, SearchRec) = 0 then
      repeat
        dt := FileTimeGMT(SearchRec);
        if (dt+(1/24))<NowGMT() then //session timeout: one hour
        try
          sFile := FLocalPath + 'sessions' + PathDelim + SearchRec.Name;
          Application.Log(etInfo, 'CmsThread.Exceute: delete: ' + sFile + ' ' + DateTimeToString(GMTToLocalTime(dt), tsLog));
          DeleteFile(sFile);
        except
          Application.Log(etError, 'CmsThread.Exceute: delete: ' + sFile + ' ' + DateTimeToString(GMTToLocalTime(dt), tsLog));
        end;
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);

//      Application.Log(etInfo, 'CmsThread.Execute: js & css minimizer');
      Minimizer(cssPath);
      Minimizer(jsPath);
      Minimizer(xinhaPath);
      CodeToHtml(codePath);
//      Application.Log(etInfo, 'CmsThread.Execute: HTMLtoPDF: generate PDF from index file');
      if FindFirst(idxPath + '*.html', 0, SearchRec) = 0 then
      repeat
        if not FileExists(pdfPath + ChangeFileExt(SearchRec.Name, '.pdf')) or
          (FileTimeGMT(SearchRec)>FileTimeGMT(pdfPath + ChangeFileExt(SearchRec.Name, '.pdf'))) then
        begin
          changed := true;
          Application.Log(etInfo, 'CmsThread.Execute: create PDF: ' + pdfPath + ChangeFileExt(SearchRec.Name, '.pdf'));
          WinExecAndWait(FLocalPath + 'htmltopdf.exe --ignore-load-errors' +
                         ' "http://' + FHost + '/' + ChangeFileExt(SearchRec.Name, '') + '?media=print&name=pdfgen&password=mypassw"' +
                         ' "' + pdfPath + ChangeFileExt(SearchRec.Name, '.pdf'));
          FileTimeCopy(idxPath + SearchRec.Name, pdfPath + ChangeFileExt(SearchRec.Name, '.pdf'));
        end;
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);

      if FindFirst(pdfPath + '*.pdf', 0, SearchRec) = 0 then
      repeat
        if not FileExists(idxPath + ChangeFileExt(SearchRec.Name, '.html')) then
        begin
          changed := true;
          Application.Log(etInfo, 'CmsThread.Execute: delete: ' + pdfPath + SearchRec.Name);
          DeleteFile(pdfPath + SearchRec.Name);
        end;
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);

      if FindFirst(downloadsPath + '*.pdf', 0, SearchRec) = 0 then
      repeat
        if not FileExists(idxdownloadsPath + ChangeFileExt(SearchRec.Name, '.html')) or
          (FileTimeGMT(SearchRec)>FileTimeGMT(idxdownloadsPath + ChangeFileExt(SearchRec.Name, '.html'))) then
        begin
          Application.Log(etInfo, 'CmsThread.Execute: PDFtoHTML: create index file: '+ downloadsPath + SearchRec.Name);
          if WinExecAndWait(FLocalPath + 'pdftohtml -i -noframes -q ' + downloadsPath + SearchRec.Name, SW_HIDE) and
            FileExists(downloadsPath + ChangeFileExt(SearchRec.Name, '.html')) then
          begin
            with TParser.Create do
            try
              LoadFromFile(downloadsPath + ChangeFileExt(SearchRec.Name, '.html'));
              SaveAsUtf8File(idxdownloadsPath + ChangeFileExt(SearchRec.Name, '.html'));
              changed := true;
            finally
              DeleteFile(downloadsPath + ChangeFileExt(SearchRec.Name, '.html'));
              Free;
            end;
            Application.Log(etInfo, 'CmsThread.Execute: create Index: ' + idxdownloadsPath + ChangeFileExt(SearchRec.Name, '.html'));
            FileTimeCopy(downloadsPath + SearchRec.Name, idxdownloadsPath + ChangeFileExt(SearchRec.Name, '.html'));
          end;
        end;
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);

//      Application.Log(etInfo, 'CmsThread.Execute: delete index file if PDF not exists anymore');
      if FindFirst(idxdownloadsPath + '*.html', 0, SearchRec) = 0 then
      repeat
        if not FileExists(downloadsPath + ChangeFileExt(SearchRec.Name, '.pdf')) then
        begin
          Application.Log(etInfo, 'CmsThread.Execute: delete: ' + idxdownloadsPath + SearchRec.Name);
          DeleteFile(idxdownloadsPath + SearchRec.Name);
          changed := true;
        end;
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);

      if changed then Indexer();

//      Application.Log(etInfo, 'Thread.Execute: optimize images');
      changed := false;
      if FindFirst(imagesPath + '*.*', faAnyFile { or faSymLink}, SearchRec) = 0 then
      repeat
        optimize := false;
        if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
        begin
          if ((SearchRec.FindData.dwFileAttributes and faDirectory) = 0) and
            (pos(lowercase(ExtractFileExt(SearchRec.Name)), '.png.jpg.jpeg')>0) then
          begin
            i := FList.IndexOfName(imagesPath + SearchRec.Name);
            optimize := (i = -1);
            if not optimize then
              optimize := (StringToDateTime(FList.ValueFromIndex[i], tsGER) <> FileTimeGMT(SearchRec));
            if optimize then
            begin
              if (lowercase(ExtractFileExt(SearchRec.Name))='.png') then
              begin
                Application.Log(etDebug, 'CmsThread.Execute: optimize PNG: ' + imagesPath + SearchRec.Name);
                WinExecAndWait(FLocalPath + 'optipng.exe -o7 "' + imagesPath + SearchRec.Name + '"', SW_HIDE);
              end
              else if (pos(lowercase(ExtractFileExt(SearchRec.Name)), '.jpg.jpeg')>0) then
              begin
                Application.Log(etDebug, 'CmsThread.Execute: optimize JPEG: ' + imagesPath + SearchRec.Name);
                WinExecAndWait(FLocalPath + 'jpegoptim.exe --strip-all "' + imagesPath + SearchRec.Name + '"', SW_HIDE);
              end;
              if (i = -1) then
                FList.Add(imagesPath + SearchRec.Name + '=' + DateTimeToString(FileTimeGMT(SearchRec), tsGER))
              else
                FList.ValueFromIndex[i] := DateTimeToString(FileTimeGMT(SearchRec), tsGER);
              changed := true;
            end;
          end;
        end;
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);

      if changed then
      begin
        Application.Log(etDebug, 'CmsThread.Exceute: update: ' + FLocalPath + 'index' + PathDelim + FProj + '-files.txt ' + DateTimeToStr(dt));
        FList.SaveToFile(FLocalpath + 'index' + PathDelim + FProj + '-files.txt');
      end;

//      Application.Log(etInfo, 'CmsThread.Execute: Webparser for SEO-Analyse');
      if FindFirst(FLocalPath + 'seo' + PathDelim + '*.ini', 0, SearchRec) = 0 then
      repeat
        SEOFile := TStringList.Create;
        SEOFile.LoadFromFile(FLocalPath + 'seo' + PathDelim + SearchRec.Name);
        s := ' --domain=' + SEOFile.Values['domain'] +
             ' --path=' + SEOFile.Values['path'] +
             ' --type=' + SEOFile.Values['type'];
        if SEOFile.Values['zip']='true'  then s := s + ' --zip';
        SEOFile.Values['start'] := NowToGMT(tsGER);
        WinExecAndWait(FLocalPath + 'Webparser.exe' + s, SW_HIDE);
        SEOFile.Values['end'] := NowToGMT(tsGER);
        SEOFile.SaveToFile(FLocalPath + 'seo' + PathDelim + SearchRec.Name);
        SEOFile.Free;
        RenameFile(FLocalPath + 'seo' + PathDelim + SearchRec.Name, FLocalPath + 'seo' + PathDelim + SearchRec.Name + '.done')
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);

    until Terminated;
    FreeAndNil(FList);
  except
    on E: Exception do
      Application.Log(etError, 'CmsThread.Execute: ' + E.Message);
  end;
end;

{$REGION ' - CmsDaemon - '}
function TCmsDaemon.Install: boolean;
begin
  result := inherited Install;
  Application.Log(etDebug, 'CmsDaemon.Installed: ' + BoolToStr(result));
end;

function TCmsDaemon.Start: boolean;
begin
  result := inherited Start;
  if not assigned(FThread) then
  begin
    FThread := TCmsThread.Create(true);
    FThread.FreeOnTerminate := true;
    FThread.LocalPath := path;
    FThread.Proj := 'gocher';
    FThread.Host := 'www.gocher.me';
    FThread.Resume;
  end;
  Application.Log(etDebug, 'CmsDaemon.Start: ' + BoolToStr(result));
end;

function TCmsDaemon.Stop: boolean;
begin
  result := inherited Stop;

  if assigned(FThread) then
  begin
    FThread.Terminate;
    FThread.WaitFor;
    FThread := nil;
  end;
  Application.Log(etDebug, 'CmsDaemon.Stop: ' + BoolToStr(result));
end;

function TCmsDaemon.UnInstall: boolean;
begin
  result := inherited UnInstall;
  Application.Log(etDebug, 'CmsDaemon.Uninstall: ' + BoolToStr(result));
end;

function TCmsDaemon.Pause: boolean;
begin
  result := inherited Pause;
  if assigned(FThread) then
  begin
    FThread.Suspend;
    result := true;
  end;
  Application.Log(etDebug, 'CmsDaemon.Pause: ' + BoolToStr(result));
end;

function TCmsDaemon.Continue: boolean;
begin
  result := inherited Continue;
  if assigned(FThread) then
  begin
    FThread.Resume;
    result := true;
  end;
  Application.Log(etDebug, 'CmsDaemon.Continue: ' + BoolToStr(result));
end;

function TCmsDaemon.Execute: boolean;
begin
  result := inherited Execute;
  Application.Log(etDebug, 'CmsDaemon.Execute: ' + BoolToStr(result));
end;

function TCmsDaemon.ShutDown: boolean;
begin
  result := inherited ShutDown;
  Application.Log(etDebug, 'CmsDaemon.ShutDown: ' + BoolToStr(result));
end;
{$ENDREGION}

{$REGION ' - CmsDaemonMapper - '}
constructor TCmsDaemonMapper.Create(AOwner: TComponent);
begin
  Application.Log(etDebug, 'CmsDaemonMapper.Create');
  inherited Create(AOwner);
  with DaemonDefs.Add as TDaemonDef do
  begin
    DaemonClassName := 'TCmsDaemon';
    Name := 'CmsDaemon';
    Description := 'Udos ISAPI CMS Daemon';
    DisplayName := 'ISAPI CMS Daemon';
//    RunArguments := '--run';
    Options := [doAllowStop,doAllowPause];
    Enabled := true;
    with WinBindings do
    begin
      StartType := stBoot;
      WaitHint := 0;
      IDTag := 0;
      ServiceType := stWin32;
      ErrorSeverity := esIgnore;
    end;
//    OnCreateInstance := ?;
    LogStatusReport := false;
  end;
  OnInstall := @Self.ToDoOnInstall;
  OnRun := @Self.ToDoOnRun;
  OnUnInstall := @Self.ToDoOnUninstall;
  OnDestroy := @Self.ToDoOnDestroy;
  Application.Log(etDebug, 'CmsDeamonMapper.Createted');
end;

procedure TCmsDaemonMapper.ToDoOnInstall(Sender: TObject);
begin
  Application.Log(etDebug, 'CmsDaemonMapper.Install');
end;

procedure TCmsDaemonMapper.ToDoOnRun(Sender: TObject);
begin
  Application.Log(etDebug, 'CmsDaemonMapper.Run');
end;

procedure TCmsDaemonMapper.ToDoOnUnInstall(Sender: TObject);
begin
  Application.Log(etDebug, 'CmsDaemonMapper.Uninstall');
end;

procedure TCmsDaemonMapper.ToDoOnDestroy(Sender: TObject);
begin
  //doesn't comes here
  Application.Log(etDebug, 'CmsDaemonMapper.Destroy');
end;
{$ENDREGION}

{$R *.res}

begin
  path := ExtractFilePath(ParamStr(0));
//  heaptrc.SetHeapTraceOutput(path + 'logging' + PathDelim + ChangeFileExt(ExtractFileName(ParamStr(0)), '.heap'));
  RegisterDaemonClass(TCmsDaemon);
  RegisterDaemonMapper(TCmsDaemonMapper);
  with Application do
  begin
    Title := 'ISAPI CMS Daemon Application';
    EventLog.LogType := ltFile;
    EventLog.DefaultEventType := etDebug;
    EventLog.AppendContent := true;
    EventLog.FileName := path + 'logging' + PathDelim + ChangeFileExt(ExtractFileName(ParamStr(0)), FormatDateTime('dd"."mm"."yyyy', Now) + '.log');
    Initialize;
    Run;
  end;
end.

basierend auf Daemon (Service)

Autor: , veröffentlicht: , letzte Änderung:

Kontakt

Copyright / License of sources

Copyright (c) 2007-2017, Udo Schmal <udo.schmal@t-online.de>

Permission to use, copy, modify, and/or distribute the software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.

THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

Service Infos

CMS Info
UDOs Webserver

0.3.1.24

All in one Webserver

Udo Schmal

Sa, 21 Okt 2017 00:30:10
Development Info
Lazarus LCL 1.9.0.0

Free Pascal FPC 3.1.1

OS:Win64, CPU:x86_64
Hardware Info
Precision WorkStation T3500

Intel(R) Xeon(R) CPU W3530 @ 2.80GHz

x86_64, 1 physical CPU(s), 4 Core(s), 8 logical CPU(s), 2800 MHz