program svnsrv;

uses
  Windows, Messages, Registry, SysUtils, NTService, Magsubs4, Magsubs1,
  MagTaskWins, ShellAPI ;

{$R *.RES}

// this program is a service starter that runs Svnserver.exe on server startup, so that
// remote users can access the ICS SVN repository svn.overbyte.be with SVN clients.
// it must be run once as svnsrv.exe -install to install 'Subversion Server Service'

// command line for magpub5 public Windows 2018 server
// c:\csvn\bin\svnserve.exe' ' -d -r "d:\svnrepos" --listen-port "3690" --listen-host "217.146.102.149' ;


// 20 Jan 2020 - 1.2 - baseline


type
                     // Derive a new class from the NT service class
    TNTTestService = class (TNTService)
    protected       // Override the ;Execute' method.
      function Execute : Integer; override;
      function ServiceStop: Boolean ; override;
      function PostRegisterInitialize: Boolean; override ;  // service start
      procedure UserFunction (Code: integer); override ;
    end;

var
    MainService: TNTTestService;
//    LogDiags: boolean ;
    VhActHandle: THandle ;
    ProcessId: THandle ;

const
    ProgVersion = 'Magenta Systems Release 1.2 - 20th Januarry 2020' ;
    ProgServName = 'Subversion Server Service' ;
    ProgDispName = 'Subversion Server Service' ;


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

// run a program and optionally return immediately with all process information

function StartExe2 (const aAppName, aCmdLine, aWorkDir: String;
                                        ShowState: Word): TProcessInformation ;
var
    StartupInfo : TStartupInfo;
    ProcInfo : TProcessInformation;
begin
  {setup the startup information for the application }
    FillChar (StartupInfo, SizeOf (TStartupInfo), 0);
    FillChar (Result, SizeOf (Result), 0);
    with StartupInfo do
    begin
        cb := SizeOf (TStartupInfo);
        dwFlags := STARTF_FORCEONFEEDBACK ;
        if ShowState <> 0 then
        begin
            dwFlags := dwFlags OR STARTF_USESHOWWINDOW ;
            wShowWindow := ShowState ;  // SW_SHOWNORMAL, SW_SHOWMINIMIZED or SW_HIDE
        end ;
    end ;
    if CreateProcess (PChar(aAppName), PChar(aCmdLine), nil, nil, False,
         NORMAL_PRIORITY_CLASS, nil, PChar(aWorkDir), StartupInfo,
                                     ProcInfo) then Result := ProcInfo ;
end;

// ==============================================================================================
// borrowed from RX

function fileShellOpen2(const FileName, Params, StartDir: string;
                                  InitialState: integer): THandle;
var
  Info: TShellExecuteInfo;
//  ExitCode: DWORD;
begin
  result := 0 ;
  FillChar(Info, SizeOf(Info), 0);
  Info.cbSize := SizeOf(TShellExecuteInfo);
  with Info do begin
    fMask := SEE_MASK_NOCLOSEPROCESS;
  //  Wnd := Application.Handle;
    lpFile := PChar(FileName);
    lpParameters := PChar(Params);
    lpDirectory := PChar(StartDir);
    nShow := InitialState ;
  end;
  if ShellExecuteEx(@Info) then
  begin
    result := Info.hProcess ;
  end ;
end;

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

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

function TNTTestService.PostRegisterInitialize: Boolean;
var
    basedir, fname, cmdline: string ;
    ProcessInfo : TProcessInformation;
begin
    result := false ;

// start vehicle activity server
    basedir := ExtractFilePath (ParamStr(0)) ;
    ProcessId := 0 ;
    VhActHandle := 0 ;
    fname := 'c:\csvn\bin\svnserve.exe' ;
    cmdline := ' -d -r "d:\svnrepos" --listen-port "3690" --listen-host "217.146.102.149' ;

    ProcessInfo := StartExe2 (fname, cmdline, basedir, SW_SHOWNORMAL) ;
    VhActHandle := ProcessInfo.hProcess ;
    if VhActHandle = 0 then
    begin
        LogMessage ('SvnServer Failed to Failed to Start: ' + fname + space + cmdline,
                                EVENTLOG_ERROR_TYPE, 0, 0) ;  // event log
        exit ;
    end ;

(*    VhActHandle := fileShellOpen2 (fname, cmdline, basedir, SW_NORMAL) ;
    if VhActHandle = 0 then
    begin
        LogMessage ('SvnServer Failed to Failed to Start: ' + fname + space + cmdline,
                                EVENTLOG_ERROR_TYPE, 0, 0) ;  // event log
        exit ;
    end ;    *)

    LogMessage ('SvnServer Started OK ' + fname + space + IntToStr (ProcessId),
                               EVENTLOG_INFORMATION_TYPE, 0, 0) ;  // event log

    result := true ;
end;

function TNTTestService.ServiceStop: Boolean ;
var
    exitcode: integer ;
begin
    result := true ;
    try

    if ProcessId <> 0 then
    begin
        exitcode := 0 ;
        TermPID (ProcessId, exitcode) ;
        if ExitCode <> Still_Active then
        begin
            ProcessId := 0 ;
            LogMessage ('SvnServer Stopped OK',
                                 EVENTLOG_INFORMATION_TYPE, 0, 0) ;  // event log
        end
        else
        begin
            result := false ;
            LogMessage ('SvnServer Failed to Stop',
                                   EVENTLOG_INFORMATION_TYPE, 0, 0) ;  // event log
        end ;
        exit ;
    end ;

// try the hard way, no clear-ups
    if VhActHandle <> 0 then
    begin
        if TerminateProcess (VhActHandle, 0) then
        begin
            VhActHandle := 0 ;
            LogMessage ('SvnServer Stopped OK',
                                 EVENTLOG_INFORMATION_TYPE, 0, 0) ;  // event log
        end
        else
        begin
            result := false ;
            LogMessage ('SvnServer Failed to Stop',
                                   EVENTLOG_INFORMATION_TYPE, 0, 0) ;  // event log
        end ;
    end ;
    except
    end ;
end;

function TNTTestService.Execute : Integer;
var
    lpExitCode: longword ;
begin
    result := 0;

    if ProcessId <> 0 then
    begin
        while not Terminated do
        begin
            if NOT CheckExePID (ProcessId) then
            begin
                LogMessage ('SvnServer Terminated',
                              EVENTLOG_INFORMATION_TYPE, 0, 0) ;  // event log
                exit ;
            end ;
            Sleep (5000) ;   // very important to stop heavy CPU usage
        end;
        exit ;
    end ;
    if VhActHandle <> 0 then
    begin
        while not Terminated do
        begin
            GetExitCodeProcess (VhActHandle, lpExitCode) ;
            if lpExitCode <> Still_Active then
            begin
                LogMessage ('SvnServer Terminated',
                              EVENTLOG_INFORMATION_TYPE, 0, 0) ;  // event log
                exit ;
            end ;
            Sleep (5000) ;   // very important to stop heavy CPU usage
        end;
        exit ;
    end ;
    LogMessage ('SvnServer Handles Not Found',
                              EVENTLOG_ERROR_TYPE, 0, 0) ;  // event log
end;

procedure TNTTestService.UserFunction (Code: integer);
begin
//
end;

begin
    MainService := TNTTestService.Create (ProgServName, ProgDispName);
    try
        MainService.AllowPause := false ;
        MainService.AllowStop := true ;
//        MainService.Logging := true ;
        MainService.Run;
    except
        MainService.LogMessage ('SvnServer Exception: ' + GetExceptMess
                 (ExceptObject), EVENTLOG_ERROR_TYPE, 0, 0) ;  // event log
    end ;
    MainService.Free
end.