unit Cache;

////////////////////////////////////////////////////////////////////////////////////////////////////
interface
uses
  System.Generics.Collections;

type
  TCache<T> = class
  private
    FRoots: TDictionary<string,string>;
    FInfos: TDictionary<string,T>;
  public
    constructor Create;
    destructor  Destroy; override;

    function  GetAssociatedRoot(const Dir: string): string;
    procedure SetAssociatedRoot(const Dir, RootDir: string);
    function  GetInfo(const RootDir: string; out Repo: T): Boolean;
    procedure SetInfo(const RootDir: string; const Info: T);
  end;


////////////////////////////////////////////////////////////////////////////////////////////////////
implementation
uses
  u_FinalPathName;

const
  cLockTimeout = 1000;

{ TCache<T> }

constructor TCache<T>.Create;
begin
  FRoots := TDictionary<string,string>.Create;
  FInfos := TDictionary<string,T>.Create;
end;

destructor TCache<T>.Destroy;
begin
  FRoots.Free;
  FInfos.Free;
  inherited;
end;

function TCache<T>.GetInfo(const RootDir: string; out Repo: T): Boolean;
begin
  Result := TMonitor.Enter(FInfos, cLockTimeout);
  if Result then
  try
    Result := FInfos.TryGetValue(RootDir, Repo) or FInfos.TryGetValue(GetFinalPathName(RootDir), Repo);
  finally
    TMonitor.Exit(FInfos);
  end;
end;

function TCache<T>.GetAssociatedRoot(const Dir: string): string;
begin
  if TMonitor.Enter(FRoots, cLockTimeout) then begin
    try
      if not (FRoots.TryGetValue(Dir, Result) or FRoots.TryGetValue(GetFinalPathName(Dir), Result)) then
          Result := '';
    finally
      TMonitor.Exit(FRoots);
    end;
  end else begin
    Result := '';
  end;
end;

procedure TCache<T>.SetInfo(const RootDir: string; const Info: T);
begin
  TMonitor.Enter(FInfos);
  try
    FInfos.AddOrSetValue(GetFinalPathName(RootDir), Info);
  finally
    TMonitor.Exit(FInfos);
  end;
end;

procedure TCache<T>.SetAssociatedRoot(const Dir, RootDir: string);
var
  FinalDir: string;
begin
  TMonitor.Enter(FRoots);
  try
    FinalDir := GetFinalPathName(Dir);
    if RootDir = '' then begin
      FRoots.Remove(FinalDir);
    end else begin
      FRoots.AddOrSetValue(GetFinalPathName(Dir), RootDir);
    end;
  finally
    TMonitor.Exit(FRoots);
  end;
end;

end.

    </PropertyGroup>
    <Import Project="..\Version.optset" Condition="'$(Base)'!='' And Exists('..\Version.optset')"/>
    <PropertyGroup Condition="'$(Base)'!=''">
        <DCC_UNIT_PLATFORM>false</DCC_UNIT_PLATFORM>
        <DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM>
        <DCC_CBuilderOutput>All</DCC_CBuilderOutput>
        <GenPackage>true</GenPackage>
        <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
        <GenDll>true</GenDll>
        <SanitizedProjectName>VCSInfo</SanitizedProjectName>
        <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
        <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
        <DCC_E>false</DCC_E>
        <DCC_N>false</DCC_N>
        <DCC_S>false</DCC_S>

requires
  rtl,
  designide;

contains
  VCSInfoMenuWzrd in '..\VCSInfoMenuWzrd.pas',
  u_FinalPathName,
  u_VersionInfo in '..\u_VersionInfo.pas',
  Cache in '..\Cache.pas';

end.

    <Import Project="..\Version.optset" Condition="'$(Base)'!='' And Exists('..\Version.optset')"/>
    <PropertyGroup Condition="'$(Base)'!=''">
        <DCC_UnitSearchPath>..;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
        <DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM>
        <DCC_UNIT_PLATFORM>false</DCC_UNIT_PLATFORM>
        <DCC_CBuilderOutput>All</DCC_CBuilderOutput>
        <GenPackage>true</GenPackage>

        <GenDll>true</GenDll>
        <SanitizedProjectName>VCSInfo</SanitizedProjectName>
        <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
        <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
        <DCC_E>false</DCC_E>
        <DCC_N>false</DCC_N>
        <DCC_S>false</DCC_S>
        <DCC_F>false</DCC_F>
        <DCC_K>false</DCC_K>


        <VerInfo_Locale>1033</VerInfo_Locale>
        <CfgDependentOn>..\Version.optset</CfgDependentOn>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base_Android)'!=''">
        <DCC_UsePackage>rtl;$(DCC_UsePackage)</DCC_UsePackage>
        <DCC_CBuilderOutput>None</DCC_CBuilderOutput>
    </PropertyGroup>

        <DCC_DebugDCUs>true</DCC_DebugDCUs>
        <DCC_Optimize>false</DCC_Optimize>
        <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
        <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
        <DCC_RemoteDebug>true</DCC_RemoteDebug>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
        <VerInfo_Keys>CompanyName=Martijn Coppoolse;FileDescription=VCS Info;FileVersion=0.1.0.0;InternalName=VCSInfo;LegalCopyright=;LegalTrademarks=;OriginalFilename=VCSInfo.bpl;ProductName=VCS Info;ProductVersion=1.0;Comments=http://fossil.2of4.net/vcsInfo</VerInfo_Keys>
        <VerInfo_MajorVer>0</VerInfo_MajorVer>
        <VerInfo_PreRelease>true</VerInfo_PreRelease>
        <VerInfo_DLL>true</VerInfo_DLL>
        <VerInfo_MinorVer>1</VerInfo_MinorVer>
        <DCC_RemoteDebug>false</DCC_RemoteDebug>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_2)'!=''">
        <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
        <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
        <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
        <DCC_DebugInformation>0</DCC_DebugInformation>
    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
        </DelphiCompile>
        <DCCReference Include="rtl.dcp"/>
        <DCCReference Include="designide.dcp"/>
        <DCCReference Include="..\VCSInfoMenuWzrd.pas"/>
        <DCCReference Include="..\u_VersionInfo.pas"/>
        <DCCReference Include="..\Cache.pas"/>
        <None Include="..\..\todo.md"/>
        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">
            <Key>Base</Key>

    function IsRepo: Boolean;
  end;

  // TODO: implement IOTAEditorNotifier and/or IOTAIDENotifier so we know which file is active
  TVCSInfoWizard = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)
    private
      FRepos: TDictionary<string,TRepoInfo>;
      FCurrentVersion: string;

      FToolbar: TToolBar;
      FPluginAbout: Integer;

      FButtonSync: TToolButton;
      FButtonStatus: TToolButton;
      FButtonBranch: TToolButton;

procedure Register;

implementation
uses
  System.SysUtils, System.UITypes, System.Classes, System.StrUtils,
  Winapi.Windows, Winapi.ShellAPI,
  Vcl.Forms, Vcl.Dialogs, Vcl.Graphics,
  u_FinalPathName, u_VersionInfo;

const
  scMenuIDString = 'net.2of4.VCSInfoWizard';
  cLimit = 9;

type
  TRefreshTrigger = (trgCode, trgUser, trgFileSaved, trgFileSwitched, trgTimer);
  TRefreshTask = record
    Trigger: TRefreshTrigger;
    FileName: string;
  end;
  TRefreshTaskQueue = class(TThreadedQueue<TRefreshTask>);

{ ------------------------------------------------------------------------------------------------ }
procedure Register;
begin
  RegisterPackageWizard(TVCSInfoWizard.Create);
  (* TODO: create multiple separate menu wizards:
    - pull (incoming) / push (outgoing)
  *)
end;


{$REGION 'Functions to execute command-line and capture output'}

//--- JclBase and JclSysUtils --------------------------------------------------
const
  // line delimiters for a version of Delphi/C++Builder
  NativeLineFeed       = Char(#10);
  NativeCarriageReturn = Char(#13);

function CharIsReturn(const C: Char): Boolean;

                                            PChar(ACurrentDir),
                                            SUI, ProcInfo);
  except
    Result := False;
  end;
end {CreateProcess};






































{ ================================================================================================ }
{ TVCSInfoWizard }

{ ------------------------------------------------------------------------------------------------ }
constructor TVCSInfoWizard.Create;
var

  actBranch: TAction;
  i: Integer;
begin
  LogMessage(StringOfChar('-', 80));

  Services := ToolsAPI.BorlandIDEServices as INTAServices;

  LogMessage('Inserting about box...');
  with TFileVersionInfo.Create(HInstance) do begin
    try
      FCurrentVersion := Trim(FileDescription + ' ' + FileVersionText);

      AboutBox := ToolsAPI.BorlandIDEServices as IOTAAboutBoxServices;
      FPluginAbout := AboutBox.AddPluginInfo(FCurrentVersion,
                                              FCurrentVersion + sLineBreak +
                                              sLineBreak +
                                              '© ' + CompanyName + ' - ' + Comments,
                                              0);
    finally
      Free;
    end;
  end;

  LogMessage('Creating toolbar');
  Toolbar := nil;
  Services.ReadToolbar(Application.MainForm, Application.MainForm.FindChildControl('Controlbar1') as TWinControl, scToolbarName, Toolbar);
  if not (Toolbar is TToolBar) then begin
    FToolbar := Services.NewToolbar(scToolbarName, 'Repository');
    FToolbar.AutoSize := True;
    Services.WriteToolbar(FToolbar);
  end else begin

  AddButtonMenuItem(Button, FImgSyncPush, 'Outgoing changesets (push)');
  AddButtonMenuItem(Button, FImgSyncBoth, 'Incoming and outgoing changesets');
  AddButtonMenuItem(Button, -1,           '-');
  AddButtonMenuItem(Button, FImgClean,    'Working dir is clean');
  AddButtonMenuItem(Button, FImgPending,  'Working dir has changes');
  AddButtonMenuItem(Button, FImgExtra,    'Working dir has untracked files');
  AddButtonMenuItem(Button, -1,           '-');
  AddButtonMenuItem(Button, FImgIcon,     FCurrentVersion, actInfoMenuVCSClick);


  LogMessage('Creating sync button...');
  actSync := TAction.Create(FToolbar);
  actSync.Caption := 'Nothing to sync';
  actSync.Hint := actSync.Caption;
  actSync.Enabled := True;

  if not Assigned(Toolbar) then begin
    FToolbar.Left := Application.MainForm.Width - FToolbar.Width;
    FToolbar.Visible := True;
  end;
//  Services.ToolbarModified(FToolbar);
  FToolbar.Invalidate;







end {TVCSInfoWizard.Create};
{ ------------------------------------------------------------------------------------------------ }
destructor TVCSInfoWizard.Destroy;
var
  Services: INTAServices;
  Button: TToolButton;
  i: Integer;

        end;
        1: begin // fossil
          ExecuteCmd('fossil version', Output);
          if Output <> '' then
            Item.Caption := Output.Replace('This is f', 'F').TrimRight;
        end;
        else begin
          Item.Caption := FCurrentVersion;
        end;
      end;
    end;
  except
    on E: Exception do begin
      LogMessage('actInfoMenuPopUp raised ' + E.ClassName + sLineBreak + E.ToString);
    end;

        end;
         0: begin
          NewImageIndex := FImgClean;
          NewHint := 'Working directory is clean';
         end
        else begin
          NewImageIndex := FImgPending;
          if Repo.Pending = 1 then begin
            NewHint := Format('%d file pending', [Repo.Pending]);
          end else begin
            NewHint := Format('%d files pending', [Repo.Pending]);
          end;
        end;
      end;
    end else begin
      NewImageIndex := -1; // FImgNeutral;
      NewHint := 'No repository';
    end;

unit u_VersionInfo;

interface

uses
  Windows, SysUtils, System.Classes;

type
  TVersion = packed record
    class operator Implicit(Text: string): TVersion;
    class operator Implicit(Version: TVersion): string;
    class operator Equal(A, B: TVersion): boolean; inline;
    class operator NotEqual(A, B: TVersion): boolean; inline;
    class operator GreaterThan(A, B: TVersion): boolean; inline;
    class operator GreaterThanOrEqual(A, B: TVersion): boolean; inline;
    class operator LessThan(A, B: TVersion): boolean; inline;
    class operator LessThanOrEqual(A, B: TVersion): boolean; inline;
    function CompareTo(const Other: TVersion): integer;
    case Integer of
      0: (
        Major:    Word;
        Minor:    Word;
        Revision: Word;
        Build:    Word;
      );
      1: (
        Values: packed array[0..3] of Word;
      );
  end;

type
  TFileVersionInfo = class
  {$SCOPEDENUMS ON}
  type
    TFlag = (Debug, PreRelease, Patched, PrivateBuild, SpecialBuild);
    TFlags = set of TFlag;
  strict private const
    cFlags: array[TFlag] of Cardinal = (VS_FF_DEBUG,
                                        VS_FF_PRERELEASE,
                                        VS_FF_PATCHED,
                                        VS_FF_PRIVATEBUILD,
                                        VS_FF_SPECIALBUILD);
  type
    TFileType = (Unknown = VFT_UNKNOWN,
                 Application = VFT_APP,
                 DLL = VFT_DLL,
                 Driver = VFT_DRV,
                 Font = VFT_FONT,
                 VirtualDevice = VFT_VXD,
                 StaticLib = VFT_STATIC_LIB);
    TFileSubtype = (Unknown = VFT2_UNKNOWN,
                    PrinterPrinter = VFT2_DRV_PRINTER,
                    KeyboardDriver = VFT2_DRV_KEYBOARD,
                    LanguageDriver = VFT2_DRV_LANGUAGE,
                    DisplayDriver = VFT2_DRV_DISPLAY,
                    MouseDriver = VFT2_DRV_MOUSE,
                    NetworkDriver = VFT2_DRV_NETWORK,
                    SystemDriver = VFT2_DRV_SYSTEM,
                    InstallableDriver = VFT2_DRV_INSTALLABLE,
                    SoundDriver = VFT2_DRV_SOUND,
                    CommunicationsDriver = VFT2_DRV_COMM,
                    RasterFont = VFT2_FONT_RASTER,
                    VectorFont = VFT2_FONT_VECTOR,
                    TrueTypeFont = VFT2_FONT_TRUETYPE);
  {$SCOPEDENUMS OFF}
  strict private type
    TLangAndCP = record
      wLanguage : word;
      wCodePage : word;
    end;
    PLangAndCP = ^TLangAndCP;
  private
    { Private declarations }
    FBufferStream       : TMemoryStream;
    FBufferPtr          : Pointer;
    FFilename           : string;
    FHasVersionInfo     : boolean;
    FLang               : PLangAndCP;

    FCompanyName        : string;
    FFileDescription    : string;
    FFileVersionText    : string;
    FInternalname       : string;
    FLegalCopyright     : string;
    FLegalTradeMarks    : string;
    FOriginalFilename   : string;
    FProductName        : string;
    FProductVersionText : string;
    FComments           : string;
    FSpecialBuild       : string;
    FPrivateBuild       : string;
    FFileVersion        : TVersion;
    FProductVersion     : TVersion;
    FFlags              : cardinal;
    FFileType           : TFileType;
    FFileSubtype        : TFileSubtype;

    procedure Clear;
    procedure ReadVersionInfoFromFile(const AFileName: string);
    procedure ReadVersionInfoFromModule(const AInstance: THandle);
    procedure ReadVersionInfo(const ABuffer: Pointer);

    procedure SetFileName(const AFileName: string);
    function  QueryValue(const AName: string): string;
    function  GetFlags: TFlags;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(const AFileName: string); overload;
    constructor Create(const AInstance: THandle); overload;
    destructor  Destroy; override;

    property FileName                 : string        read FFileName          write SetFileName;
    property HasVersionInfo           : boolean       read FHasVersionInfo;
    property Flags                    : TFlags        read GetFlags;
    property FileType                 : TFileType     read FFileType;
    property FileSubtype              : TFileSubtype  read FFileSubtype;

    { Published declarations }
    property CompanyName              : string        read FCompanyName;
    property FileDescription          : string        read FFileDescription;
    property FileVersion              : TVersion      read FFileVersion;
    property FileVersionText          : string        read FFileVersionText;
    property InternalName             : string        read FInternalname;
    property LegalCopyright           : string        read FLegalCopyright;
    property LegalTradeMarks          : string        read FLegalTradeMarks;
    property OriginalFilename         : string        read FOriginalFilename;
    property ProductName              : string        read FProductName;
    property ProductVersion           : TVersion      read FProductVersion;
    property ProductVersionText       : string        read FProductVersionText;
    property Comments                 : string        read FComments;

    property Value[const Name: string]: string        read QueryValue;
  end;

implementation

constructor TFileVersionInfo.Create(const AFileName: string);
begin
  inherited Create;
  SetFileName(AFileName);
end;

constructor TFileVersionInfo.Create(const AInstance: THandle);
begin
  inherited Create;
  ReadVersionInfoFromModule(AInstance);
end;

destructor TFileVersionInfo.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TFileVersionInfo.Clear;
begin
  FFilename           := '';
  FCompanyname        := '';
  FFileDescription    := '';
  FFileVersionText    := '';
  FInternalname       := '';
  FLegalCopyright     := '';
  FLegalTradeMarks    := '';
  FOriginalFilename   := '';
  FProductName        := '';
  FProductVersionText := '';
  FComments           := '';
  FSpecialBuild       := '';
  FPrivateBuild       := '';
  FFileVersion        := Default(TVersion);
  FProductVersion     := Default(TVersion);
  FFlags              := 0;
  if FBufferStream <> nil then begin
    FBufferStream.Free;
    FBufferStream := nil;
  end else if FBufferPtr <> nil then begin
    FreeMem(FBufferPtr);
  end;
  FBufferPtr := nil;
end;

procedure TFileVersionInfo.ReadVersionInfoFromFile(const AFileName: string);
var
  Dummy     : cardinal;
  BufferSize: integer;
begin
  Clear;
  FFilename := AFileName;

  BufferSize := GetFileVersionInfoSize(PChar(AFileName), Dummy);
  FHasVersionInfo := (Buffersize > 0);
  if FHasVersionInfo then begin
    FBufferPtr := AllocMem(BufferSize);
    FHasVersionInfo := GetFileVersionInfo(PChar(AFileName), 0, BufferSize, FBufferPtr);
    if FHasVersionInfo then begin
      ReadVersionInfo(FBufferPtr);
    end else begin
      FreeMem(FBufferPtr, BufferSize);
      FBufferPtr := nil;
    end;
  end;
end;

procedure TFileVersionInfo.ReadVersionInfoFromModule(const AInstance: THandle);
var
  RS: TResourceStream;
  BufferSize, ResultSize: Cardinal;
begin
  Clear;
  // Inspired by http://stackoverflow.com/a/1720501/3092116
  FBufferStream := TMemoryStream.Create;
  try
    RS := TResourceStream.CreateFromID(AInstance, 1, RT_VERSION);
    try
      FBufferStream.CopyFrom(RS, RS.Size);
    finally
      RS.Free;
    end;
    FBufferStream.Position := 0;
    FBufferPtr := FBufferStream.Memory;
    ReadVersionInfo(FBufferPtr);
  except
    FBufferStream.Free;
    FBufferStream := nil;
  end;

  // also try to determine the filename of the given instance
  BufferSize := MAX_PATH;
  repeat
    FFilename := StringOfChar(#0, BufferSize);
    ResultSize := GetModuleFileName(AInstance, PChar(FFilename), BufferSize);
    SetLength(FFilename, ResultSize);
    BufferSize := BufferSize * 2;
  until (ResultSize < BufferSize) or (GetLastError <> ERROR_INSUFFICIENT_BUFFER);
end;

procedure TFileVersionInfo.ReadVersionInfo(const ABuffer: Pointer);
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  function ReadVersion(const MS, LS: Cardinal): TVersion; inline;
  begin
    Result.Major    := MS shr 16;
    Result.Minor    := MS and 65535;
    Result.Revision := LS shr 16;
    Result.Build    := LS and 65535;
  end;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
var
  Dummy     : cardinal;
  SubBlock  : string;
  InfoPtr   : Pointer;
  InfoBlock : TVSFixedFileInfo;
begin
  SubBlock := '\\VarFileInfo\\Translation';
  VerQueryValue(ABuffer, PChar(SubBlock), Pointer(FLang), Dummy);

  FCompanyName        := QueryValue('CompanyName');
  FFileDescription    := QueryValue('FileDescription');
  FFileVersionText    := QueryValue('FileVersion');
  FInternalName       := QueryValue('InternalName');
  FLegalCopyright     := QueryValue('LegalCopyright');
  FLegalTradeMarks    := QueryValue('LegalTradeMarks');
  FOriginalFilename   := QueryValue('OriginalFilename');
  FProductName        := QueryValue('ProductName');
  FProductVersionText := QueryValue('ProductVersion');
  FComments           := QueryValue('Comments');
  FSpecialBuild       := QueryValue('SpecialBuild');
  FPrivateBuild       := QueryValue('PrivateBuild');

  VerQueryValue(ABuffer, '\', InfoPtr, Dummy);
  Move(InfoPtr^, InfoBlock, SizeOf(InfoBlock));
  FFileVersion    := ReadVersion(InfoBlock.dwFileVersionMS, InfoBlock.dwFileVersionLS);
  FProductVersion := ReadVersion(InfoBlock.dwProductVersionMS, InfoBlock.dwProductVersionLS);
  FFlags          := InfoBlock.dwFileFlags and InfoBlock.dwFileFlagsMask;
  FFileType       := TFileType(InfoBlock.dwFileType);
  FFileSubtype    := TFileSubtype(InfoBlock.dwFileSubtype);
end;

function TFileVersionInfo.QueryValue(const AName: string): string;
var
  SubBlock  : string;
  Dummy     : cardinal;
  Value     : PChar;
begin
  SubBlock := Format('\\StringFileInfo\\%.4x%.4x\\%s', [GetThreadLocale, GetACP, AName]);
  if VerQueryValue(FBufferPtr, PChar(SubBlock), Pointer(Value), Dummy) then begin
    Result := string(Value);
  end else begin
    SubBlock := Format('\\StringFileInfo\\%.4x%.4x\\%s', [FLang.wLanguage, FLang.wCodePage, AName]);
    VerQueryValue(FBufferPtr, PChar(SubBlock), Pointer(Value), Dummy);
    Result := string(Value);
  end;
end;

procedure TFileVersionInfo.SetFileName(const AFileName: string);
begin
  ReadVersionInfoFromFile(AFileName);
end {TFileVersionInfo.SetFileName};

function TFileVersionInfo.GetFlags: TFlags;
var
  Flag: TFlag;
begin
  Result := [];
  for Flag := Low(cFlags) to High(cFlags) do begin
    if (FFlags and cFlags[Flag]) <> 0 then begin
      Include(Result, Flag);
    end;
  end;
end;


{ TVersion }

class operator TVersion.Implicit(Text: string): TVersion;
var
  vi, ci: Integer;
  Value: Cardinal;
  Index: Integer;
begin
  Result := Default(TVersion);
  vi := Low(Result.Values);
  ci := 1;
  while (ci <= Length(Text)) and (vi <= High(Result.Values)) do begin
    Val(Copy(Text, ci), Value, Index);
    if Index = 0 then begin // the entire remainder of the string is a valid integer
      Result.Values[vi] := Value;
      Break;
    end else if Index > 1 then begin // we have an integer, followed by something non-integer
      Result.Values[vi] := Value;
      Inc(vi);
    end;
    ci := ci + Index;
  end;
end;

class operator TVersion.Implicit(Version: TVersion): string;
begin
  Result := Format('%d.%d.%d.%d', [Version.Major, Version.Minor, Version.Revision, Version.Build]);
end;

function TVersion.CompareTo(const Other: TVersion): integer;
var
  i: Integer;
begin
  for i := Low(Values) to High(Values) do begin
    if Values[i] < Other.Values[i] then
      Exit(-1)
    else if Values[i] > Other.Values[i] then
      Exit(1);
  end;
  Result := 0;
end;

class operator TVersion.Equal(A, B: TVersion): boolean;
begin
  Result := A.CompareTo(B) = 0;
end;

class operator TVersion.GreaterThan(A, B: TVersion): boolean;
begin
  Result := A.CompareTo(B) > 0;
end;

class operator TVersion.GreaterThanOrEqual(A, B: TVersion): boolean;
begin
  Result := A.CompareTo(B) >= 0;
end;

class operator TVersion.LessThan(A, B: TVersion): boolean;
begin
  Result := A.CompareTo(B) < 0;
end;

class operator TVersion.LessThanOrEqual(A, B: TVersion): boolean;
begin
  Result := A.CompareTo(B) <= 0;
end;

class operator TVersion.NotEqual(A, B: TVersion): boolean;
begin
  Result := A.CompareTo(B) <> 0;
end;

end.