program ZTWatch;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Windows,
  SysUtils,
  ComObj,
  SHFolder,
  Classes,
  DateUtils,
  IOUtils,
  Types;


{ ================================================================================================ }
type
  TStreamWriterHelper = class helper for TStreamWriter
  private
    class var FPrevTime: TDateTime;
  public
    procedure Write(const DateTime: TDateTime; const Format: string = ''); overload;
    procedure Append(const Text: string); overload;
    procedure Append(const Text: string; const Args: array of const); overload;
  end;

{ ------------------------------------------------------------------------------------------------ }
procedure TStreamWriterHelper.Write(const DateTime: TDateTime; const Format: string);
begin
  if Length(Format) = 0 then
    Self.Write(DateTimeToStr(DateTime))
  else
    Self.Write(FormatDateTime(Format, DateTime));
end {TStreamWriterHelper.Write};

{ ------------------------------------------------------------------------------------------------ }
procedure TStreamWriterHelper.Append(const Text: string);
var
  Time: TDateTime;
  Stamp, Prefix: string;
  C: AnsiChar;
  P: Int64;
begin
  P := BaseStream.Position;
  if (P > Length(Encoding.GetPreamble)) then begin
    BaseStream.Seek(-SizeOf(C), soCurrent);
    BaseStream.Read(C, SizeOf(C));
    BaseStream.Position := P;
    if C <> #10 then
      WriteLine;
  end;

  Time := Now;
  if DateOf(Time) > DateOf(FPrevTime) then begin
    Write(FormatDateTime('yyyy-mm-dd (dddd)', Time));
    WriteLine;
  end;
  FPrevTime := Time;

  Stamp := FormatDateTime('hh:nn:ss.zzz ', Time);
  Prefix := StringOfChar(' ', Length(Stamp));
  Write(Stamp + StringReplace(Text, #10, #10 + Prefix, [rfReplaceAll]));
  Flush;
end {TStreamWriterHelper.Append};
{ ------------------------------------------------------------------------------------------------ }
procedure TStreamWriterHelper.Append(const Text: string; const Args: array of const);
begin
  Append(Format(Text, Args));
end {TStreamWriterHelper.Append};


var
  Log: TStreamWriter;


{ ------------------------------------------------------------------------------------------------ }
function GetCSIDLDir(const CSIDL: Integer): string;
var
  Buffer: array[0..MAX_PATH] of Char;
  PBuffer: PChar;
begin
  PBuffer := PChar(@Buffer[0]);
  OleCheck(SHGetFolderPath(0, CSIDL or CSIDL_FLAG_CREATE, 0, SHGFP_TYPE_CURRENT, PBuffer));
  Result := IncludeTrailingPathDelimiter(string(PBuffer));
end {TSpecialFolders.GetCSIDLDir};

{ ------------------------------------------------------------------------------------------------ }
function CreateCacheDirs: string;
begin
  Result := GetCSIDLDir(CSIDL_COMMON_APPDATA) +
            'Voronwë\ZTWatch\' +
            FormatDateTime('yyyy-mm-dd"\"hh.nn.ss.zzz" - "', Now) + IntToHex(GetCurrentProcessId, 8) + '\';
  ForceDirectories(Result);
end {CreateCacheDir};


{ ------------------------------------------------------------------------------------------------ }
// From http://stackoverflow.com/a/1634007/60590
function Is64BitOS: Boolean;
type
  TIsWow64Process = function(Handle:THandle; var IsWow64 : BOOL) : BOOL; stdcall;
var
  hKernel32 : Integer;
  IsWow64Process : TIsWow64Process;
  IsWow64 : BOOL;
begin
  // we can check if the operating system is 64-bit by checking whether
  // we are running under Wow64 (we are 32-bit code). We must check if this
  // function is implemented before we call it, because some older versions
  // of kernel32.dll (eg. Windows 2000) don't know about it.
  // see http://msdn.microsoft.com/en-us/library/ms684139.aspx
  Result := False;
  hKernel32 := LoadLibrary('kernel32.dll');
  if (hKernel32 = 0) then RaiseLastOSError;
  @IsWow64Process := GetProcAddress(hkernel32, 'IsWow64Process');
  if Assigned(IsWow64Process) then begin
    IsWow64 := False;
    if (IsWow64Process(GetCurrentProcess, IsWow64)) then begin
      Result := IsWow64;
    end
    else RaiseLastOSError;
  end;
  FreeLibrary(hKernel32);
end{Is64BitOS};

{ ------------------------------------------------------------------------------------------------ }
function FindZTreeWin: string;
var
  ExeName: string;
  BufferLength: Cardinal;
  PFilenamePart: PChar;
begin
  if Is64BitOS then
    ExeName := 'ZTW64.EXE'
  else
    ExeName := 'ZTW.EXE';
  BufferLength := 32768;
  SetLength(Result, BufferLength - 1);
  SetLength(Result, SearchPath(nil, PChar(ExeName), nil, BufferLength, PChar(Result), PFilenamePart));
  if Length(Result) = 0 then
    RaiseLastOSError;
end {FindZTreeWin};

{ ------------------------------------------------------------------------------------------------ }
function LaunchZTreeWin(const ExePath: string): TProcessInformation;
var
  SUI: TStartupInfo;
begin
  SUI.cb := SizeOf(SUI);
  GetStartupInfo(SUI);
  if not CreateProcess(PChar(ExePath), GetCommandLine, nil, nil, True,
                        CREATE_UNICODE_ENVIRONMENT, GetEnvironmentStrings,
                        nil, SUI, Result) then
    RaiseLastOSError;
end {LaunchZTreeWin};

{ ------------------------------------------------------------------------------------------------ }
function FindZTTemp(const ProcessID: Cardinal): string;
var
  TempDir, PIDFile: string;
  TempDirs: TStringDynArray;
  i, PID: Integer;
  FS: TFileStream;
  FR: TStreamReader;
  HexPID: string;
begin
  Result := '';
  TempDir := GetEnvironmentVariable('TEMP');
  TempDirs := TDirectory.GetDirectories(TempDir, 'ZTMP*', TSearchOption.soTopDirectoryOnly);
  for i := Low(TempDirs) to High(TempDirs) do begin
    PIDFile := TPath.Combine(TempDirs[i], 'ZTW.PID');
    if TFile.Exists(PidFile) then begin
      FS := TFileStream.Create(PIDFile, fmOpenRead or fmShareDenyNone);
      try
        FR := TStreamReader.Create(FS);
        try
          HexPID := FR.ReadToEnd;
        finally
          FR.Free;
        end;
      finally
        FS.Free;
      end;
      if TryStrToInt('$' + HexPID, PID) and (Cardinal(PID) = ProcessID) then begin
        Result := TempDirs[i];
        Break;
      end;
    end;
  end;
end {FindZTTemp};

{ ------------------------------------------------------------------------------------------------ }
function SameFileContents(const File1, File2: TFilename): Boolean;
const
  BlockSize = 1024;
var
  FS1, FS2: TFileStream;
  MS1, MS2: TMemoryStream;
  BytesToRead, BytesRead1, BytesRead2: Int64;
begin
  if not FileExists(File1) or not FileExists(File2) then
    Exit(False);
  FS1 := TFileStream.Create(File1, fmOpenRead or fmShareDenyNone);
  try
    FS2 := TFileStream.Create(File2, fmOpenRead or fmShareDenyNone);
    try
      if FS1.Size <> FS2.Size then
        Exit(False);

      MS1 := TMemoryStream.Create;
      MS2 := TMemoryStream.Create;
      try
        repeat
          if FS1.Size - FS1.Position < BlockSize then
            BytesToRead := FS1.Size - FS1.Position
          else
            BytesToRead := BlockSize;
          BytesRead1 := MS1.CopyFrom(FS1, BytesToRead);

          if FS2.Size - FS2.Position < BlockSize then
            BytesToRead := FS2.Size - FS2.Position
          else
            BytesToRead := BlockSize;
          BytesRead2 := MS2.CopyFrom(FS2, BytesToRead);

          if BytesRead1 <> BytesRead2 then
            Exit(False);
          if not CompareMem(MS1.Memory, MS2.Memory, BytesRead1) then
            Exit(False);

          MS1.Clear;
          MS2.Clear;
        until (FS1.Position >= FS1.Size) or (FS2.Position >= FS2.Size);

        Result := True;
      finally
        MS2.Free;
        MS1.Free;
      end;
    finally
      FS2.Free;
    end;
  finally
    FS1.Free;
  end;
end {IdenticalFiles};

{ ------------------------------------------------------------------------------------------------ }
function ShouldCopyFile(const Filename: TFilename): Boolean;
const
  FilesToCopy: array[1..9] of string = ('ZTW.HST', 'ZTW.ZAM', 'zkeys.log', 'ZTW.INI', 'ARCHIVER.BB2',
                                        'ZColors.ini', 'ZSAVE.ZTM', 'TEMP.ZLOG', 'ZLIST.ZLS');
var
  i: Integer;
begin
  Result := False;
  for i := Low(FilesToCopy) to High(FilesToCopy) do begin
    if SameFileName(FilesToCopy[i], Filename) then
      Exit(True);
  end;
end {ShouldCopyFile};
{ ------------------------------------------------------------------------------------------------ }
function BackupFiles(const TargetDir, CurrentDir, HomeDir: string; const ComparisonDir: string = ''): Integer;
var
  Files: TStringList;
  fi: Integer;
  Filename, SourceFile, TargetFile, ComparisonFile: string;
  LastError: Cardinal;
begin
  Result := 0;
  ForceDirectories(TargetDir);

  Files := TStringList.Create;
  try
    TDirectory.GetFiles(CurrentDir, TSearchOption.soTopDirectoryOnly,
        function(const Path: string; const SR: TSearchRec): Boolean
        begin
          if ShouldCopyFile(SR.Name) then
            Files.Add(TPath.Combine(Path, SR.Name));
          Result := False;
        end);

    if not SameFileName(CurrentDir, HomeDir) then begin
      TDirectory.GetFiles(HomeDir, TSearchOption.soTopDirectoryOnly,
          function(const Path: string; const SR: TSearchRec): Boolean
          begin
            if ShouldCopyFile(SR.Name) then
              Files.Add(TPath.Combine(Path, SR.Name));
            Result := False;
          end);
    end;

    try
      for fi := 0 to Files.Count - 1 do begin
        SourceFile := Files[fi];
        Filename := ExtractFileName(SourceFile);
        TargetFile := ChangeFilePath(Filename, TargetDir);
        ComparisonFile := ChangeFilePath(Filename, ComparisonDir);
        if (ComparisonDir = '') or not SameFileContents(SourceFile, ComparisonFile) then begin
          WriteLn(SourceFile);
          if CopyFile(PChar(SourceFile), PChar(TargetFile), True) then begin
            Inc(Result);
          end else if GetLastError <> ERROR_FILE_EXISTS then begin
            LastError := GetLastError;
            Log.Append(SourceFile + ': ' + SysErrorMessage(LastError));
            Writeln(ErrOutput, SourceFile + ': ' + SysErrorMessage(LastError));
          end;
        end;
      end;
    except
      on E: Exception do begin
        Log.Append(E.ClassName + ': ' + E.Message);
        Writeln(ErrOutput, E.ClassName + ': ' + E.Message);
      end;
    end;
  finally
    Files.Free;
  end;
end {BackupFiles};

type
  DWM_BLURBEHIND = record
    dwFlags                 : DWORD;
    fEnable                 : BOOL;
    hRgnBlur                : HRGN;
    fTransitionOnMaximized  : BOOL;
  end;

//function to enable the glass effect
function DwmEnableBlurBehindWindow(hWnd : HWND; const pBlurBehind : DWM_BLURBEHIND) : HRESULT; stdcall; external  'dwmapi.dll' name 'DwmEnableBlurBehindWindow';
//get the handle of the console window
function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow';

function DWM_EnableBlurBehind(hwnd : HWND; AEnable: Boolean; hRgnBlur : HRGN = 0; ATransitionOnMaximized: Boolean = False; AFlags: Cardinal = 1): HRESULT;
var
  pBlurBehind : DWM_BLURBEHIND;
begin
  pBlurBehind.dwFlags:=AFlags;
  pBlurBehind.fEnable:=AEnable;
  pBlurBehind.hRgnBlur:=hRgnBlur;
  pBlurBehind.fTransitionOnMaximized:=ATransitionOnMaximized;
  Result:=DwmEnableBlurBehindWindow(hwnd, pBlurBehind);
end;

{ ================================================================================================ }
var
  LogFile: TFileStream;
  CacheDir, StartupDir, ZTExe, ZTHome, ZTTemp: string;
  ConsoleWindow: HWND;
  ProcInfo: TProcessInformation;
  ExitCode: DWORD;
  StartTime, EndTime: TDateTime;
  Interval: Integer;
  IntervalUnit: string;
begin
  try

    (*
      TODO: integrate this with fossil
      - use a central work dir
      - on startup:
        - copy all relevant* files from #ZTHome
        - convert binary files to readable (and diffable)
        - fossil addremove
        - fossil commit --no-warnings --allow-empty --tag start --tag <process-id and window handle> -m "Started PID <process-id> HWND <window-handle>"
      - on shutdown:
        - copy all relevant* files from #ZTHome
        - convert binary files to readable (and diffable)
        - copy all files (except for the ZTW.PID) from #ZTTemp into a ZTTemp subdir?
        - fossil addremove
        - fossil commit --no-warnings --allow-empty --tag finish --tag <process-id and window handle> --tag exitcode=<exitcode> -M <ZTW.log>
        - prune the ZTTemp subdir
      * all relevant files means all files from #ZTHome that either match one in the list
        given in ShouldCopyFile above, or are already present in the work dir.
      [TODO]
      - try to convert all binary files to readable ones (preferably ones that can also be converted
        back to binary without data loss);
        - *.ZAM can be converted to .ZAM.TXT or .ZAM.XML
        - ZTW.INI?
    *)

    ConsoleWindow := GetConsoleWindow;
//    DWM_EnableBlurBehind(ConsoleWindow, True);

    // Set up a log dir under LocalAppData (C:\ProgramData\Voronwë\ZTWatch\yyyy-mm-dd\hh.nn.ss.zzz\<ZTWatch-PID>\)
    // Subdirs: 1_Before, 2_Temp, 3_After
    StartupDir := ExcludeTrailingPathDelimiter(GetCurrentDir);
    CacheDir := CreateCacheDirs;
    TFileStream.Create(CacheDir + 'ZTWatch.log', fmCreate).Free;
    LogFile := TFileStream.Create(CacheDir + 'ZTWatch.log', fmOpenWrite or fmShareDenyWrite);
    Log := TStreamWriter.Create(LogFile, TEncoding.UTF8);
    try
      try
        Log.Append(StringOfChar('-', 80));
        Log.Append('Command line: %s', [GetCommandLine]);

        ZTExe := FindZTreeWin;
        ZTHome := ExtractFilePath(ZTExe);

        Log.Append('ZTExe: %s', [ZTExe]);
        if not SameFileName(ExcludeTrailingPathDelimiter(ZTHome), StartupDir) then
          Log.Append('Current dir: %s', [StartupDir]);

        // Before startup: make backup of all files in #ZTHome (unless there's a copy of that file in
        //  the current dir; if so we use that one) to ~/1_Before/
        WriteLn('Backing up files...');
        BackupFiles(CacheDir + '1_Before', ZTHome, StartupDir);

        // Figure out if we're running on a 64-bits system; if so, launch ZTW64.exe (otherwise
        //  ZTW.exe), passing along all our command-line options
        ProcInfo := LaunchZTreeWin(ZTExe);
        try
          StartTime := Now;
          // After startup:
          // Log Process ID, WindowHandle?
          Log.Append('ZTreeWin started; process ID: %d (%.4x)', [ProcInfo.dwProcessId, ProcInfo.dwProcessId]);
          Log.Append('Console window handle: %d (%.4x)', [ConsoleWindow, ConsoleWindow]);

          ZTTemp := FindZTTemp(ProcInfo.dwProcessId);
          if ZTTemp = '' then begin
            Sleep(1000);
            ZTTemp := FindZTTemp(ProcInfo.dwProcessId);
          end;
          if ZTTemp <> '' then begin
            Log.Append('ZTTemp: %s', [ZTTemp]);
          end;
          // TODO: Make backup of all files in #ZTTemp (and set up a DirWatcher
          //  so as to keep track of all changes, notably to zkeys.log)


          // Wait for termination of ZTreeWin
          repeat
            if WaitForSingleObject(ProcInfo.hProcess, 250) = WAIT_OBJECT_0 then
              Break;
            GetExitCodeProcess(ProcInfo.hProcess, ExitCode);
          until (ExitCode <> STILL_ACTIVE);
          EndTime := Now;
          GetExitCodeProcess(ProcInfo.hProcess, ExitCode);

          case SecondsBetween(EndTime, StartTime) of
            0: begin
              Interval := MilliSecondsBetween(EndTime, StartTime);
              IntervalUnit := 'ms';
            end;
            1: begin
              Interval := 1;
              IntervalUnit := 'second';
            end;
            2..119: begin
              Interval := SecondsBetween(EndTime, StartTime);
              IntervalUnit := 'seconds';
            end;
            120..3599: begin
              Interval := MinutesBetween(EndTime, StartTime);
              IntervalUnit := 'minutes';
            end;
            3600..86399: begin
              Interval := HoursBetween(EndTime, StartTime);
              IntervalUnit := 'hours';
            end;
            else begin
              Interval := DaysBetween(EndTime, StartTime);
              IntervalUnit := 'days';
            end;
          end;
          Log.Append('ZTreeWin finished after %d %s with exit code %d.',
                      [Interval, IntervalUnit, ExitCode]);
        finally
          CloseHandle(ProcInfo.hProcess);
          CloseHandle(ProcInfo.hThread);
        end;

        // Minimize the console window
        ShowWindow(ConsoleWindow, SW_MINIMIZE);
        SetConsoleTitle('Shutting down...');

        // After termination of ZTreeWin, we (again) make a copy of all those files, *if
        //  they have been changed*, to ~/3_After/
        WriteLn('Backing up files...');
        BackupFiles(CacheDir + '3_After', ZTHome, StartupDir, CacheDir + '1_Before');

        Log.Append(StringOfChar('=', 80));
      except
        on E: Exception do begin
          Log.Append('!!! ' + E.ClassName + ': ' + E.Message);
          raise;
        end;
      end;
    finally
      Log.Free;
      LogFile.Free;
    end;
    if ExitCode <> 0 then begin
      with TStreamWriter.Create(CacheDir + Format('ExitCode %d.txt', [ExitCode]), False) do begin
        Write(ExitCode);
        Free;
      end;
    end;

  except
    on E: Exception do begin
      Beep;
      Writeln(ErrOutput, E.ClassName, ': ', E.Message);
    end;
  end;
end.
