unit RGServices;

interface

uses
  Forms, Windows, SysUtils, Classes, IniFiles, SvcMgr, Dialogs, WinSvc, ShellAPI,
  RGServiceLogWriter, RGServiceNetLogWriter, Generics.Collections, Indexes;

type

  TRGService = class;

  TServiceLogic = class(TThread)
    constructor Create(Parent: TRGService; CreateSuspended: Boolean); overload;
  public
    Service  : TRGService;
    function ServiceThread: TServiceThread;
  end;

  TLogicControlThread = class(TThread)
  protected
    procedure Execute; override;
  public
    Service  : TRGService;
  end;

  TVisualLogItem = record
    FileName  : string;
    Data      : TLogItem;
  end;
  TVisualLog = TListEx<TVisualLogItem>;

  TLogicCreate = Function(Sender: TRGService): TServiceLogic;

  TRGService = class(TService)
    constructor Create(ServiceName, ServiceDisplayName,Description: string; LogicCreateEvent: TLogicCreate); reintroduce;
    destructor Destroy; override;

    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure Stop;
  private
    { Private declarations }
    LogFileName           : string;
    StartTime             : TDateTime;
    NextRetry             : TDateTime;

    UpdateCount           : integer;
    LogWriter             : TLogWriter;
    NetWriter             : TNetLogWriter;

    FServLogic            : TServiceLogic;
    FLogicControlThread   : TLogicControlThread;
    FForceLogicControl    : boolean;
    FLogicIdleTimeout     : double;
    FLogicMaximumMemoryMb : double;
    FLastLogicAliveTime   : TDateTime;
    CheckStop             : TDateTime;
    InStopMode            : boolean;

    procedure SetForceLogicControl(const Value: boolean);
    procedure OnAfterInstall(Sender: TService);
    procedure LogWriteLog(Item: TLogItem; FileName: string);
  public
    VisualLog           : TVisualLog;
    Ini                 : TIniFile;
    FLogicCreateEvent   : TLogicCreate;
    FDescription        : string;

    procedure StrToLog(Str: string; LogFileName: string = '');
    procedure PostInfo(Str: string);
    procedure PostWarning(Str: string);
    procedure PostError(Str: string);
    procedure PostTNGMessage(Str: string);

    function  LastPostTime: TDateTime;

    function  GetLogFileName: string;
    function  GetServiceController: TServiceController; override;
    procedure UpdateDebugInterface;

    procedure Run;

    procedure GenerateBatFiles;

    procedure TerminateService(ErrorCode: integer = 666);

    procedure SignalLogicAlive;

    property ForceLogicControl: boolean read FForceLogicControl write SetForceLogicControl default false;
    property LogicIdleTimeoutSec: double read FLogicIdleTimeout write FLogicIdleTimeout;
    property LogicMaximumMemoryMb: double read FLogicMaximumMemoryMb write FLogicMaximumMemoryMb;
    property LastLogicAliveTime: TDateTime read FLastLogicAliveTime write FLastLogicAliveTime;

    class procedure StrToFile(FileName,Str: string; AutoAppend: Boolean = False); overload;
    class Procedure StrToFile(FileName: string; Str: AnsiString; AutoAppend: Boolean = False); overload;
  end;

  Function CutSubLine(var Text: string): string;
  Function CutSubParam(var Text: string; Delimeter: string = ';'): string;
  Function CutSubParamEx(var Text: string; Delimeter: Char = ';'; Quotes: Char = '"'): string;

  function TimeStampStrToDateTime(Text: string): TDateTime;

  function  FileToStr(FileName: String): string;
  function  FileToStrA(FileName: String): AnsiString;

  function DateTimeToStrDb(DateTime: TDateTime): string;
  function StrDbToDateTimeDef(Str: string; Default: TDateTime = 0): TDateTime;
  function DateTimeToStr(DateTime: TDateTime; Precision: integer = 0): string;

  function GetFilesInDir(Directory, Mask: String; FullPath: boolean = False): TStringList;
  function CopyFiles(SrcDir, DestDir, Mask: String): Boolean;
  function DeleteFiles(Dir, Mask: String): Boolean;

  procedure FreeAndNil(var Obj);
  procedure StopThread(Thread: TThread);
  function GetProcessMemoryUsage: Cardinal;

var
  Debug     : boolean;
  Directory : string;
  ForceStop : boolean;

const
  ServerCoreVersion = '1.01';

implementation

{$R *.DFM}

uses RGServiceLog, ActiveX, PsAPI, Math, AnsiStrings, System.Win.Registry, System.IOUtils;

var
  SRV: TRGService;

function GetProcessMemoryUsage: Cardinal;
var
  pmc : PPROCESS_MEMORY_COUNTERS;
  cb  : Integer;
begin
  Result:=0;

  cb:=SizeOf(TProcessMemoryCounters);
  GetMem(pmc, cb);
  pmc^.cb:=cb;
  if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then begin
    Result:=max(Longint(pmc^.WorkingSetSize),Longint(pmc^.PagefileUsage));
  end;
  FreeMem(pmc);
end;

procedure FreeAndNil(var Obj);
var
  ObjT : TObject;
begin
  ObjT:=TOBject(Obj);
  try
    if Assigned(ObjT) then begin
      ObjT.Free;
    end;
  except
  end;
  try
    Pointer(Obj):=nil;
  except
  end;
end;

procedure StopThread(Thread: TThread);
var
  i,ID : integer;
  FOT  : boolean;
begin
  Id:=Thread.Handle;
  FOT:=Thread.FreeOnTerminate;
  Thread.Terminate;

  for i:=1 to 20 do begin
    try
      if Assigned(Thread) and Thread.Finished then Break;
    except
      Break;
    end;
    Sleep(50);
  end;

  if Assigned(Thread) and not FOT then begin
    try
      if not Thread.Finished then begin
        SuspendThread(ID);
      end;
    except
    end;
    try
      TerminateThread(ID,0);
    except
    end;
    try
      FreeandNil(Thread);
    except
    end;
  end;
end;

function DateTimeToStrDb(DateTime: TDateTime): string;
begin
  Result:=FormatDateTime('yyyy-mm-dd-hh.nn.ss.', DateTime)+Copy(FloatToStr(frac(DateTime*24*3600)),3,6);
end;

function StrDbToDateTimeDef(Str: string; Default: TDateTime = 0): TDateTime;
var
  Year  : integer;
  Month : integer;
  Day   : integer;
  Hour  : integer;
  Min   : integer;
  Sec   : integer;
  MSec  : double;
  Prec  : integer;
begin
  Result:=Default;
  if Length(Str)<19 then Exit;

  Year:=StrToIntDef(Copy(Str,1,4),0);
  Month:=StrToIntDef(Copy(Str,6,2),0);
  Day:=StrToIntDef(Copy(Str,9,2),0);
  Hour:=StrToIntDef(Copy(Str,12,2),0);
  Min:=StrToIntDef(Copy(Str,15,2),0);
  Sec:=StrToIntDef(Copy(Str,18,2),0);

  Prec:=Length(Str)-20;
  if Prec>0 then begin
    MSec:=StrToIntDef(Copy(Str,21,Prec),0)/Power(10,Prec);
  end else begin
    MSec:=0;
  end;

  Result:=EncodeDate(Year,Month,Day)+EncodeTime(Hour,Min,Sec,0)+MSec/24/3600;
end;


function DateTimeToStr(DateTime: TDateTime; Precision: integer): string;
begin
  if Precision=0 then begin
    Result:=FormatDateTime('dd/mm/yyyy hh:nn:ss', DateTime);
  end else begin
    Result:=FormatDateTime('dd/mm/yyyy hh:nn:ss.', DateTime)+Copy(FloatToStr(frac(DateTime*24*3600)),3,Precision);
  end;
end;

Function CutSubLine(var Text: string): string;
var
  p : integer;
begin
  p:=pos(#10,Text);
  if p=0 then begin
    Result:=Text;
    Text:='';
  end else begin
    Result:=copy(Text,1,p-1);
    Text:=copy(Text,p+1,length(Text));
  end;
end;

Function CutSubParam(var Text: string; Delimeter: string = ';'): string;
var
  p : integer;
begin
  p:=pos(Delimeter,Text);
  if p=0 then begin
    Result:=Text;
    Text:='';
  end else begin
    Result:=copy(Text,1,p-1);
    Text:=copy(Text,p+length(Delimeter),length(Text));
  end;
end;

Function CutSubParamEx(var Text: string; Delimeter: Char = ';'; Quotes: Char = '"'): string;
var
  i : integer;
  QMode : boolean;

  Procedure AddChar(C: Char);
  var
    n : integer;
  begin
    n:=Length(Result);
    SetLength(Result,n+1);
    Result[n+1]:=C;
  end;

begin
  QMode:=False;
  Result:='';

  for i:=1 to length(Text) do begin
    if Text[i]=Quotes then begin
      QMode:=not QMode;
    end else begin
      if QMode then begin
        AddChar(Text[i]);
      end else begin
        if Text[i]=Delimeter then begin
          Text:=Copy(Text,i+1,length(Text)-i);
          Exit;
        end else begin
          if not QMode then begin
            AddChar(Text[i]);
          end;
        end;
      end;
    end;
  end;
  Text:='';
end;

function TimeStampStrToDateTime(Text: string): TDateTime;
var
  YY,MM,DD    : WORD;
  HH,NN,SS    : WORD;
  MS          : double;
  S           : string;
begin
  Result:=0;
  if length(Text)=0 then Exit;

  if (length(Text)>2) and (Text[1]='''') and (Text[length(Text)]='''') then begin
    Text:=Copy(Text,2,length(Text)-2);
  end;

  if length(Text)>=length('2007-11-29-13.00.00') then begin
    YY:=StrToIntDef(Copy(Text,1,4),0);
    MM:=StrToIntDef(Copy(Text,6,2),0);
    DD:=StrToIntDef(Copy(Text,9,2),0);

    HH:=StrToIntDef(Copy(Text,12,2),0);
    NN:=StrToIntDef(Copy(Text,15,2),0);
    SS:=StrToIntDef(Copy(Text,18,2),0);
  end else begin
    Exit;
  end;

  S:=Copy(Text,21,10);
  if S<>'' then begin
    MS:=StrToIntDef(s,0)/Power(10,length(S))/24/3600;
  end else begin
    MS:=0;
  end;

  Result:=EncodeDate(YY,MM,DD)+EncodeTime(HH,NN,SS,00)+MS;
end;

function FileToStr(FileName :String): string;
var
  f    : File;
  Buff : AnsiString;
begin
  if Pos(':\', FileName)=0 then begin
    FileName:=ExtractFilePath(ParamStr(0))+'\'+FileName;
  end;

  AssignFile(F, FileName);
  Reset(F,1);
  SetLength(Buff,FileSize(F));
  BlockRead(F,Buff[1],FileSize(F));
  CloseFile(F);
  Result:=String(Buff);
end;

function FileToStrA(FileName: String): AnsiString;
var
  f    : File;
  Buff : AnsiString;
begin
  if Pos(':\', FileName)=0 then begin
    FileName:=ExtractFilePath(ParamStr(0))+'\'+FileName;
  end;

  AssignFile(F, FileName);
  Reset(F,1);
  SetLength(Buff,FileSize(F));
  BlockRead(F,Buff[1],FileSize(F));
  CloseFile(F);
  Result:=Buff;
end;

class procedure TRGService.StrToFile(FileName,Str: string; AutoAppend: Boolean = False);
var
  f : TextFile;
begin
  if Pos(':\',FileName)=0 then begin
    FileName:=ExtractFilePath(ParamStr(0))+'\'+FileName;
  end;
  if FileExists(FileName) then begin
    AssignFile(f,FileName);
    if AutoAppend then begin
      Append(f);
    end else begin
      ReWrite(f);
    end;
  end else begin
    AssignFile(f,FileName);
    ReWrite(f);
  end;
  WriteLn(f,Str);
  CloseFile(f);
end;

class procedure TRGService.StrToFile(FileName: string; Str: AnsiString; AutoAppend: Boolean = False);
var
  f : TextFile;
begin
  if Pos(':\',FileName)=0 then begin
    FileName:=ExtractFilePath(ParamStr(0))+'\'+FileName;
  end;
  if FileExists(FileName) then begin
    AssignFile(f,FileName);
    if AutoAppend then begin
      Append(f);
    end else begin
      ReWrite(f);
    end;
  end else begin
    AssignFile(f,FileName);
    ReWrite(f);
  end;
  WriteLn(f,Str);
  CloseFile(f);
end;


procedure TRGService.GenerateBatFiles;
var
  f : TextFile;
begin
  try
    AssignFile(f,Directory+'Service_Restart.bat');
    try
      ReWrite(f);
      WriteLn(f,'@echo off');
      WriteLn(f,'echo --------------------------------------------------------- >> Logs\ServiceRestart.log');
      WriteLn(f,'echo %Date% %Time%: restarting service "'+DisplayName+'"');
      WriteLn(f,'echo %Date% %Time%: restarting service "'+DisplayName+'" >> Logs\ServiceRestart.log');
      WriteLn(f,'NET STOP "'+DisplayName+'" >> Logs\ServiceRestart.log 2>&1');
      WriteLn(f,'TASKKILL /F /IM "'+ExtractFileName(Forms.Application.ExeName)+'" >> Logs\ServiceRestart.log 2>&1');
      WriteLn(f,'ping -w 500 127.0.0.1 > nul');
      WriteLn(f,'NET START "'+DisplayName+'" >> Logs\ServiceRestart.log 2>&1');
    except
      on E: Exception do begin
        StrToLog('ERROR ON WRITE Service_Restart BAT FILE: '+E.Message);
      end;
    end;
    CloseFile(f);

    AssignFile(f,Directory+'Service_Stop.bat');
    try
      ReWrite(f);
      WriteLn(f,'@echo off');
      WriteLn(f,'echo --------------------------------------------------------- >> Logs\ServiceRestart.log');
      WriteLn(f,'echo %Date% %Time%: stopping service "'+DisplayName+'"');
      WriteLn(f,'echo %Date% %Time%: stopping service "'+DisplayName+'" >> Logs\ServiceRestart.log');
      WriteLn(f,'NET STOP "'+DisplayName+'"');
      WriteLn(f,'TASKKILL /F /IM "'+ExtractFileName(Forms.Application.ExeName)+'" >> Logs\ServiceRestart.log 2>&1');
    except
      on E: Exception do begin
        StrToLog('ERROR ON WRITE Service_Stop BAT FILE: '+E.Message);
      end;
    end;
    CloseFile(f);

    AssignFile(f,Directory+'Service_Start.bat');
    try
      ReWrite(f);
      WriteLn(f,'@echo off');
      WriteLn(f,'echo --------------------------------------------------------- >> Logs\ServiceRestart.log');
      WriteLn(f,'echo %Date% %Time%: start service "'+DisplayName+'"');
      WriteLn(f,'echo %Date% %Time%: start service "'+DisplayName+'" >> Logs\ServiceRestart.log');
      WriteLn(f,'NET START "'+DisplayName+'"');
    except
      on E: Exception do begin
        StrToLog('ERROR ON WRITE Service_Start BAT FILE: '+E.Message);
      end;
    end;
    CloseFile(f);

    AssignFile(f,Directory+'Install.bat');
    try
      ReWrite(f);
      WriteLn(f,ExtractFileName(Forms.Application.ExeName)+' /install');
    except
      on E: Exception do begin
        StrToLog('ERROR ON WRITE Install BAT FILE: '+E.Message);
      end;
    end;
    CloseFile(f);

    AssignFile(f,Directory+'Uninstall.bat');
    try
      ReWrite(f);
      WriteLn(f,ExtractFileName(Forms.Application.ExeName)+' /uninstall');
    except
      on E: Exception do begin
        StrToLog('ERROR ON WRITE Uninstall BAT FILE: '+E.Message);
      end;
    end;
    CloseFile(f);
  except
  end;
end;

function TRGService.GetLogFileName: string;
begin
  try
    result:=FormatDateTime('yyyy-mm-dd', Now)+'.log';
  except
  end;
end;

procedure TRGService.PostError(Str: string);
begin
  try
    SignalLogicAlive;
    NetWriter.PostError(Str);
  except
  end;
end;

procedure TRGService.PostInfo(Str: string);
begin
  try
    SignalLogicAlive;
    NetWriter.PostInfo(Str);
  except
  end;
end;

procedure TRGService.PostTNGMessage(Str: string);
begin
  try
    SignalLogicAlive;
    NetWriter.PostTNGMessage(Str);
  except
  end;
end;

procedure TRGService.Stop;
var
  Stopped: boolean;
begin
  ServiceStop(Self,Stopped);
end;

Procedure TRGService.StrToLog(Str: string; LogFileName: string = '');
var
  Item  : TVisualLogItem;
  FN    : string;
begin
  if Self=nil then begin
    Exit;
  end;

  try
    SignalLogicAlive;
    if LogFileName='' then begin
      FN:=GetLogFileName;
    end else begin
      FN:=LogFileName;
    end;

    Item.FileName:=FN;
    Item.Data.Text:=Str;
    Item.Data.Time:=Now;
    LogWriter.AddToLog(Item.Data,FN);

    if Debug then begin
      if VisualLog=nil then VisualLog:=TVisualLog.Create;

      if VisualLog.Count<100000 then begin
        VisualLog.Add(Item);
      end;
    end;
  except
  end;
end;

procedure TRGService.UpdateDebugInterface;
var
  Item : TVisualLogItem;
begin
  if LogDlg=nil then Exit;
  
  LogDlg.Caption:='Статус сервера: '+DateTimeToStr(Now);
  if VisualLog<>nil then begin
    while VisualLog.Count>0 do begin
      try
        Item:=VisualLog[0];
      except
      end;
      try
        LogDlg.ToLog(DateTimeToStr(Item.Data.Time,2)+' '+Item.Data.Text,Item.FileName);
      except
      end;
      try
        VisualLog.Delete(0);
      except
      end;
    end;
  end;
  LogDlg.Refresh;
end;


procedure TRGService.PostWarning(Str: string);
begin
  try
    if Self=nil then Exit;

    SignalLogicAlive;
    NetWriter.PostWarning(Str);
  except
  end;
end;


function DebuggerPresent : boolean;
type
  TDebugProc = function : boolean; stdcall;
var
  Kernel32  : HMODULE;
  DebugProc : TDebugProc;
begin
  Result:=False;
  Kernel32:=GetModuleHandle('kernel32');
  if Kernel32<>0 then begin
    @DebugProc:=GetProcAddress(Kernel32, 'IsDebuggerPresent');
    if Assigned(DebugProc) then Result:=DebugProc;
  end;
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  SRV.Controller(CtrlCode);
end;

function TRGService.GetServiceController: TServiceController;
begin
  Result:=ServiceController;
end;

function TRGService.LastPostTime: TDateTime;
begin
  try
    Result:=NetWriter.LastPost;
  except
    Result:=0;
  end;
end;

procedure TRGService.LogWriteLog(Item: TLogItem; FileName: string);
begin
  SignalLogicAlive;
end;

function GetVerFile: string;
type
  TLongVersion = record
    case Integer of
    0: (All: array[1..4] of Word);
    1: (MS, LS: LongInt);
  end;
var
  FHandle        : DWORD;
  FSize          : DWORD;
  FBuffer        : PChar;
  FValid         : Boolean;
  FixedFileInfo  : PVSFixedFileInfo;
  Len            : UINT;
  Lv             : TLongVersion;
begin
  FSize:=GetFileVersionInfoSize(PChar(paramstr(0)),FHandle);
  if FSize>0 then begin
    GetMem(FBuffer,FSize);
    try
      FValid:=GetFileVersionInfo(PChar(paramstr(0)),FHandle,FSize,FBuffer);
      if not FValid then begin
        Result:='';
        Exit;
      end;
      VerQueryValue(FBuffer,'\',Pointer(FixedFileInfo), Len);
      Lv.MS:=FixedFileInfo^.dwProductVersionMS;
      Lv.LS:=FixedFileInfo^.dwProductVersionLS;
      with Lv do
        Result:=Format('%d.%d', [All[2], All[3]]);
    finally
      FreeMem(FBuffer);
    end;
  end;
end;

function GetFilesInDir(Directory, Mask: String; FullPath: boolean = False): TStringList;
var
  Res      : TSearchRec;
begin
  Result:=TStringList.Create;

  if FindFirst(Directory+Mask,faAnyFile,Res)=0 then begin
    Repeat
      if FullPath then begin
        Result.Add(IncludeTrailingPathDelimiter(ExtractFileDir(Directory))+ExtractFileName(Res.Name));
      end else begin
        Result.Add(Res.Name);
      end;
    Until FindNext(Res)<>0;
  end;
end;


function CopyFiles(SrcDir, DestDir, Mask: String): Boolean;
var
  Res      : TSearchRec;
  FileName : string;
begin
  Result:=True;
  ForceDirectories(DestDir);
  if FindFirst(SrcDir+Mask,faAnyFile,Res)=0 then begin
    Repeat
      FileName:=ExtractFileName(Res.Name);
      if FileExists(SrcDir+Res.Name) then begin
        if CopyFile(PChar(SrcDir+Res.Name),PChar(DestDir+FileName),False)=false then begin
          Result:=False;
        end;
      end;
    Until FindNext(Res)<>0;
  end;
end;

function DeleteFiles(Dir, Mask: String): Boolean;
var
  Res      : TSearchRec;
  FileName : string;
begin
  Result:=True;
  if FindFirst(Dir+Mask,faAnyFile,Res)=0 then begin
    Repeat
      FileName:=ExtractFileName(Res.Name);
      if FileExists(Dir+Res.Name) then begin
        if DeleteFile(Dir+Res.Name)=false then begin
          Result:=False;
        end;
      end;
    Until FindNext(Res)<>0;
  end;
end;



procedure TRGService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  try
    FormatSettings.DecimalSeparator:='.';
    CoInitialize(nil);
    UpdateCount:=0;
    LogFileName:=Directory+'Service.log';
    NextRetry:=0;
    StartTime:=Now;
    ForceDirectories(Directory+'Logs\');
    try
      Ini:=TIniFile.Create(Directory+'Service.ini');
      if Ini.ReadBool('LogFiles', 'DeleteAllOnStart',False) then begin
        TDirectory.Delete(Directory+'Logs\',True);
//        DeleteFiles(Directory+'Logs\','*.log');
      end;
     FreeAndNil(Ini);
    except
    end;


    LogWriter:=TLogWriter.Create(Self,Directory+'Logs\',False);
    LogWriter.OnWriteLog:=LogWriteLog;

    NetWriter:=TNetLogWriter.Create(Self,True);
    NetWriter.FreeOnTerminate:=False;
    NetWriter.Main:=Self;
    StrToLog('LogServer Started.');

    StrToLog('Server Version: '+GetVerFile);
    StrToLog('----------------------------------------------');
    StrToLog('--------------- Service Init -----------------');
    StrToLog('----------------------------------------------');

    StrToLog('Loading Settings from: '+Directory+'Service.ini');
    Ini:=TIniFile.Create(Directory+'Service.ini');

    NetWriter.LogWriteURL:=Ini.ReadString('DiagnosticServer', 'URL','');
    NetWriter.LogWriteSrvName:=Ini.ReadString('DiagnosticServer', 'ServiceName','rgreat.nav.xxx.main');

    LogWriter.LogsToKeepDays:=Ini.ReadInteger('LogFiles', 'LogsToKeep',30);;
    LogicIdleTimeoutSec:=Ini.ReadInteger('ErrorControl', 'IdleTimeoutSec',-1);;
    LogicMaximumMemoryMb:=Ini.ReadInteger('ErrorControl', 'MaximumMemoryMb',-1);;
    if Ini.SectionExists('ErrorControl') then begin
      ForceLogicControl:=True;
    end;

    StrToLog('CFG Load Ok.');
    NetWriter.Start;

    Status:=csRunning;
    PostInfo('Сервис запускается.');
    if Assigned(FLogicCreateEvent) then begin
      StrToLog('Starting Logic...');
      FServLogic:=FLogicCreateEvent(Self);
    end;

    if FServLogic<>nil then begin
      FServLogic.FreeOnTerminate:=False;
      StrToLog('Logic Started.');
      StrToLog('Service Started.');
      PostInfo('Сервис запущен.');
      Started:=True;
      FLastLogicAliveTime:=Now;
    end else begin
      StrToLog('Error! No Logic Started...');
      PostError('Не запущена логика.');
    end;
  except
    on E: Exception do begin
      try
        StrToLog('ERROR ON INIT!: '+E.Message);
      except
      end;
      Started:=False;
    end;
  end;
end;

procedure TRGService.ServiceStop(Sender: TService; var Stopped: Boolean);
var
  ND : TDateTime;
begin
  try
    StrToLog('Service STOP Command received...');
    PostWarning('Сервис останавливается.');
    InStopMode:=True;

    if FServLogic<>nil then begin
      try
        StrToLog('Stopping Logic...');
        FServLogic.Terminate;
        ND:=Now;
        while (FServLogic<>nil) and not FServLogic.Finished do begin
          Sleep(1);
          if (Now-ND>20/24/3600) then Break;
        end;
        if (FServLogic<>nil) then begin
          if FServLogic.Finished then begin
            FreeAndNil(FServLogic);
          end else begin
            StrToLog('Halting Logic...');
            StopThread(TThread(FServLogic));
          end;
        end;
      except
      end;
    end;
    StrToLog('Stopping Log...');
    UpdateDebugInterface;

    StrToLog('Service stopped.');
    PostWarning('Сервис остановлен.');

    ND:=Now;
    while (LogWriter.CacheCount>0) or (NetWriter.Cache.Count>0) do begin
      Sleep(1);
      if (Now-ND>5/24/3600) then Break;
    end;

    LogWriter.Terminate;
    NetWriter.Terminate;

    CheckStop:=Now;

    if VisualLog<>nil then FreeAndNil(VisualLog);
    if Ini<>nil then FreeAndNil(Ini);
  except
  end;

  try
    if not Debug then begin
      ServiceThread.Terminate;
    end;
//    StopThread(TThread(FLogicControlThread));
//    StopThread(TThread(LogWriter));
//    StopThread(TThread(NetWriter));
    CoUnInitialize;
  except
  end;
  ForceStop:=True;
  Stopped:=True;
end;

{$WARN SYMBOL_DEPRECATED OFF}
procedure TRGService.SetForceLogicControl(const Value: boolean);
begin
  FForceLogicControl:=Value;
  if FForceLogicControl then begin
    FLogicControlThread.Resume;
  end else begin
    FLogicControlThread.Suspend;
  end;
end;

procedure TRGService.SignalLogicAlive;
begin
  FLastLogicAliveTime:=Now;
end;

procedure TRGService.OnAfterInstall(Sender: TService);
var
  Reg: TRegistry;
  FA : array of byte;
  i: Integer;
const
  XFA : array [0..43] of byte = (00,00,00,00,00,00,00,00,00,00,
                                 00,00,03,00,00,00,14,00,00,00,
                                 01,00,00,00,00,00,00,00,01,00,
                                 00,00,00,00,00,00,01,00,00,00,
                                 00,00,00,00);
begin
  Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SYSTEM\CurrentControlSet\Services\'+Name, false) then
    begin
      Reg.WriteString('Description', FDescription);
      Reg.WriteInteger('ErrorControl', 1);
      SetLength(FA,length(XFA));
      for i:=0 to length(XFA)-1 do begin
        FA[i]:=XFA[i];
      end;
      Reg.WriteBinaryData('FailureActions', FA[0] , Length(FA));
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;


constructor TRGService.Create(ServiceName, ServiceDisplayName,Description: string; LogicCreateEvent: TLogicCreate);
begin
  AfterInstall:=OnAfterInstall;

  Name:=ServiceName;
  DisplayName:=ServiceDisplayName;
  FLogicCreateEvent:=LogicCreateEvent;
  OnStart:=ServiceStart;
  OnStop:=ServiceStop;
  SRV:=Self;
  FLogicIdleTimeout:=600;
  LogicMaximumMemoryMb:=256;
  FForceLogicControl:=False;
  CheckStop:=0;
  FDescription:=Description;
  InStopMode:=False;

  inherited CreateNew(Application,0);

  FLogicControlThread:=TLogicControlThread.Create(True);
  FLogicControlThread.Service:=Self;
end;

destructor TRGService.Destroy;
begin
  if Ini<>nil then FreeAndNil(Ini);
  if VisualLog<>nil then FreeAndNil(VisualLog);
  if FLogicControlThread<>nil then FreeAndNil(FLogicControlThread);
end;

procedure TRGService.Run;
var
  Started : boolean;
begin

  if FindCmdLineSwitch('debug') then begin
    Debug:=True;
//    ReportMemoryLeaksOnShutdown:=True;
  end;

  if not Application.DelayInitialize or Application.Installing then begin
    Application.Initialize;
  end;

  GenerateBatFiles;

  if Debug then begin
    LogDlg:=TLogDlg.Create(Self);
    LogDlg.Main:=Self;
    LogDlg.Show;
    ServiceStart(Self,Started);

    while not ForceStop do begin
      UpdateDebugInterface;
      Sleep(1);
    end;
  end else begin
    Application.Run;
  end;
end;

{ TLogic }

constructor TServiceLogic.Create(Parent: TRGService; CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  Service:=Parent;
end;

{ TLogicControlThread }


procedure TLogicControlThread.Execute;
var
  inOverloadMode : boolean;
  OverloadTime   : TDateTime;
begin
  inherited;
  NameThreadForDebugging(AnsiString(ClassName));

  inOverloadMode:=False;
  OverloadTime:=0;

  while not Terminated do begin
    try
      if not inOverloadMode and
         Assigned(Service.FLogicCreateEvent) and
         (Service.FLastLogicAliveTime<>0) and
         (Service.FLogicIdleTimeout>=0) and
         (Now-Service.FLastLogicAliveTime>Service.FLogicIdleTimeout/24/3600) then begin

        Service.StrToLog('Logic control timeout! Logic inactive for more then '+IntToStr(trunc(Service.FLogicIdleTimeout))+' seconds.'#13#10+
                          'Service will be restarted...');
        Service.PostError('Таймаут в сервисе контроля! Логика неактивна более '+IntToStr(trunc(Service.FLogicIdleTimeout))+' секунд.'#13#10+
                          'Сервис будет перезапущен...');

        Service.TerminateService;
        inOverloadMode:=True;
      end;

      if not inOverloadMode and (Service.FLogicMaximumMemoryMb>=0) and (GetProcessMemoryUsage>Service.FLogicMaximumMemoryMb*1024*1024) then begin
        Service.StrToLog('Service memory overload! Memory usage: '+FloatToStr(RoundTo(GetProcessMemoryUsage/1024/1024,-1))+' mb.'#13#10+
                          'Service will be restarted...');
        Service.PostError('Превышение максимального размера использованной оперативной памяти! Использовано '+FloatToStr(RoundTo(GetProcessMemoryUsage/1024/1024,-1))+' мб.'#13#10+
                          'Сервис будет перезапущен...');
        Service.TerminateService;
        inOverloadMode:=True;
        OverloadTime:=Now;
      end;
      if Now-OverloadTime>1/24/60 then begin
        inOverloadMode:=False;
      end;

      if Service.CheckStop>0 then begin
        if Now-Service.CheckStop>1/24/60 then begin
          try
            Service.StrToLog('Service stop timeout, Halting service!');
            Service.PostError('Не удалось отановить логику.'#13#10+
                              'Сервис будет остановлен принудительно....');
            Sleep(1000);
          except
          end;
          Service.TerminateService;
        end;
      end;
    except
      on E: Exception do begin
        try
          Service.StrToLog('ERROR in ServiceThread: '+E.Message);
          Service.PostError('ERROR in ServiceThread: '+E.Message);
          Sleep(1000);
        except
        end;
      end;
    end;
    Sleep(100);
  end;
end;


function CreateProcessSimple(sExecutableFilePath: string): boolean;
var
  pi: TProcessInformation;
  si: TStartupInfo;
begin
  FillMemory(@si, sizeof(si),0);
  si.cb:=sizeof(si);

  Result:=CreateProcess(Nil,PChar(sExecutableFilePath),Nil,Nil,False,NORMAL_PRIORITY_CLASS,Nil,Nil,si,pi);
end;


procedure TRGService.TerminateService(ErrorCode: integer = 666);
begin
  try
    raise Exception.Create('Termitate Initiated');
  except
    on E: Exception do begin
      StrToLog('Terminating Service...'#13#10+E.StackTrace);
    end;
  end;

  try
    Sleep(1000);
    ServiceThread.Terminate;
    Sleep(5000);
    PostWarning('Запускается критическая остановка сервиса.');
    Sleep(1000);
  except
  end;

  if InStopMode then begin
    ExitProcess(0);
  end else begin
    ExitProcess(ErrorCode);
  end;
end;

function TServiceLogic.ServiceThread: TServiceThread;
begin
  Result:=Service.ServiceThread;
end;

initialization
  Directory:=IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));

end.

unit RGServiceLog;

interface

uses
  Forms, Classes, Controls, StdCtrls, ExtCtrls, ComCtrls, Indexes;

type
  TLogPage = class
    FileName : string;
    Page     : TTabSheet;
    LB       : TListBox;
    constructor Create(FileName: string;
                       Page    : TTabSheet;
                       LB      : TListBox);
  end;
  TLogPages = THashTable<string,TLogPage>;

  TLogDlg = class(TForm)
    Panel2: TPanel;
    Button1: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
  public
    Main     : TObject;
    DoStop   : boolean;
    LogPages : TLogPages;

    procedure ToLog(Text: string; LogFile: string);
    procedure Refresh;
  end;

var
  LogDlg: TLogDlg;
  LogDlgIsActive : boolean;

implementation

{$R *.dfm}

Uses RGServices;

procedure TLogDlg.Button1Click(Sender: TObject);
var
  Stopped: boolean;
begin
  TRGService(Main).ServiceStop(TRGService(Main),Stopped);
end;

procedure TLogDlg.ToLog(Text: string; LogFile: string);
var
  i     : integer;
  LP    : TLogPage;
  Lines : TStringList;
begin
  if not LogDlgIsActive then Exit;

  if (TRGService(Main).GetLogFileName=LogFile) then begin
    LogFile:='';
  end;

  if (LogFile='') or CheckBox2.Checked then begin
    LP:=LogPages[0];
   end else begin
    LP:=LogPages.DataByID[LogFile];
    if LP=nil then begin
      LP:=TLogPage.Create(LogFile,TTabSheet.Create(Self),TListBox.Create(Self));
      LP.Page.PageControl:=PageControl1;
      LP.Page.Caption:=LogFile;
      LP.LB.Parent:=LP.Page;
      LP.LB.Align:=alClient;
      LogPages.Add(LogFile,LP);
    end;
  end;


  if CheckBox1.Checked then begin
    if LP.LB.Items.Count>100 then begin
      LP.LB.Items.Delete(0);
    end;
  end;
  if not LogDlgIsActive then Exit;

  Lines:=TStringList.Create;
  try
    Lines.Text:=Text;
    if Lines.Count>1 then begin
      for i:=0 to Lines.Count-1 do begin
        LP.LB.Items.Add(Lines[i]);
      end;
    end else begin
      LP.LB.Items.Add(Text);
    end;
    LP.LB.ItemIndex:=LP.LB.Items.Count-1;
  except
  end;
  Lines.Free;

  try
    Application.ProcessMessages;
  finally
  end;
end;

procedure TLogDlg.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Stopped : boolean;
begin
  TRGService(Main).ServiceStop(nil,Stopped);
end;

procedure TLogDlg.FormCreate(Sender: TObject);
begin
  LogDlgIsActive:=True;
  LogPages:=TLogPages.Create;
  LogPages.Add('',TLogPage.Create('',TabSheet1,ListBox1));
end;

procedure TLogDlg.FormDestroy(Sender: TObject);
begin
  LogDlgIsActive:=False;
  LogPages.Free;
end;

procedure TLogDlg.Refresh;
begin
  Update;
  Application.ProcessMessages;
end;

{ TLogPage }

constructor TLogPage.Create(FileName: string; Page: TTabSheet; LB: TListBox);
begin
  Self.FileName:=FileName;
  Self.Page:=Page;
  Self.LB:=LB;
end;

end.

object LogDlg: TLogDlg
  Left = 377
  Top = 184
  Caption = #1057#1090#1072#1090#1091#1089' '#1089#1077#1088#1074#1077#1088#1072
  ClientHeight = 525
  ClientWidth = 763
  Color = clBtnFace
  Font.Charset = RUSSIAN_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnClose = FormClose
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Panel2: TPanel
    Left = 0
    Top = 494
    Width = 763
    Height = 31
    Align = alBottom
    TabOrder = 0
    object Button1: TButton
      Left = 3
      Top = 3
      Width = 145
      Height = 25
      Caption = #1054#1089#1090#1072#1085#1086#1074#1080#1090#1100' '#1089#1077#1088#1074#1080#1089
      TabOrder = 0
      OnClick = Button1Click
    end
    object CheckBox1: TCheckBox
      Left = 157
      Top = 7
      Width = 122
      Height = 17
      Caption = #1054#1075#1088#1072#1085#1080#1095#1080#1090#1100' '#1078#1091#1088#1085#1072#1083
      Checked = True
      State = cbChecked
      TabOrder = 1
    end
    object CheckBox2: TCheckBox
      Left = 285
      Top = 6
      Width = 227
      Height = 17
      Caption = #1042#1099#1074#1086#1076#1080#1090#1100' '#1074#1089#1077' '#1079#1072#1087#1080#1089#1080' '#1074' '#1075#1083#1072#1074#1085#1099#1081' '#1078#1091#1088#1085#1072#1083
      TabOrder = 2
    end
  end
  object PageControl1: TPageControl
    Left = 0
    Top = 0
    Width = 763
    Height = 494
    ActivePage = TabSheet1
    Align = alClient
    MultiLine = True
    TabOrder = 1
    object TabSheet1: TTabSheet
      Caption = #1043#1083#1072#1074#1085#1099#1081' '#1078#1091#1088#1085#1072#1083
      object ListBox1: TListBox
        Left = 0
        Top = 0
        Width = 755
        Height = 466
        Align = alClient
        Font.Charset = RUSSIAN_CHARSET
        Font.Color = clWindowText
        Font.Height = -11
        Font.Name = 'Courier New'
        Font.Style = []
        ItemHeight = 14
        ParentFont = False
        TabOrder = 0
      end
    end
  end
end

unit RGServiceLogWriter;

interface

uses
  Classes, Generics.Collections, SyncObjs;

type
  TLogItem = record
    Text      : string;
    Time      : TDateTime;
  end;
  TLogCache = class(TList<TLogItem>);

  TLogFile = class
    constructor Create; reintroduce;
    destructor Destroy; override;
  public
    FileName : string;
    Stream   : TFileStream;
    Cache    : TLogCache;
    LastPost : TDateTime;
  end;

  TLogFiles = class(TDictionary<String,TLogFile>);

  FOnNewLogEvent = procedure(Item: TLogItem; FileName: string) of object;

  TCharMode = (cmAnsi,cmUnicode);

  TLogWriter = class(TThread)
  private
    FParent        : TObject;
    FOnWriteLog    : FOnNewLogEvent;
    FCharMode      : TCharMode;
    FLock          : TCriticalSection;
    FLogDirectory  : string;
    FLastDirCheck  : TDateTime;
    FLogFiles      : TLogFiles;
    FLogsToKeep    : integer;
    FBufferLimit   : integer;
    FTmtTimeOutSec : integer;

    procedure SetOnWriteLog(const Value: FOnNewLogEvent);
    procedure SetCharMode(const Value: TCharMode);
    procedure SetLogsToKeep(const Value: integer);
    procedure SetLogDirectory(const Value: string);
    procedure SetTerminateTimeOutSec(const Value: integer);
    procedure SetBufferLimit(const Value: integer);
  protected
    procedure Execute; override;
  public
    constructor Create(Parent: TObject; LogDirectory: string; CreateSuspended: Boolean); overload;
    destructor Destroy; override;

    procedure AddToLog(Text: string; Time: TDateTime = 0; FileName: string = ''); overload;
    procedure AddToLog(Item: TLogItem; FileName: string); overload;

    function CacheCount: integer;
    procedure ClearOldLogFiles;

    property OnWriteLog: FOnNewLogEvent read FOnWriteLog write SetOnWriteLog;
    property CharMode: TCharMode read FCharMode write SetCharMode;

    property LogDirectory : string read FLogDirectory write SetLogDirectory;
    property LogsToKeepDays: integer read FLogsToKeep write SetLogsToKeep;
    property TerminateTimeOutSec: integer read FTmtTimeOutSec write SetTerminateTimeOutSec;
    property BufferLimit: integer read FBufferLimit write SetBufferLimit;
  end;

implementation

uses
  System.IOUtils, System.Types, Math, SysUtils;

{ TNAVWriter }

procedure TLogWriter.AddToLog(Item: TLogItem; FileName: string);
var
  LF   : TLogFile;
begin
  if (Self=nil) or Terminated then Exit;

  if Assigned(FOnWriteLog) then FOnWriteLog(Item,FileName);

  FLock.Enter;
  try
    FileName:=FLogDirectory+FileName;

    if FLogFiles.ContainsKey(FileName) then begin
      LF:=FLogFiles[FileName];
    end else begin
      LF:=TLogFile.Create;
      LF.FileName:=FileName;
      LF.LastPost:=Now;

      if not FileExists(FileName) then begin
        ForceDirectories(ExtractFileDir(FileName));
        LF.Stream:=TFileStream.Create(FileName,fmCreate+fmShareDenyNone);
        LF.Stream.Free;
        LF.Stream:=TFileStream.Create(FileName,fmOpenReadWrite+fmShareDenyNone);
      end else begin
        LF.Stream:=TFileStream.Create(FileName,fmOpenReadWrite+fmShareDenyNone);
      end;
      LF.Stream.Seek(LF.Stream.Size,soBeginning);

      FLogFiles.Add(FileName,LF);
    end;

    if (FBufferLimit>0) and (LF.Cache.Count>FBufferLimit) then raise Exception.Create('Log Buffer OverFlow!');

    LF.Cache.Add(Item);
  finally
    FLock.Leave;
  end;
end;

procedure TLogWriter.AddToLog(Text: string; Time: TDateTime; FileName: string);
var
  Item : TLogItem;
begin
  if Time=0 then Time:=Now;
  if FileName='' then FileName:=FormatDateTime('DD/MM/YYYY',Time)+'.log';

  Item.Text:=Text;
  Item.Time:=Time;
  AddToLog(Item,FileName);
end;

function TLogWriter.CacheCount: integer;
var
  LF : TLogFile;
begin
  Result:=0;
  for LF in FLogFiles.Values do begin
    try
      inc(Result,LF.Cache.Count);
    except
    end;
  end;
end;


function GetFilesInDir(Directory: String): TStringList;
var
  i   : Integer;
  Res : TStringDynArray;
begin
  Result:=TStringList.Create;

  Res:=TDirectory.GetFiles(Directory);

  for i:=0 to length(Res)-1 do begin
    Result.Add(Res[i]);
  end;
end;

function GetDirectoriesInDir(Directory: String): TStringList;
var
  i   : Integer;
  Res : TStringDynArray;
begin
  Result:=TStringList.Create;
  Res:=TDirectory.GetDirectories(Directory);
  for i:=0 to length(Res)-1 do begin
    Result.Add(Res[i]);
  end;
end;

procedure TLogWriter.ClearOldLogFiles;
var
  Logs       : TStringList;
  i          : Integer;
  Item       : TLogItem;
  DirsToKeep : integer;
begin
  Logs:=GetFilesInDir(FLogDirectory);
  try
    Logs.Sort;
    if Logs.Count>LogsToKeepDays then begin
      Item.Text:='Deleting '+IntToStr(Logs.Count-LogsToKeepDays)+' logs ['+Logs[0]+' - '+Logs[LogsToKeepDays-1]+']... ';
      Item.Time:=Now;
      AddToLog(Item,FormatDateTime('yyyy-mm-dd', Now)+'.log');
      for i:=0 to Logs.Count-LogsToKeepDays-1 do begin
        TFile.Delete(Logs[i]);
      end;
      Item.Text:='Done... ';
    end;

    Logs:=GetDirectoriesInDir(FLogDirectory);
    Logs.Sort;
    DirsToKeep:=LogsToKeepDays div 2;
    if Logs.Count>DirsToKeep then begin
      Item.Text:='Deleting '+IntToStr(Logs.Count-DirsToKeep)+' dirs ['+Logs[0]+' - '+Logs[DirsToKeep-1]+']... ';
      Item.Time:=Now;
      AddToLog(Item,FormatDateTime('yyyy-mm-dd', Now)+'.log');
      for i:=0 to Logs.Count-(DirsToKeep div 2)-1 do begin
        TDirectory.Delete(Logs[i],True);
      end;
      Item.Text:='Done... ';
    end;
  finally
    Logs.Free;
  end;
end;

constructor TLogWriter.Create(Parent: TObject; LogDirectory: string; CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);

  FLock:=TCriticalSection.Create;
  FLastDirCheck:=Now-59/MinsPerDay;
  FTmtTimeOutSec:=10;
  FLogDirectory:=LogDirectory;
  FLogFiles:=TLogFiles.Create;
  FParent:=Parent;
  FLogsToKeep:=0;
  FCharMode:=cmAnsi;
  FBufferLimit:=0;
end;

destructor TLogWriter.Destroy;
var
  LF : TLogFile;
begin
  for LF in FLogFiles.Values do begin
    LF.Free;
  end;
  FLogFiles.Free;
  FLock.Free;

  inherited;
end;

function DateTimeToStr(DateTime: TDateTime; Precision: integer): string;
begin
  if Precision=0 then begin
    Result:=FormatDateTime('dd/mm/yyyy hh:nn:ss', DateTime);
  end else begin
    Result:=FormatDateTime('dd/mm/yyyy hh:nn:ss.', DateTime)+Copy(FloatToStr(frac(DateTime*SecsPerDay)),3,Precision);
  end;
end;

procedure TLogWriter.Execute;
var
  Item    : TLogItem;
  LF      : TLogFile;
  Empty   : boolean;
  EndTime : TDateTime;

  procedure WriteText(Text: string);
  var
    Buff   : AnsiString;
  begin
    if CharMode=cmAnsi then begin
      Buff:=AnsiString(Text);
      LF.Stream.Write(Buff[1],length(Buff));
    end else begin
      LF.Stream.Write(Text[1],length(Text));
    end;
  end;
begin
  NameThreadForDebugging(AnsiString(ClassName));

  Empty:=True;
  EndTime:=0;
  while not Terminated or ((CacheCount>0) and ((Now-EndTime<=FTmtTimeOutSec/SecsPerDay) or (EndTime=0))) do begin
    if Terminated and (EndTime=0) then EndTime:=Now;

    try
      if Empty then begin
        Sleep(1);
      end;
      Empty:=True;

      if (FLogsToKeep>0) and (Now-FLastDirCheck>1/24) then begin
        ClearOldLogFiles;
        FLastDirCheck:=Now;
      end;


      if not FLock.TryEnter then Continue;

      try
        if FLogFiles.Count=0 then Continue;
        for LF in FLogFiles.Values do begin
          try
            if LF.Cache.Count=0 then Continue;

            Item:=LF.Cache[0];
            if Item.Time=0 then Continue;

            WriteText(DateTimeToStr(Item.Time,2)+' '+Item.Text+#13#10);
          except
            // Spice Must Flow!
          end;

          LF.Cache.Delete(0);

          if LF.Cache.Count>0 then begin
            Empty:=False;
          end;
        end;

        for LF in FLogFiles.Values do begin
          if (LF.Cache.Count=0) and (Now-LF.LastPost>1/24) then begin
            FLogFiles.Remove(LF.FileName);
          end;
        end;
      finally
        FLock.Leave;
      end;
    except
      // Spice Must Flow!
    end;
  end;
  if CacheCount>0 then begin
    WriteText(DateTimeToStr(Now,2)+' Error: LogTimeOut! Records Left in Log: '+IntToStr(CacheCount)+#13#10);
  end;
end;

procedure TLogWriter.SetBufferLimit(const Value: integer);
begin
  FBufferLimit := Value;
end;

procedure TLogWriter.SetCharMode(const Value: TCharMode);
begin
  FCharMode := Value;
end;

procedure TLogWriter.SetLogDirectory(const Value: string);
begin
  FLogDirectory := Value;
end;

procedure TLogWriter.SetLogsToKeep(const Value: integer);
begin
  FLogsToKeep := Value;
end;

procedure TLogWriter.SetOnWriteLog(const Value: FOnNewLogEvent);
begin
  FOnWriteLog := Value;
end;

procedure TLogWriter.SetTerminateTimeOutSec(const Value: integer);
begin
  FTmtTimeOutSec := Value;
end;

{ TLogFile }

constructor TLogFile.Create;
begin
  Cache:=TLogCache.Create;
  Inherited;
end;

destructor TLogFile.Destroy;
begin
  Cache.Free;
  if Stream<>nil then FreeAndNil(Stream);

  Inherited;
end;

end.