Der Hintergrund Service erledigt wiederkehrende Aufgaben und erkennt selber, ob überhaupt welche anliegen:
Also im allgemeinen Optimierungs- und Aktualisierungsaufgaben.
daemon.lpr Pascal (23,15 kByte) 14.07.2013 12:15
program cmsdaemon;
{$mode objfpc} {$H+}
uses
{$IFDEF UNIX} {$IFDEF UseCThreads}
CThreads,
{$ENDIF} Cmem,{$ENDIF}
Windows, Classes, SysUtils, EventLog, DateUtils, DaemonApp,
UniParser, GMTUtils, 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),
nil ,
nil ,
true ,
Normal_Priority_Class,
nil ,
nil ,
si,
pi) then
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' ; 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 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 ;
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;
begin
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 ); changed := false ;
if iDay <> DayOf(Now()) then
begin
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
sFile := FLocalPath + 'index' + PathDelim + 'browscap~.ini' ;
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 ;
if FindFirst(FLocalPath + 'sessions' + PathDelim + '*.ini' , 0 , SearchRec) = 0 then
repeat
dt := FileTimeGMT(SearchRec);
if (dt+ (1 / 24 ))< NowGMT() then 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);
Minimizer (cssPath);
Minimizer (jsPath);
Minimizer (xinhaPath);
CodeToHtml (codePath);
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);
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 ();
changed := false ;
if FindFirst(imagesPath + '*.*' , faAnyFile , 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 ;
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' ;
Options := [doAllowStop,doAllowPause];
Enabled := true ;
with WinBindings do
begin
StartType := stBoot;
WaitHint := 0 ;
IDTag := 0 ;
ServiceType := stWin32;
ErrorSeverity := esIgnore;
end ;
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
Application.Log(etDebug, 'CmsDaemonMapper.Destroy' );
end ;
{$ENDREGION}
{$R *.res}
begin
path := ExtractFilePath(ParamStr(0 ));
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 .