Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
gfx	[ DIR ]	drwxrwxrwx
locale	[ DIR ]	drwxrwxrwx
.mad-root	0 B	-rw-rw-rw-
VersInfo.pas	42.97 KB	-rw-rw-rw-
default.po	32.22 KB	-rw-rw-rw-
ggexclude.cfg	227 B	-rw-rw-rw-
gnugettext.pas	114.84 KB	-rw-rw-rw-
ignore.po	7.28 KB	-rw-rw-rw-
sonar-project.properties	464 B	-rw-rw-rw-
uApache.pas	15.79 KB	-rw-rw-rw-
uBaseModule.pas	2.25 KB	-rw-rw-rw-
uConfig.dfm	14.81 KB	-rw-rw-rw-
uConfig.pas	4.43 KB	-rw-rw-rw-
uConfigUserDefined.dfm	14.73 KB	-rw-rw-rw-
uConfigUserDefined.pas	3.36 KB	-rw-rw-rw-
uExceptionDialog.dcu	32.71 KB	-rw-rw-rw-
uExceptionDialog.dfm	2.08 KB	-rw-rw-rw-
uExceptionDialog.pas	27.37 KB	-rw-rw-rw-
uFileZilla.pas	14.85 KB	-rw-rw-rw-
uGetWinVersionInfo.dcu	8.09 KB	-rw-rw-rw-
uGetWinVersionInfo.pas	11.13 KB	-rw-rw-rw-
uHelp.dfm	3.18 KB	-rw-rw-rw-
uHelp.pas	1.81 KB	-rw-rw-rw-
uJclSysInfo.pas	22.05 KB	-rw-rw-rw-
uLanguage.dfm	12.95 KB	-rw-rw-rw-
uLanguage.pas	2 KB	-rw-rw-rw-
uLogOptions.dfm	6.42 KB	-rw-rw-rw-
uLogOptions.pas	2.1 KB	-rw-rw-rw-
uMain.dfm	217.14 KB	-rw-rw-rw-
uMain.pas	39.26 KB	-rw-rw-rw-
uMercury.pas	11.42 KB	-rw-rw-rw-
uMySQL.pas	13.95 KB	-rw-rw-rw-
uNetstat.dfm	3.53 KB	-rw-rw-rw-
uNetstat.pas	7.95 KB	-rw-rw-rw-
uNetstatTable.pas	7.58 KB	-rw-rw-rw-
uProcesses.pas	6.25 KB	-rw-rw-rw-
uProcesses_new.pas	2.14 KB	-rw-rw-rw-
uServiceSettings.dfm	16.89 KB	-rw-rw-rw-
uServiceSettings.pas	8.26 KB	-rw-rw-rw-
uServices.pas	6.14 KB	-rw-rw-rw-
uTomcat.pas	15.9 KB	-rw-rw-rw-
uTools.pas	26.61 KB	-rw-rw-rw-
xampp_control3.dpr	2.21 KB	-rw-rw-rw-
xampp_control3.dproj	30.02 KB	-rw-rw-rw-
xampp_control3.dproj.local	38.45 KB	-rw-rw-rw-
xampp_control3.drc	78.46 KB	-rw-rw-rw-
xampp_control3.dres	37.08 KB	-rw-rw-rw-
xampp_control3.identcache	1.29 KB	-rw-rw-rw-
xampp_control3.stat	170 B	-rw-rw-rw-
xampp_control3Resource.rc	341 B	-rw-rw-rw-
xampp_control3_project.tvsconf...	72 B	-rw-rw-rw-

Code Editor : gnugettext.pas

{ *------------------------------------------------------------------------------
  GNU gettext translation system for Delphi, Kylix, C++ Builder and others.
  All parts of the translation system are kept in this unit.

@author Lars B. Dybdahl and others
  @version $LastChangedRevision$
  @see http://dybdahl.dk/dxgettext/
  ------------------------------------------------------------------------------- }
unit gnugettext;
(* ************************************************************ *)
(* *)
(* (C) Copyright by Lars B. Dybdahl and others *)
(* E-mail: Lars@dybdahl.dk, phone +45 70201241 *)
(* *)
(* Contributors: Peter Thornqvist, Troy Wolbrink, *)
(* Frank Andreas de Groot, Igor Siticov, *)
(* Jacques Garcia Vazquez, Igor Gitman *)
(* *)
(* See http://dybdahl.dk/dxgettext/ for more information *)
(* *)
(* ************************************************************ *)

// Information about this file:
// $LastChangedDate$
// $LastChangedRevision$
// $HeadURL$

// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are met:
//
// The names of any contributor may not be used to endorse or promote
// products derived from this software without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
// SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
// CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
// OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

interface

// If the conditional define DXGETTEXTDEBUG is defined, debugging log is activated.
// Use DefaultInstance.DebugLogToFile() to write the log to a file.
{ $define DXGETTEXTDEBUG }

{$IFDEF VER140}
// Delphi 6
{$DEFINE DELPHI2007OROLDER}
{$IFDEF MSWINDOWS}
{$DEFINE DELPHI6OROLDER}
{$ENDIF}
{$ENDIF}
{$IFDEF VER150}
// Delphi 7
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER160}
// Delphi 8
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER170}
// Delphi 2005
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER180}
// Delphi 2006
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER190}
// Delphi 2007
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER200}
// Delphi 2009 with Unicode
{$ENDIF}

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ELSE}
  Libc,
{$IFDEF FPC}
  CWString,
{$ENDIF}
{$ENDIF}
  Classes, StrUtils, SysUtils, TypInfo;

(* *************************************************************************** *)
(* *)
(* MAIN API *)
(* *)
(* *************************************************************************** *)

type
{$IFNDEF UNICODE}
  UnicodeString = WideString;
  RawUtf8String = AnsiString;
  RawByteString = AnsiString;
{$ELSE}
  RawUtf8String = RawByteString;
{$ENDIF}
  DomainString = string;
  LanguageString = string;
  ComponentNameString = string;
  FilenameString = string;
  MsgIdString = UnicodeString;
  TranslatedUnicodeString = UnicodeString;

// Main GNU gettext functions. See documentation for instructions on how to use them.
function _(const szMsgId: MsgIdString): TranslatedUnicodeString;
function gettext(const szMsgId: MsgIdString): TranslatedUnicodeString;
function dgettext(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
function dngettext(const szDomain: DomainString; const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
function ngettext(const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
procedure textdomain(const szDomain: DomainString);
function getcurrenttextdomain: DomainString;
procedure bindtextdomain(const szDomain: DomainString; const szDirectory: FilenameString);

// Set language to use
procedure UseLanguage(LanguageCode: LanguageString);
function GetCurrentLanguage: LanguageString;

// Translates a component (form, frame etc.) to the currently selected language.
// Put TranslateComponent(self) in the OnCreate event of all your forms.
// See the manual for documentation on these functions
type
  TTranslator = procedure(obj: TObject) of object;

procedure TP_Ignore(AnObject: TObject; const name: ComponentNameString);
procedure TP_IgnoreClass(IgnClass: TClass);
procedure TP_IgnoreClassProperty(IgnClass: TClass; const propertyname: ComponentNameString);
procedure TP_GlobalIgnoreClass(IgnClass: TClass);
procedure TP_GlobalIgnoreClassProperty(IgnClass: TClass; const propertyname: ComponentNameString);
procedure TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator);
procedure TranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');
procedure RetranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');

// Add more domains that resourcestrings can be extracted from. If a translation
// is not found in the default domain, this domain will be searched, too.
// This is useful for adding mo files for certain runtime libraries and 3rd
// party component libraries
procedure AddDomainForResourceString(const domain: DomainString);
procedure RemoveDomainForResourceString(const domain: DomainString);

// Unicode-enabled way to get resourcestrings, automatically translated
// Use like this: ws:=LoadResStringW(@NameOfResourceString);
function LoadResString(ResStringRec: PResStringRec): WideString;
function LoadResStringW(ResStringRec: PResStringRec): UnicodeString;

// This returns an empty string if not translated or translator name is not specified.
function GetTranslatorNameAndEmail: TranslatedUnicodeString;

(* *************************************************************************** *)
(* *)
(* ADVANCED FUNCTIONALITY *)
(* *)
(* *************************************************************************** *)

const
  DefaultTextDomain = 'default';

var
  ExecutableFilename: FilenameString;
  // This is set to paramstr(0) or the name of the DLL you are creating.

const
  PreferExternal = false;
  // Set to true, to prefer external *.mo over embedded translation

const
  // Subversion source code version control version information
  VCSVersion = '$LastChangedRevision$';

type
  EGnuGettext = class(Exception);
  EGGProgrammingError = class(EGnuGettext);
  EGGComponentError = class(EGnuGettext);
  EGGIOError = class(EGnuGettext);
  EGGAnsi2WideConvError = class(EGnuGettext);

// This function will turn resourcestring hooks on or off, eventually with BPL file support.
  // Please do not activate BPL file support when the package is in design mode.
const
  AutoCreateHooks = true;
procedure HookIntoResourceStrings(enabled: boolean = true; SupportPackages: boolean = false);

(* *************************************************************************** *)
(* *)
(* CLASS based implementation. *)
(* Use TGnuGettextInstance to have more than one language *)
(* in your application at the same time *)
(* *)
(* *************************************************************************** *)

{$IFDEF MSWINDOWS}
{$IFNDEF DELPHI6OROLDER}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$ENDIF}
{$ENDIF}

type
  TOnDebugLine = Procedure(Sender: TObject; const Line: String; var Discard: boolean) of Object;
  // Set Discard to false if output should still go to ordinary debug log
  TGetPluralForm = function(Number: longint): Integer;
  TDebugLogger = procedure(Line: AnsiString) of object;

{ *------------------------------------------------------------------------------
    Handles .mo files, in separate files or inside the exe file.
    Don't use this class. It's for internal use.
    ------------------------------------------------------------------------------- }
  TMoFile = class
    /// Threadsafe. Only constructor and destructor are writing to memory
  private
    doswap: boolean;
  public
    Users: Integer;
    /// Reference count. If it reaches zero, this object should be destroyed.
    constructor Create(filename: FilenameString; Offset, Size: int64);
    destructor Destroy; override;
    function gettext(const msgid: RawUtf8String; var found: boolean): RawUtf8String; // uses mo file and utf-8
    property isSwappedArchitecture: boolean read doswap;
  private
    N, O, T: Cardinal;
    /// Values defined at http://www.linuxselfhelp.com/gnu/gettext/html_chapter/gettext_6.html
    startindex, startstep: Integer;
{$IFDEF mswindows}
    mo: THandle;
    momapping: THandle;
{$ENDIF}
    momemoryHandle: PAnsiChar;
    momemory: PAnsiChar;
    function autoswap32(i: Cardinal): Cardinal;
    function CardinalInMem(baseptr: PAnsiChar; Offset: Cardinal): Cardinal;
  end;

{ *------------------------------------------------------------------------------
    Handles all issues regarding a specific domain.
    Don't use this class. It's for internal use.
    ------------------------------------------------------------------------------- }
  TDomain = class
  private
    enabled: boolean;
    vDirectory: FilenameString;
    procedure setDirectory(const dir: FilenameString);
  public
    DebugLogger: TDebugLogger;
    domain: DomainString;
    property Directory: FilenameString read vDirectory write setDirectory;
    constructor Create;
    destructor Destroy; override;
    // Set parameters
    procedure SetLanguageCode(const langcode: LanguageString);
    procedure SetFilename(const filename: FilenameString);
    // Bind this domain to a specific file
    // Get information
    procedure GetListOfLanguages(list: TStrings);
    function GetTranslationProperty(propertyname: ComponentNameString): TranslatedUnicodeString;
    function gettext(const msgid: RawUtf8String): RawUtf8String;
    // uses mo file and utf-8
  private
    mofile: TMoFile;
    SpecificFilename: FilenameString;
    curlang: LanguageString;
    OpenHasFailedBefore: boolean;
    procedure OpenMoFile;
    procedure CloseMoFile;
  end;

{ *------------------------------------------------------------------------------
    Helper class for invoking events.
    ------------------------------------------------------------------------------- }
  TExecutable = class
    procedure Execute; virtual; abstract;
  end;

{ *------------------------------------------------------------------------------
    The main translation engine.
    ------------------------------------------------------------------------------- }
  TGnuGettextInstance = class
  private
    fOnDebugLine: TOnDebugLine;
    CreatorThread: Cardinal;
    /// Only this thread can use LoadResString
  public
    enabled: boolean;
    /// Set this to false to disable translations
    DesignTimeCodePage: Integer;
    /// See MultiByteToWideChar() in Win32 API for documentation
    constructor Create;
    destructor Destroy; override;
    procedure UseLanguage(LanguageCode: LanguageString);
    procedure GetListOfLanguages(const domain: DomainString; list: TStrings);
    // Puts list of language codes, for which there are translations in the specified domain, into list
{$IFNDEF UNICODE}
    function gettext(const szMsgId: AnsiString): TranslatedUnicodeString; overload; virtual;
    function ngettext(const singular, plural: AnsiString; Number: longint): TranslatedUnicodeString; overload; virtual;
{$ENDIF}
    function gettext(const szMsgId: MsgIdString): TranslatedUnicodeString; overload; virtual;
    function gettext_NoExtract(const szMsgId: MsgIdString): TranslatedUnicodeString;
    function ngettext(const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString; overload; virtual;
    function ngettext_NoExtract(const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
    function GetCurrentLanguage: LanguageString;
    function GetTranslationProperty(const propertyname: ComponentNameString): TranslatedUnicodeString;
    function GetTranslatorNameAndEmail: TranslatedUnicodeString;

// Form translation tools, these are not threadsafe. All TP_ procs must be called just before TranslateProperites()
    procedure TP_Ignore(AnObject: TObject; const name: ComponentNameString);
    procedure TP_IgnoreClass(IgnClass: TClass);
    procedure TP_IgnoreClassProperty(IgnClass: TClass; propertyname: ComponentNameString);
    procedure TP_GlobalIgnoreClass(IgnClass: TClass);
    procedure TP_GlobalIgnoreClassProperty(IgnClass: TClass; propertyname: ComponentNameString);
    procedure TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator);
    procedure TranslateProperties(AnObject: TObject; textdomain: DomainString = '');
    procedure TranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');
    procedure RetranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');

// Multi-domain functions
{$IFNDEF UNICODE}
    function dgettext(const szDomain: DomainString; const szMsgId: AnsiString): TranslatedUnicodeString; overload; virtual;
    function dngettext(const szDomain: DomainString; const singular, plural: AnsiString; Number: longint): TranslatedUnicodeString; overload; virtual;
{$ENDIF}
    function dgettext(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString; overload; virtual;
    function dgettext_NoExtract(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
    function dngettext(const szDomain: DomainString; const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
      overload; virtual;
    function dngettext_NoExtract(const szDomain: DomainString; const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
    procedure textdomain(const szDomain: DomainString);
    function getcurrenttextdomain: DomainString;
    procedure bindtextdomain(const szDomain: DomainString; const szDirectory: FilenameString);
    procedure bindtextdomainToFile(const szDomain: DomainString; const filename: FilenameString);
    // Also works with files embedded in exe file

// Windows API functions
    function LoadResString(ResStringRec: PResStringRec): UnicodeString;

// Output all log info to this file. This may only be called once.
    procedure DebugLogToFile(const filename: FilenameString; append: boolean = false);
    procedure DebugLogPause(PauseEnabled: boolean);
    property OnDebugLine: TOnDebugLine read fOnDebugLine write fOnDebugLine;
    // If set, all debug output goes here
{$IFNDEF UNICODE}
    // Conversion according to design-time character set
    function ansi2wideDTCP(const s: AnsiString): MsgIdString;
    // Convert using Design Time Code Page
{$ENDIF}
  protected
    procedure TranslateStrings(sl: TStrings; const textdomain: DomainString);

// Override these three, if you want to inherited from this class
    // to create a new class that handles other domain and language dependent
    // issues
    procedure WhenNewLanguage(const LanguageID: LanguageString); virtual;
    // Override to know when language changes
    procedure WhenNewDomain(const textdomain: DomainString); virtual;
    // Override to know when text domain changes. Directory is purely informational
    procedure WhenNewDomainDirectory(const textdomain: DomainString; const Directory: FilenameString); virtual;
    // Override to know when any text domain's directory changes. It won't be called if a domain is fixed to a specific file.
  private
    curlang: LanguageString;
    curGetPluralForm: TGetPluralForm;
    curmsgdomain: DomainString;
    savefileCS: TMultiReadExclusiveWriteSynchronizer;
    savefile: TextFile;
    savememory: TStringList;
    DefaultDomainDirectory: FilenameString;
    domainlist: TStringList;
    /// List of domain names. Objects are TDomain.
    TP_IgnoreList: TStringList;
    /// Temporary list, reset each time TranslateProperties is called
    TP_ClassHandling: TList;
    /// Items are TClassMode. If a is derived from b, a comes first
    TP_GlobalClassHandling: TList;
    /// Items are TClassMode. If a is derived from b, a comes first
    TP_Retranslator: TExecutable;
    /// Cast this to TTP_Retranslator
{$IFDEF DXGETTEXTDEBUG}
    DebugLogCS: TMultiReadExclusiveWriteSynchronizer;
    DebugLog: TStream;
    DebugLogOutputPaused: boolean;
{$ENDIF}
    function TP_CreateRetranslator: TExecutable; // Must be freed by caller!
    procedure FreeTP_ClassHandlingItems;
{$IFDEF DXGETTEXTDEBUG}
    procedure DebugWriteln(Line: AnsiString);
{$ENDIF}
    procedure TranslateProperty(AnObject: TObject; PropInfo: PPropInfo; TodoList: TStrings; const textdomain: DomainString);
    function Getdomain(const domain: DomainString; const DefaultDomainDirectory: FilenameString; const curlang: LanguageString): TDomain;
    // Translates a single property of an object
  end;

const
  LOCALE_SISO639LANGNAME = $59; // Used by Lazarus software development tool
  LOCALE_SISO3166CTRYNAME = $5A; // Used by Lazarus software development tool

var
  DefaultInstance: TGnuGettextInstance;
  /// Default instance of the main API for singlethreaded applications.

implementation

{$IFNDEF MSWINDOWS}
{$IFNDEF LINUX}
  'This version of gnugettext.pas is only meant to be compiled with Kylix 3,'
  'Delphi 6, Delphi 7 and later versions. If you use other versions, please' 'get the gnugettext.pas version from the Delphi 5 directory.'
{$ENDIF}
{$ENDIF}
(* ************************************************************************ *)
// Some comments on the implementation:
// This unit should be independent of other units where possible.
// It should have a small footprint in any way.
(* ************************************************************************ *)
// TMultiReadExclusiveWriteSynchronizer is used instead of TCriticalSection
// because it makes this unit independent of the SyncObjs unit
(* ************************************************************************ *)

{$B-,R+,I+,Q+}
  type TTP_RetranslatorItem = class obj: TObject;
Propname:
ComponentNameString;
OldValue:
TranslatedUnicodeString;
end;
TTP_Retranslator = class(TExecutable)textdomain: DomainString;
Instance:
TGnuGettextInstance;

constructor Create;
  destructor Destroy; override;
    procedure Remember(obj: TObject; Propname: ComponentNameString; OldValue: TranslatedUnicodeString);
      procedure Execute; override;
      private
        list: TList;
        end;
        TEmbeddedFileInfo = class Offset, Size: int64;
        end;
        TFileLocator = class
        // This class finds files even when embedded inside executable
          constructor Create;
        destructor Destroy;
        override;
        procedure Analyze; // List files embedded inside executable
        function FileExists(filename: FilenameString): boolean;
        function GetMoFile(filename: FilenameString; DebugLogger: TDebugLogger): TMoFile;
        procedure ReleaseMoFile(mofile: TMoFile);
      private
        basedirectory: FilenameString;
        filelist: TStringList;
        // Objects are TEmbeddedFileInfo. Filenames are relative to .exe file
        MoFilesCS: TMultiReadExclusiveWriteSynchronizer;
        MoFiles: TStringList;
        // Objects are filenames+offset, objects are TMoFile
        function ReadInt64(str: TStream): int64;
        end;
        TGnuGettextComponentMarker = class(TComponent)public LastLanguage: LanguageString;
        Retranslator: TExecutable;
        destructor Destroy;
        override;
        end;
        TClassMode = class HClass: TClass;
        SpecialHandler: TTranslator;
        PropertiesToIgnore: TStringList; // This is ignored if Handler is set
        constructor Create;
        destructor Destroy;
        override;
        end;
        TRStrinfo = record strlength, stroffset: Cardinal;
        end;
        TStrInfoArr = array [0 .. 10000000] of TRStrinfo;
        PStrInfoArr = ^TStrInfoArr;
        TCharArray5 = array [0 .. 4] of ansichar;
        THook = // Replaces a runtime library procedure with a custom procedure
          class public constructor Create(OldProcedure, NewProcedure: pointer; FollowJump: boolean = false);
        destructor Destroy;
        override; // Restores unhooked state
        procedure Reset(FollowJump: boolean = false);
        // Disables and picks up patch points again
        procedure Disable;
        procedure Enable;
      private
        oldproc, newproc: pointer;
        Patch: TCharArray5;
        Original: TCharArray5;
        PatchPosition: PAnsiChar;
        procedure Shutdown;
        // Same as destroy, except that object is not destroyed
        end;

var
        // System information
        Win32PlatformIsUnicode: boolean = false;

// Information about files embedded inside .exe file
        FileLocator: TFileLocator;

// Hooks into runtime library functions
        ResourceStringDomainListCS: TMultiReadExclusiveWriteSynchronizer;
        ResourceStringDomainList: TStringList;
        HookLoadResString: THook;
        HookLoadStr: THook;
        HookFmtLoadStr: THook;

function GGGetEnvironmentVariable(const name: WideString): WideString;
        var
          Len: Integer;
          W: WideString;
        begin
          Result := '';
          SetLength(W, 1);
          Len := Windows.GetEnvironmentVariableW(PWideChar(Name), PWideChar(W), 1);
          if Len > 0 then
          begin
            SetLength(Result, Len - 1);
            Windows.GetEnvironmentVariableW(PWideChar(Name), PWideChar(Result), Len);
          end;
        end;

function StripCRRawMsgId(s: RawUtf8String): RawUtf8String;
        var
          i: Integer;
        begin
          i := 1;
          while i <= length(s) do
          begin
            if s[i] = #13 then
              delete(s, i, 1)
            else
              inc(i);
          end;
          Result := s;
        end;

function IsWriteProp(Info: PPropInfo): boolean;
        begin
          Result := Assigned(Info) and (Info^.SetProc <> nil);
        end;

function ResourceStringGettext(msgid: MsgIdString): TranslatedUnicodeString;
        var
          i: Integer;
        begin
          if (msgid = '') or (ResourceStringDomainListCS = nil) then
          begin
            // This only happens during very complicated program startups that fail,
            // or when Msgid=''
            Result := msgid;
            exit;
          end;
          ResourceStringDomainListCS.BeginRead;
          try
            for i := 0 to ResourceStringDomainList.Count - 1 do
            begin
              Result := dgettext(ResourceStringDomainList.Strings[i], msgid);
              if Result <> msgid then
                break;
            end;
          finally
            ResourceStringDomainListCS.EndRead;
          end;
        end;

function gettext(const szMsgId: MsgIdString): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.gettext(szMsgId);
        end;

{ *------------------------------------------------------------------------------
        This is the main translation procedure used in programs. It takes a parameter,
        looks it up in the translation dictionary, and returns the translation.
        If no translation is found, the parameter is returned.

@param szMsgId The text, that should be displayed if no translation is found.
        ------------------------------------------------------------------------------- }
        function _(const szMsgId: MsgIdString): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.gettext(szMsgId);
        end;

{ *------------------------------------------------------------------------------
        Translates a text, using a specified translation domain.
        If no translation is found, the parameter is returned.

@param szDomain Which translation domain that should be searched for a translation.
        @param szMsgId The text, that should be displayed if no translation is found.
        ------------------------------------------------------------------------------- }
        function dgettext(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.dgettext(szDomain, szMsgId);
        end;

function dngettext(const szDomain: DomainString; const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.dngettext(szDomain, singular, plural, Number);
        end;

function ngettext(const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.ngettext(singular, plural, Number);
        end;

procedure textdomain(const szDomain: DomainString);
        begin
          DefaultInstance.textdomain(szDomain);
        end;

procedure SetGettextEnabled(enabled: boolean);
        begin
          DefaultInstance.enabled := enabled;
        end;

function getcurrenttextdomain: DomainString;
        begin
          Result := DefaultInstance.getcurrenttextdomain;
        end;

procedure bindtextdomain(const szDomain: DomainString; const szDirectory: FilenameString);
        begin
          DefaultInstance.bindtextdomain(szDomain, szDirectory);
        end;

procedure TP_Ignore(AnObject: TObject; const name: FilenameString);
        begin
          DefaultInstance.TP_Ignore(AnObject, name);
        end;

procedure TP_GlobalIgnoreClass(IgnClass: TClass);
        begin
          DefaultInstance.TP_GlobalIgnoreClass(IgnClass);
        end;

procedure TP_IgnoreClass(IgnClass: TClass);
        begin
          DefaultInstance.TP_IgnoreClass(IgnClass);
        end;

procedure TP_IgnoreClassProperty(IgnClass: TClass; const propertyname: ComponentNameString);
        begin
          DefaultInstance.TP_IgnoreClassProperty(IgnClass, propertyname);
        end;

procedure TP_GlobalIgnoreClassProperty(IgnClass: TClass; const propertyname: ComponentNameString);
        begin
          DefaultInstance.TP_GlobalIgnoreClassProperty(IgnClass, propertyname);
        end;

procedure TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator);
        begin
          DefaultInstance.TP_GlobalHandleClass(HClass, Handler);
        end;

procedure TranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');
        begin
          DefaultInstance.TranslateComponent(AnObject, textdomain);
        end;

procedure RetranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');
        begin
          DefaultInstance.RetranslateComponent(AnObject, textdomain);
        end;

{$IFDEF MSWINDOWS}

// These constants are only used in Windows 95
      // Thanks to Frank Andreas de Groot for this table
      const
        IDAfrikaans = $0436;
        IDAlbanian = $041C;
        IDArabicAlgeria = $1401;
        IDArabicBahrain = $3C01;
        IDArabicEgypt = $0C01;
        IDArabicIraq = $0801;
        IDArabicJordan = $2C01;
        IDArabicKuwait = $3401;
        IDArabicLebanon = $3001;
        IDArabicLibya = $1001;
        IDArabicMorocco = $1801;
        IDArabicOman = $2001;
        IDArabicQatar = $4001;
        IDArabic = $0401;
        IDArabicSyria = $2801;
        IDArabicTunisia = $1C01;
        IDArabicUAE = $3801;
        IDArabicYemen = $2401;
        IDArmenian = $042B;
        IDAssamese = $044D;
        IDAzeriCyrillic = $082C;
        IDAzeriLatin = $042C;
        IDBasque = $042D;
        IDByelorussian = $0423;
        IDBengali = $0445;
        IDBulgarian = $0402;
        IDBurmese = $0455;
        IDCatalan = $0403;
        IDChineseHongKong = $0C04;
        IDChineseMacao = $1404;
        IDSimplifiedChinese = $0804;
        IDChineseSingapore = $1004;
        IDTraditionalChinese = $0404;
        IDCroatian = $041A;
        IDCzech = $0405;
        IDDanish = $0406;
        IDBelgianDutch = $0813;
        IDDutch = $0413;
        IDEnglishAUS = $0C09;
        IDEnglishBelize = $2809;
        IDEnglishCanadian = $1009;
        IDEnglishCaribbean = $2409;
        IDEnglishIreland = $1809;
        IDEnglishJamaica = $2009;
        IDEnglishNewZealand = $1409;
        IDEnglishPhilippines = $3409;
        IDEnglishSouthAfrica = $1C09;
        IDEnglishTrinidad = $2C09;
        IDEnglishUK = $0809;
        IDEnglishUS = $0409;
        IDEnglishZimbabwe = $3009;
        IDEstonian = $0425;
        IDFaeroese = $0438;
        IDFarsi = $0429;
        IDFinnish = $040B;
        IDBelgianFrench = $080C;
        IDFrenchCameroon = $2C0C;
        IDFrenchCanadian = $0C0C;
        IDFrenchCotedIvoire = $300C;
        IDFrench = $040C;
        IDFrenchLuxembourg = $140C;
        IDFrenchMali = $340C;
        IDFrenchMonaco = $180C;
        IDFrenchReunion = $200C;
        IDFrenchSenegal = $280C;
        IDSwissFrench = $100C;
        IDFrenchWestIndies = $1C0C;
        IDFrenchZaire = $240C;
        IDFrisianNetherlands = $0462;
        IDGaelicIreland = $083C;
        IDGaelicScotland = $043C;
        IDGalician = $0456;
        IDGeorgian = $0437;
        IDGermanAustria = $0C07;
        IDGerman = $0407;
        IDGermanLiechtenstein = $1407;
        IDGermanLuxembourg = $1007;
        IDSwissGerman = $0807;
        IDGreek = $0408;
        IDGujarati = $0447;
        IDHebrew = $040D;
        IDHindi = $0439;
        IDHungarian = $040E;
        IDIcelandic = $040F;
        IDIndonesian = $0421;
        IDItalian = $0410;
        IDSwissItalian = $0810;
        IDJapanese = $0411;
        IDKannada = $044B;
        IDKashmiri = $0460;
        IDKazakh = $043F;
        IDKhmer = $0453;
        IDKirghiz = $0440;
        IDKonkani = $0457;
        IDKorean = $0412;
        IDLao = $0454;
        IDLatvian = $0426;
        IDLithuanian = $0427;
        IDMacedonian = $042F;
        IDMalaysian = $043E;
        IDMalayBruneiDarussalam = $083E;
        IDMalayalam = $044C;
        IDMaltese = $043A;
        IDManipuri = $0458;
        IDMarathi = $044E;
        IDMongolian = $0450;
        IDNepali = $0461;
        IDNorwegianBokmol = $0414;
        IDNorwegianNynorsk = $0814;
        IDOriya = $0448;
        IDPolish = $0415;
        IDBrazilianPortuguese = $0416;
        IDPortuguese = $0816;
        IDPunjabi = $0446;
        IDRhaetoRomanic = $0417;
        IDRomanianMoldova = $0818;
        IDRomanian = $0418;
        IDRussianMoldova = $0819;
        IDRussian = $0419;
        IDSamiLappish = $043B;
        IDSanskrit = $044F;
        IDSerbianCyrillic = $0C1A;
        IDSerbianLatin = $081A;
        IDSesotho = $0430;
        IDSindhi = $0459;
        IDSlovak = $041B;
        IDSlovenian = $0424;
        IDSorbian = $042E;
        IDSpanishArgentina = $2C0A;
        IDSpanishBolivia = $400A;
        IDSpanishChile = $340A;
        IDSpanishColombia = $240A;
        IDSpanishCostaRica = $140A;
        IDSpanishDominicanRepublic = $1C0A;
        IDSpanishEcuador = $300A;
        IDSpanishElSalvador = $440A;
        IDSpanishGuatemala = $100A;
        IDSpanishHonduras = $480A;
        IDMexicanSpanish = $080A;
        IDSpanishNicaragua = $4C0A;
        IDSpanishPanama = $180A;
        IDSpanishParaguay = $3C0A;
        IDSpanishPeru = $280A;
        IDSpanishPuertoRico = $500A;
        IDSpanishModernSort = $0C0A;
        IDSpanish = $040A;
        IDSpanishUruguay = $380A;
        IDSpanishVenezuela = $200A;
        IDSutu = $0430;
        IDSwahili = $0441;
        IDSwedishFinland = $081D;
        IDSwedish = $041D;
        IDTajik = $0428;
        IDTamil = $0449;
        IDTatar = $0444;
        IDTelugu = $044A;
        IDThai = $041E;
        IDTibetan = $0451;
        IDTsonga = $0431;
        IDTswana = $0432;
        IDTurkish = $041F;
        IDTurkmen = $0442;
        IDUkrainian = $0422;
        IDUrdu = $0420;
        IDUzbekCyrillic = $0843;
        IDUzbekLatin = $0443;
        IDVenda = $0433;
        IDVietnamese = $042A;
        IDWelsh = $0452;
        IDXhosa = $0434;
        IDZulu = $0435;

function GetWindowsLanguage: WideString;
        var
          langid: Cardinal;
          langcode: WideString;
          CountryName: array [0 .. 4] of widechar;
          LanguageName: array [0 .. 4] of widechar;
          works: boolean;
        begin
          // The return value of GetLocaleInfo is compared with 3 = 2 characters and a zero
          works := 3 = GetLocaleInfoW(LOCALE_USER_DEFAULT, LOCALE_SISO639LANGNAME, LanguageName, SizeOf(LanguageName));
          works := works and (3 = GetLocaleInfoW(LOCALE_USER_DEFAULT, LOCALE_SISO3166CTRYNAME, CountryName, SizeOf(CountryName)));
          if works then
          begin
            // Windows 98, Me, NT4, 2000, XP and newer
            langcode := PWideChar(@(LanguageName[0]));
            if lowercase(langcode) = 'no' then
              langcode := 'nb';
            langcode := langcode + '_' + PWideChar(@CountryName[0]);
          end
          else
          begin
            // This part should only happen on Windows 95.
            langid := GetThreadLocale;
            case langid of
              IDBelgianDutch:
                langcode := 'nl_BE';
              IDBelgianFrench:
                langcode := 'fr_BE';
              IDBrazilianPortuguese:
                langcode := 'pt_BR';
              IDDanish:
                langcode := 'da_DK';
              IDDutch:
                langcode := 'nl_NL';
              IDEnglishUK:
                langcode := 'en_GB';
              IDEnglishUS:
                langcode := 'en_US';
              IDFinnish:
                langcode := 'fi_FI';
              IDFrench:
                langcode := 'fr_FR';
              IDFrenchCanadian:
                langcode := 'fr_CA';
              IDGerman:
                langcode := 'de_DE';
              IDGermanLuxembourg:
                langcode := 'de_LU';
              IDGreek:
                langcode := 'el_GR';
              IDIcelandic:
                langcode := 'is_IS';
              IDItalian:
                langcode := 'it_IT';
              IDKorean:
                langcode := 'ko_KO';
              IDNorwegianBokmol:
                langcode := 'nb_NO';
              IDNorwegianNynorsk:
                langcode := 'nn_NO';
              IDPolish:
                langcode := 'pl_PL';
              IDPortuguese:
                langcode := 'pt_PT';
              IDRussian:
                langcode := 'ru_RU';
              IDSpanish, IDSpanishModernSort:
                langcode := 'es_ES';
              IDSwedish:
                langcode := 'sv_SE';
              IDSwedishFinland:
                langcode := 'sv_FI';
            else
              langcode := 'C';
            end;
          end;
          Result := langcode;
        end;
{$ENDIF}
{$IFNDEF UNICODE}
        function LoadResStringA(ResStringRec: PResStringRec): AnsiString;
        begin
          Result := DefaultInstance.LoadResString(ResStringRec);
        end;
{$ENDIF}
        function GetTranslatorNameAndEmail: TranslatedUnicodeString;
        begin
          Result := DefaultInstance.GetTranslatorNameAndEmail;
        end;

procedure UseLanguage(LanguageCode: LanguageString);
        begin
          DefaultInstance.UseLanguage(LanguageCode);
        end;

type
        PStrData = ^TStrData;

TStrData = record
          Ident: Integer;
          str: String;
        end;

var
        rs: TResStringRec;
        Module: HModule;
      begin
        Module := Instance;
        rs.Module := @Module;
        with PStrData(Data)^ do
        begin
          rs.Identifier := Ident;
          str := System.LoadResString(@rs);
          Result := str = '';
        end;
      end;
{$ENDIF}
      function SysUtilsFindStringResource(Ident: Integer): string;
      var
        StrData: TStrData;
      begin
        StrData.Ident := Ident;
        StrData.str := '';
        EnumResourceModules(SysUtilsEnumStringModules, @StrData);
        Result := StrData.str;
      end;

function SysUtilsLoadStr(Ident: Integer): string;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DefaultInstance.DebugWriteln('Sysutils.LoadRes(' + IntToStr(Ident) + ') called');
{$ENDIF}
        Result := ResourceStringGettext(SysUtilsFindStringResource(Ident));
      end;

function SysUtilsFmtLoadStr(Ident: Integer; const Args: array of const): string;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DefaultInstance.DebugWriteln('Sysutils.FmtLoadRes(' + IntToStr(Ident) + ',Args) called');
{$ENDIF}
        FmtStr(Result, ResourceStringGettext(SysUtilsFindStringResource(Ident)), Args);
      end;

function LoadResString(ResStringRec: PResStringRec): WideString;
      begin
        Result := DefaultInstance.LoadResString(ResStringRec);
      end;

function LoadResStringW(ResStringRec: PResStringRec): UnicodeString;
      begin
        Result := DefaultInstance.LoadResString(ResStringRec);
      end;

function GetCurrentLanguage: LanguageString;
      begin
        Result := DefaultInstance.GetCurrentLanguage;
      end;

{ TDomain }

procedure TDomain.CloseMoFile;
      begin
        if mofile <> nil then
        begin
          FileLocator.ReleaseMoFile(mofile);
          mofile := nil;
        end;
        OpenHasFailedBefore := false;
      end;

destructor TDomain.Destroy;
      begin
        CloseMoFile;
        inherited;
      end;

{$IFDEF mswindows}
      function GetLastWinError: WideString;
      var
        errcode: Cardinal;
      begin
        SetLength(Result, 2000);
        errcode := GetLastError();
        Windows.FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM, nil, errcode, 0, PWideChar(Result), 2000, nil);
        Result := PWideChar(Result);
      end;
{$ENDIF}
      procedure TDomain.OpenMoFile;
      var
        filename: FilenameString;
      begin
        // Check if it is already open
        if mofile <> nil then
          exit;

// Check if it has been attempted to open the file before
        if OpenHasFailedBefore then
          exit;

if SpecificFilename <> '' then
        begin
          filename := SpecificFilename;
{$IFDEF DXGETTEXTDEBUG}
          DebugLogger('Domain ' + domain + ' is bound to specific file ' + filename);
{$ENDIF}
        end
        else
        begin
          filename := Directory + curlang + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
          if (not FileLocator.FileExists(filename)) and (not FileExists(filename)) then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugLogger('Domain ' + domain + ': File does not exist, neither embedded or in file system: ' + filename);
{$ENDIF}
            filename := Directory + MidStr(curlang, 1, 2) + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
{$IFDEF DXGETTEXTDEBUG}
            DebugLogger('Domain ' + domain + ' will attempt to use this file: ' + filename);
{$ENDIF}
          end
          else
          begin
{$IFDEF DXGETTEXTDEBUG}
            if FileLocator.FileExists(filename) then
              DebugLogger('Domain ' + domain + ' will attempt to use this embedded file: ' + filename)
            else
              DebugLogger('Domain ' + domain + ' will attempt to use this file that was found on the file system: ' + filename);
{$ENDIF}
          end;
        end;
        if (not FileLocator.FileExists(filename)) and (not FileExists(filename)) then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugLogger('Domain ' + domain + ' failed to locate the file: ' + filename);
{$ENDIF}
          OpenHasFailedBefore := true;
          exit;
        end;
{$IFDEF DXGETTEXTDEBUG}
        DebugLogger('Domain ' + domain + ' now accesses the file.');
{$ENDIF}
        mofile := FileLocator.GetMoFile(filename, DebugLogger);

{$IFDEF DXGETTEXTDEBUG}
        if mofile.isSwappedArchitecture then
          DebugLogger('.mo file is swapped (comes from another CPU architecture)');
{$ENDIF}
        // Check, that the contents of the file is utf-8
        if pos('CHARSET=UTF-8', uppercase(GetTranslationProperty('Content-Type'))) = 0 then
        begin
          CloseMoFile;
{$IFDEF DXGETTEXTDEBUG}
          DebugLogger('The translation for the language code ' + curlang + ' (in ' + filename +
            ') does not have charset=utf-8 in its Content-Type. Translations are turned off.');
{$ENDIF}
{$IFDEF MSWINDOWS}
          MessageBoxW(0, PWideChar(WideString('The translation for the language code ' + curlang + ' (in ' + filename +
            ') does not have charset=utf-8 in its Content-Type. Translations are turned off.')), 'Localization problem', MB_OK);
{$ELSE}
          writeln(stderr, 'The translation for the language code ' + curlang + ' (in ' + filename +
            ') does not have charset=utf-8 in its Content-Type. Translations are turned off.');
{$ENDIF}
          enabled := false;
        end;
      end;

{$IFDEF UNICODE}
      function utf8decode(s: RawByteString): UnicodeString; inline;
      begin
        Result := UTF8ToWideString(s);
      end;
{$ENDIF}
      function TDomain.GetTranslationProperty(propertyname: ComponentNameString): TranslatedUnicodeString;
      var
        sl: TStringList;
        i: Integer;
        s: string;
      begin
        propertyname := uppercase(propertyname) + ': ';
        sl := TStringList.Create;
        try
          sl.Text := utf8decode(gettext(''));
          for i := 0 to sl.Count - 1 do
          begin
            s := sl.Strings[i];
            if uppercase(MidStr(s, 1, length(propertyname))) = propertyname then
            begin
              Result := trim(MidStr(s, length(propertyname) + 1, maxint));

{$IFDEF DXGETTEXTDEBUG}
              DebugLogger('GetTranslationProperty(' + propertyname + ') returns ''' + Result + '''.');
{$ENDIF}
              exit;
            end;
          end;
        finally
          FreeAndNil(sl);
        end;
        Result := '';
{$IFDEF DXGETTEXTDEBUG}
        DebugLogger('GetTranslationProperty(' + propertyname + ') did not find any value. An empty string is returned.');
{$ENDIF}
      end;

procedure TDomain.setDirectory(const dir: FilenameString);
      begin
        vDirectory := IncludeTrailingPathDelimiter(dir);
        SpecificFilename := '';
        CloseMoFile;
      end;

procedure AddDomainForResourceString(const domain: DomainString);
      begin
{$IFDEF DXGETTEXTDEBUG}
        DefaultInstance.DebugWriteln('Extra domain for resourcestring: ' + domain);
{$ENDIF}
        ResourceStringDomainListCS.BeginWrite;
        try
          if ResourceStringDomainList.IndexOf(domain) = -1 then
            ResourceStringDomainList.Add(domain);
        finally
          ResourceStringDomainListCS.EndWrite;
        end;
      end;

procedure RemoveDomainForResourceString(const domain: DomainString);
      var
        i: Integer;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DefaultInstance.DebugWriteln('Remove domain for resourcestring: ' + domain);
{$ENDIF}
        ResourceStringDomainListCS.BeginWrite;
        try
          i := ResourceStringDomainList.IndexOf(domain);
          if i <> -1 then
            ResourceStringDomainList.delete(i);
        finally
          ResourceStringDomainListCS.EndWrite;
        end;
      end;

procedure TDomain.SetLanguageCode(const langcode: LanguageString);
      begin
        CloseMoFile;
        curlang := langcode;
      end;

function GetPluralForm2EN(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if Number = 1 then
          Result := 0
        else
          Result := 1;
      end;

function GetPluralForm1(Number: Integer): Integer;
      begin
        Result := 0;
      end;

function GetPluralForm2FR(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if (Number = 1) or (Number = 0) then
          Result := 0
        else
          Result := 1;
      end;

function GetPluralForm3LV(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if (Number mod 10 = 1) and (Number mod 100 <> 11) then
          Result := 0
        else if Number <> 0 then
          Result := 1
        else
          Result := 2;
      end;

function GetPluralForm3GA(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if Number = 1 then
          Result := 0
        else if Number = 2 then
          Result := 1
        else
          Result := 2;
      end;

function GetPluralForm3LT(Number: Integer): Integer;
      var
        n1, n2: byte;
      begin
        Number := abs(Number);
        n1 := Number mod 10;
        n2 := Number mod 100;
        if (n1 = 1) and (n2 <> 11) then
          Result := 0
        else if (n1 >= 2) and ((n2 < 10) or (n2 >= 20)) then
          Result := 1
        else
          Result := 2;
      end;

function GetPluralForm3PL(Number: Integer): Integer;
      var
        n1, n2: byte;
      begin
        Number := abs(Number);
        n1 := Number mod 10;
        n2 := Number mod 100;

if Number = 1 then
          Result := 0
        else if (n1 >= 2) and (n1 <= 4) and ((n2 < 10) or (n2 >= 20)) then
          Result := 1
        else
          Result := 2;
      end;

function GetPluralForm3RU(Number: Integer): Integer;
      var
        n1, n2: byte;
      begin
        Number := abs(Number);
        n1 := Number mod 10;
        n2 := Number mod 100;
        if (n1 = 1) and (n2 <> 11) then
          Result := 0
        else if (n1 >= 2) and (n1 <= 4) and ((n2 < 10) or (n2 >= 20)) then
          Result := 1
        else
          Result := 2;
      end;

function GetPluralForm3SK(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if Number = 1 then
          Result := 0
        else if (Number < 5) and (Number <> 0) then
          Result := 1
        else
          Result := 2;
      end;

function GetPluralForm4SL(Number: Integer): Integer;
      var
        n2: byte;
      begin
        Number := abs(Number);
        n2 := Number mod 100;
        if n2 = 1 then
          Result := 0
        else if n2 = 2 then
          Result := 1
        else if (n2 = 3) or (n2 = 4) then
          Result := 2
        else
          Result := 3;
      end;

procedure TDomain.GetListOfLanguages(list: TStrings);
      var
        sr: TSearchRec;
        more: boolean;
        filename, path: FilenameString;
        langcode: LanguageString;
        i, j: Integer;
      begin
        list.Clear;

// Iterate through filesystem
        more := FindFirst(Directory + '*', faAnyFile, sr) = 0;
        try
          while more do
          begin
            if (sr.Attr and faDirectory <> 0) and (sr.name <> '.') and (sr.name <> '..') then
            begin
              filename := Directory + sr.name + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
              if FileExists(filename) then
              begin
                langcode := lowercase(sr.name);
                if list.IndexOf(langcode) = -1 then
                  list.Add(langcode);
              end;
            end;
            more := FindNext(sr) = 0;
          end;
        finally
          FindClose(sr);
        end;

// Iterate through embedded files
        for i := 0 to FileLocator.filelist.Count - 1 do
        begin
          filename := FileLocator.basedirectory + FileLocator.filelist.Strings[i];
          path := Directory;
{$IFDEF MSWINDOWS}
          path := uppercase(path);
          filename := uppercase(filename);
{$ENDIF}
          j := length(path);
          if MidStr(filename, 1, j) = path then
          begin
            path := PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
{$IFDEF MSWINDOWS}
            path := uppercase(path);
{$ENDIF}
            if MidStr(filename, length(filename) - length(path) + 1, length(path)) = path then
            begin
              langcode := lowercase(MidStr(filename, j + 1, length(filename) - length(path) - j));
              langcode := LeftStr(langcode, 3) + uppercase(MidStr(langcode, 4, maxint));
              if list.IndexOf(langcode) = -1 then
                list.Add(langcode);
            end;
          end;
        end;
      end;

procedure TDomain.SetFilename(const filename: FilenameString);
      begin
        CloseMoFile;
        vDirectory := '';
        SpecificFilename := filename;
      end;

function TDomain.gettext(const msgid: RawUtf8String): RawUtf8String;
      var
        found: boolean;
      begin
        if not enabled then
        begin
          Result := msgid;
          exit;
        end;
        if (mofile = nil) and (not OpenHasFailedBefore) then
          OpenMoFile;
        if mofile = nil then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugLogger('.mo file is not open. Not translating "' + msgid + '"');
{$ENDIF}
          Result := msgid;
        end
        else
        begin
          Result := mofile.gettext(msgid, found);
{$IFDEF DXGETTEXTDEBUG}
          if found then
            DebugLogger('Found in .mo (' + domain + '): "' + utf8encode(msgid) + '"->"' + utf8encode(Result) + '"')
          else
            DebugLogger('Translation not found in .mo file (' + domain + ') : "' + utf8encode(msgid) + '"');
{$ENDIF}
        end;
      end;

constructor TDomain.Create;
      begin
        inherited Create;
        enabled := true;
      end;

{ TGnuGettextInstance }

procedure TGnuGettextInstance.bindtextdomain(const szDomain: DomainString; const szDirectory: FilenameString);
      var
        dir: FilenameString;
      begin
        dir := IncludeTrailingPathDelimiter(szDirectory);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Text domain "' + szDomain + '" is now located at "' + dir + '"');
{$ENDIF}
        Getdomain(szDomain, DefaultDomainDirectory, curlang).Directory := dir;
        WhenNewDomainDirectory(szDomain, szDirectory);
      end;

constructor TGnuGettextInstance.Create;
      begin
        CreatorThread := GetCurrentThreadId;
{$IFDEF MSWindows}
        DesignTimeCodePage := CP_ACP;
{$ENDIF}
{$IFDEF DXGETTEXTDEBUG}
        DebugLogCS := TMultiReadExclusiveWriteSynchronizer.Create;
        DebugLog := TMemoryStream.Create;
        DebugWriteln('Debug log started ' + DateTimeToStr(Now));
        DebugWriteln('GNU gettext module version: ' + VCSVersion);
        DebugWriteln('');
{$ENDIF}
        curGetPluralForm := GetPluralForm2EN;
        enabled := true;
        curmsgdomain := DefaultTextDomain;
        savefileCS := TMultiReadExclusiveWriteSynchronizer.Create;
        domainlist := TStringList.Create;
        TP_IgnoreList := TStringList.Create;
        TP_IgnoreList.Sorted := true;
        TP_GlobalClassHandling := TList.Create;
        TP_ClassHandling := TList.Create;

// Set some settings
        DefaultDomainDirectory := IncludeTrailingPathDelimiter(extractfilepath(ExecutableFilename)) + 'locale';

UseLanguage('');

bindtextdomain(DefaultTextDomain, DefaultDomainDirectory);
        textdomain(DefaultTextDomain);

// Add default properties to ignore
        TP_GlobalIgnoreClassProperty(TComponent, 'Name');
        TP_GlobalIgnoreClassProperty(TCollection, 'PropName');
      end;

destructor TGnuGettextInstance.Destroy;
      begin
        if savememory <> nil then
        begin
          savefileCS.BeginWrite;
          try
            CloseFile(savefile);
          finally
            savefileCS.EndWrite;
          end;
          FreeAndNil(savememory);
        end;
        FreeAndNil(savefileCS);
        FreeAndNil(TP_IgnoreList);
        while TP_GlobalClassHandling.Count <> 0 do
        begin
          TObject(TP_GlobalClassHandling.Items[0]).Free;
          TP_GlobalClassHandling.delete(0);
        end;
        FreeAndNil(TP_GlobalClassHandling);
        FreeTP_ClassHandlingItems;
        FreeAndNil(TP_ClassHandling);
        while domainlist.Count <> 0 do
        begin
          domainlist.Objects[0].Free;
          domainlist.delete(0);
        end;
        FreeAndNil(domainlist);
{$IFDEF DXGETTEXTDEBUG}
        FreeAndNil(DebugLog);
        FreeAndNil(DebugLogCS);
{$ENDIF}
        inherited;
      end;

{$IFNDEF UNICODE}
      function TGnuGettextInstance.dgettext(const szDomain: DomainString; const szMsgId: AnsiString): TranslatedUnicodeString;
      begin
        Result := dgettext(szDomain, ansi2wideDTCP(szMsgId));
      end;
{$ENDIF}
      function TGnuGettextInstance.dgettext(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
      begin
        if not enabled then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Translation has been disabled. Text is not being translated: ' + szMsgId);
{$ENDIF}
          Result := szMsgId;
        end
        else
        begin
          Result := utf8decode(EnsureLineBreakInTranslatedString(Getdomain(szDomain, DefaultDomainDirectory, curlang)
            .gettext(StripCRRawMsgId(utf8encode(szMsgId)))));

{$IFDEF DXGETTEXTDEBUG}
          if (szMsgId <> '') and (Result = '') then
            DebugWriteln(Format('Error: Translation of %s was an empty string. This may never occur.', [szMsgId]));
{$ENDIF}
        end;
      end;

function TGnuGettextInstance.dgettext_NoExtract(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
      begin
        // This one is very useful for translating text in variables.
        // This can sometimes be necessary, and by using this function,
        // the source code scanner will not trigger warnings.
        Result := dgettext(szDomain, szMsgId);
      end;

function TGnuGettextInstance.GetCurrentLanguage: LanguageString;
      begin
        Result := curlang;
      end;

function TGnuGettextInstance.getcurrenttextdomain: DomainString;
      begin
        Result := curmsgdomain;
      end;

{$IFNDEF UNICODE}
      function TGnuGettextInstance.gettext(const szMsgId: AnsiString): TranslatedUnicodeString;
      begin
        Result := dgettext(curmsgdomain, szMsgId);
      end;
{$ENDIF}
      function TGnuGettextInstance.gettext(const szMsgId: MsgIdString): TranslatedUnicodeString;
      begin
        Result := dgettext(curmsgdomain, szMsgId);
      end;

function TGnuGettextInstance.gettext_NoExtract(const szMsgId: MsgIdString): TranslatedUnicodeString;
      begin
        // This one is very useful for translating text in variables.
        // This can sometimes be necessary, and by using this function,
        // the source code scanner will not trigger warnings.
        Result := gettext(szMsgId);
      end;

procedure TGnuGettextInstance.textdomain(const szDomain: DomainString);
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Changed text domain to "' + szDomain + '"');
{$ENDIF}
        curmsgdomain := szDomain;
        WhenNewDomain(szDomain);
      end;

function TGnuGettextInstance.TP_CreateRetranslator: TExecutable;
      var
        ttpr: TTP_Retranslator;
      begin
        ttpr := TTP_Retranslator.Create;
        ttpr.Instance := self;
        TP_Retranslator := ttpr;
        Result := ttpr;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('A retranslator was created.');
{$ENDIF}
      end;

procedure TGnuGettextInstance.TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator);
      var
        cm: TClassMode;
        i: Integer;
      begin
        for i := 0 to TP_GlobalClassHandling.Count - 1 do
        begin
          cm := TObject(TP_GlobalClassHandling.Items[i]) as TClassMode;
          if cm.HClass = HClass then
            raise EGGProgrammingError.Create('You cannot set a handler for a class that has already been assigned otherwise.');
          if HClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := HClass;
            cm.SpecialHandler := Handler;
            TP_GlobalClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('A handler was set for class ' + HClass.ClassName + '.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := HClass;
        cm.SpecialHandler := Handler;
        TP_GlobalClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('A handler was set for class ' + HClass.ClassName + '.');
{$ENDIF}
      end;

procedure TGnuGettextInstance.TP_GlobalIgnoreClass(IgnClass: TClass);
      var
        cm: TClassMode;
        i: Integer;
      begin
        for i := 0 to TP_GlobalClassHandling.Count - 1 do
        begin
          cm := TObject(TP_GlobalClassHandling.Items[i]) as TClassMode;
          if cm.HClass = IgnClass then
            raise EGGProgrammingError.Create('You cannot add a class to the ignore list that is already on that list: ' + IgnClass.ClassName +
              '. You should keep all TP_Global functions in one place in your source code.');
          if IgnClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := IgnClass;
            TP_GlobalClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Globally, class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := IgnClass;
        TP_GlobalClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Globally, class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
      end;

procedure TGnuGettextInstance.TP_GlobalIgnoreClassProperty(IgnClass: TClass; propertyname: ComponentNameString);
      var
        cm: TClassMode;
        i, idx: Integer;
      begin
        propertyname := uppercase(propertyname);
        for i := 0 to TP_GlobalClassHandling.Count - 1 do
        begin
          cm := TObject(TP_GlobalClassHandling.Items[i]) as TClassMode;
          if cm.HClass = IgnClass then
          begin
            if Assigned(cm.SpecialHandler) then
              raise EGGProgrammingError.Create('You cannot ignore a class property for a class that has a handler set.');
            if not cm.PropertiesToIgnore.Find(propertyname, idx) then
              cm.PropertiesToIgnore.Add(propertyname);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Globally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
          if IgnClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := IgnClass;
            cm.PropertiesToIgnore.Add(propertyname);
            TP_GlobalClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Globally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := IgnClass;
        cm.PropertiesToIgnore.Add(propertyname);
        TP_GlobalClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Globally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
      end;

procedure TGnuGettextInstance.TP_Ignore(AnObject: TObject; const name: ComponentNameString);
      begin
        TP_IgnoreList.Add(uppercase(name));
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('On object with class name ' + AnObject.ClassName + ', ignore is set on ' + name);
{$ENDIF}
      end;

procedure TGnuGettextInstance.TranslateComponent(AnObject: TComponent; const textdomain: DomainString);
      var
        comp: TGnuGettextComponentMarker;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('======================================================================');
        DebugWriteln('TranslateComponent() was called for a component with name ' + AnObject.name + '.');
{$ENDIF}
        comp := AnObject.FindComponent('GNUgettextMarker') as TGnuGettextComponentMarker;
        if comp = nil then
        begin
          comp := TGnuGettextComponentMarker.Create(nil);
          comp.name := 'GNUgettextMarker';
          comp.Retranslator := TP_CreateRetranslator;
          TranslateProperties(AnObject, textdomain);
          AnObject.InsertComponent(comp);
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln
            ('This is the first time, that this component has been translated. A retranslator component has been created for this component.');
{$ENDIF}
        end
        else
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('This is not the first time, that this component has been translated.');
{$ENDIF}
          if comp.LastLanguage <> curlang then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln
              ('ERROR: TranslateComponent() was called twice with different languages. This indicates an attempt to switch language at runtime, but by using TranslateComponent every time. This API has changed - please use RetranslateComponent() instead.');
{$ENDIF}
{$IFDEF mswindows}
            MessageBox(0,
              'This application tried to switch the language, but in an incorrect way. The programmer needs to replace a call to TranslateComponent with a call to RetranslateComponent(). The programmer should see the changelog of gnugettext.pas for more information.',
              'Error', MB_OK);
{$ELSE}
            writeln(stderr,
              'This application tried to switch the language, but in an incorrect way. The programmer needs to replace a call to TranslateComponent with a call to RetranslateComponent(). The programmer should see the changelog of gnugettext.pas for more information.');
{$ENDIF}
          end
          else
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln
              ('ERROR: TranslateComponent has been called twice, but with the same language chosen. This is a mistake, but in order to prevent that the application breaks, no exception is raised.');
{$ENDIF}
          end;
        end;
        comp.LastLanguage := curlang;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('======================================================================');
{$ENDIF}
      end;

procedure TGnuGettextInstance.TranslateProperty(AnObject: TObject; PropInfo: PPropInfo; TodoList: TStrings; const textdomain: DomainString);
      var
        ppi: PPropInfo;
        ws: TranslatedUnicodeString;
        old: TranslatedUnicodeString;
        compmarker: TComponent;
        obj: TObject;
        Propname: ComponentNameString;
      begin
        Propname := string(PropInfo^.name);
        try
          // Translate certain types of properties
          case PropInfo^.PropType^.Kind of
{$IFDEF UNICODE}
            // All dfm files returning tkUString
            tkString, tkLString, tkWString, tkUString:
{$ELSE}
            tkString, tkLString, tkWString:
{$ENDIF}
              begin
{$IFDEF DXGETTEXTDEBUG}
                DebugWriteln('Translating ' + AnObject.ClassName + '.' + Propname);
{$ENDIF}
                case PropInfo^.PropType^.Kind of
                  tkString, tkLString:
                    old := GetStrProp(AnObject, Propname);
                  tkWString:
                    old := GetWideStrProp(AnObject, Propname);
{$IFDEF UNICODE}
                  tkUString:
                    old := GetUnicodeStrProp(AnObject, Propname);
{$ENDIF}
                else
                  raise Exception.Create
                    ('Internal error: Illegal property type. This problem needs to be solved by a programmer, try to find a workaround.');
                end;
{$IFDEF DXGETTEXTDEBUG}
                if old = '' then
                  DebugWriteln('(Empty, not translated)')
                else
                  DebugWriteln('Old value: "' + old + '"');
{$ENDIF}
                if (old <> '') and (IsWriteProp(PropInfo)) then
                begin
                  if TP_Retranslator <> nil then
                    (TP_Retranslator as TTP_Retranslator).Remember(AnObject, Propname, old);
                  ws := dgettext(textdomain, old);
                  if ws <> old then
                  begin
                    ppi := GetPropInfo(AnObject, Propname);
                    if ppi <> nil then
                    begin
                      SetWideStrProp(AnObject, ppi, ws);
                    end
                    else
                    begin
{$IFDEF DXGETTEXTDEBUG}
                      DebugWriteln('ERROR: Property disappeared: ' + Propname + ' for object of type ' + AnObject.ClassName);
{$ENDIF}
                    end;
                  end;
                end;
              end { case item };
            tkClass:
              begin
                obj := GetObjectProp(AnObject, Propname);
                if obj <> nil then
                begin
                  if obj is TComponent then
                  begin
                    compmarker := TComponent(obj).FindComponent('GNUgettextMarker');
                    if Assigned(compmarker) then
                      exit;
                  end;
                  TodoList.AddObject('', obj);
                end;
              end { case item };
          end { case };
        except
          on E: Exception do
            raise EGGComponentError.Create('Property cannot be translated.' + sLinebreak + 'Add TP_GlobalIgnoreClassProperty(' + AnObject.ClassName +
              ',''' + Propname + ''') to your source code or use' + sLinebreak + 'TP_Ignore (self,''.' + Propname + ''') to prevent this message.' +
              sLinebreak + 'Reason: ' + E.Message);
        end;
      end;

procedure TGnuGettextInstance.TranslateProperties(AnObject: TObject; textdomain: DomainString = '');
      var
        TodoList: TStringList; // List of Name/TObject's that is to be processed
        DoneList: TStringList;
        // List of hex codes representing pointers to objects that have been done
        i, j, Count: Integer;
        PropList: PPropList;
        UPropName: ComponentNameString;
        PropInfo: PPropInfo;
        compmarker, comp: TComponent;
        cm, currentcm: TClassMode;
        // currentcm is nil or contains special information about how to handle the current object
        ObjectPropertyIgnoreList: TStringList;
        objid: string;
        name: ComponentNameString;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('----------------------------------------------------------------------');
        DebugWriteln('TranslateProperties() was called for an object of class ' + AnObject.ClassName + ' with domain "' + textdomain + '".');
{$ENDIF}
        if textdomain = '' then
          textdomain := curmsgdomain;
        if TP_Retranslator <> nil then
          (TP_Retranslator as TTP_Retranslator).textdomain := textdomain;
{$IFDEF FPC}
        DoneList := TCSStringList.Create;
        TodoList := TCSStringList.Create;
        ObjectPropertyIgnoreList := TCSStringList.Create;
{$ELSE}
        DoneList := TStringList.Create;
        TodoList := TStringList.Create;
        ObjectPropertyIgnoreList := TStringList.Create;
{$ENDIF}
        try
          TodoList.AddObject('', AnObject);
          DoneList.Sorted := true;
          ObjectPropertyIgnoreList.Sorted := true;
          ObjectPropertyIgnoreList.Duplicates := dupIgnore;
          ObjectPropertyIgnoreList.CaseSensitive := false;
          DoneList.Duplicates := dupError;
          DoneList.CaseSensitive := true;

while TodoList.Count <> 0 do
          begin
            AnObject := TodoList.Objects[0];
            Name := TodoList.Strings[0];
            TodoList.delete(0);
            if (AnObject <> nil) and (AnObject is TPersistent) then
            begin
              // Make sure each object is only translated once
              Assert(SizeOf(Integer) = SizeOf(TObject));
              objid := IntToHex(Integer(AnObject), 8);
              if DoneList.Find(objid, i) then
              begin
                continue;
              end
              else
              begin
                DoneList.Add(objid);
              end;

ObjectPropertyIgnoreList.Clear;

// Find out if there is special handling of this object
              currentcm := nil;
              // First check the local handling instructions
              for j := 0 to TP_ClassHandling.Count - 1 do
              begin
                cm := TObject(TP_ClassHandling.Items[j]) as TClassMode;
                if AnObject.InheritsFrom(cm.HClass) then
                begin
                  if cm.PropertiesToIgnore.Count <> 0 then
                  begin
                    ObjectPropertyIgnoreList.AddStrings(cm.PropertiesToIgnore);
                  end
                  else
                  begin
                    // Ignore the entire class
                    currentcm := cm;
                    break;
                  end;
                end;
              end;
              // Then check the global handling instructions
              if currentcm = nil then
                for j := 0 to TP_GlobalClassHandling.Count - 1 do
                begin
                  cm := TObject(TP_GlobalClassHandling.Items[j]) as TClassMode;
                  if AnObject.InheritsFrom(cm.HClass) then
                  begin
                    if cm.PropertiesToIgnore.Count <> 0 then
                    begin
                      ObjectPropertyIgnoreList.AddStrings(cm.PropertiesToIgnore);
                    end
                    else
                    begin
                      // Ignore the entire class
                      currentcm := cm;
                      break;
                    end;
                  end;
                end;
              if currentcm <> nil then
              begin
                ObjectPropertyIgnoreList.Clear;
                // Ignore or use special handler
                if Assigned(currentcm.SpecialHandler) then
                begin
                  currentcm.SpecialHandler(AnObject);
{$IFDEF DXGETTEXTDEBUG}
                  DebugWriteln('Special handler activated for ' + AnObject.ClassName);
{$ENDIF}
                end
                else
                begin
{$IFDEF DXGETTEXTDEBUG}
                  DebugWriteln('Ignoring object ' + AnObject.ClassName);
{$ENDIF}
                end;
                continue;
              end;

Count := GetPropList(AnObject, PropList);
              try
                for j := 0 to Count - 1 do
                begin
                  PropInfo := PropList[j];
{$IFDEF UNICODE}
                  if not(PropInfo^.PropType^.Kind in [tkString, tkLString, tkWString, tkClass, tkUString]) then
{$ELSE}
                  if not(PropInfo^.PropType^.Kind in [tkString, tkLString, tkWString, tkClass]) then
{$ENDIF}
                    continue;
                  UPropName := uppercase(string(PropInfo^.name));
                  // Ignore properties that are meant to be ignored
                  if ((currentcm = nil) or (not currentcm.PropertiesToIgnore.Find(UPropName, i))) and
                    (not TP_IgnoreList.Find(Name + '.' + UPropName, i)) and (not ObjectPropertyIgnoreList.Find(UPropName, i)) then
                  begin
                    TranslateProperty(AnObject, PropInfo, TodoList, textdomain);
                  end; // if
                end; // for
              finally
                if Count <> 0 then
                  FreeMem(PropList);
              end;
              if AnObject is TStrings then
              begin
                if ((AnObject as TStrings).Text <> '') and (TP_Retranslator <> nil) then
                  (TP_Retranslator as TTP_Retranslator).Remember(AnObject, 'Text', (AnObject as TStrings).Text);
                TranslateStrings(AnObject as TStrings, textdomain);
              end;
              // Check for TCollection
              if AnObject is TCollection then
              begin
                for i := 0 to (AnObject as TCollection).Count - 1 do
                begin
                  // Only add the object if it's not totally ignored already
                  if not Assigned(currentcm) or not AnObject.InheritsFrom(currentcm.HClass) then
                    TodoList.AddObject('', (AnObject as TCollection).Items[i]);
                end;
              end;
              if AnObject is TComponent then
              begin
                for i := 0 to TComponent(AnObject).ComponentCount - 1 do
                begin
                  comp := TComponent(AnObject).Components[i];
                  if (not TP_IgnoreList.Find(uppercase(comp.name), j)) then
                  begin
                    // Only add the object if it's not totally ignored or translated already
                    if not Assigned(currentcm) or not AnObject.InheritsFrom(currentcm.HClass) then
                    begin
                      compmarker := comp.FindComponent('GNUgettextMarker');
                      if not Assigned(compmarker) then
                        TodoList.AddObject(uppercase(comp.name), comp);
                    end;
                  end;
                end;
              end;
            end { if AnObject<>nil };
          end { while todolist.count<>0 };
        finally
          FreeAndNil(TodoList);
          FreeAndNil(ObjectPropertyIgnoreList);
          FreeAndNil(DoneList);
        end;
        FreeTP_ClassHandlingItems;
        TP_IgnoreList.Clear;
        TP_Retranslator := nil;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('----------------------------------------------------------------------');
{$ENDIF}
      end;

procedure TGnuGettextInstance.UseLanguage(LanguageCode: LanguageString);
      var
        i, p: Integer;
        dom: TDomain;
        l2: string;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('UseLanguage(''' + LanguageCode + '''); called');
{$ENDIF}
        if LanguageCode = '' then
        begin
          LanguageCode := GGGetEnvironmentVariable('LANG');
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('LANG env variable is ''' + LanguageCode + '''.');
{$ENDIF}
{$IFDEF MSWINDOWS}
          if LanguageCode = '' then
          begin
            LanguageCode := GetWindowsLanguage;
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Found Windows language code to be ''' + LanguageCode + '''.');
{$ENDIF}
          end;
{$ENDIF}
          p := pos('.', LanguageCode);
          if p <> 0 then
            LanguageCode := LeftStr(LanguageCode, p - 1);
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Language code that will be set is ''' + LanguageCode + '''.');
{$ENDIF}
        end;

curlang := LanguageCode;
        for i := 0 to domainlist.Count - 1 do
        begin
          dom := domainlist.Objects[i] as TDomain;
          dom.SetLanguageCode(curlang);
        end;

l2 := lowercase(LeftStr(curlang, 2));
        if (l2 = 'en') or (l2 = 'de') then
          curGetPluralForm := GetPluralForm2EN
        else if (l2 = 'hu') or (l2 = 'ko') or (l2 = 'zh') or (l2 = 'ja') or (l2 = 'tr') then
          curGetPluralForm := GetPluralForm1
        else if (l2 = 'fr') or (l2 = 'fa') or (lowercase(curlang) = 'pt_br') then
          curGetPluralForm := GetPluralForm2FR
        else if (l2 = 'lv') then
          curGetPluralForm := GetPluralForm3LV
        else if (l2 = 'ga') then
          curGetPluralForm := GetPluralForm3GA
        else if (l2 = 'lt') then
          curGetPluralForm := GetPluralForm3LT
        else if (l2 = 'ru') or (l2 = 'uk') or (l2 = 'hr') then
          curGetPluralForm := GetPluralForm3RU
        else if (l2 = 'cs') or (l2 = 'sk') then
          curGetPluralForm := GetPluralForm3SK
        else if (l2 = 'pl') then
          curGetPluralForm := GetPluralForm3PL
        else if (l2 = 'sl') then
          curGetPluralForm := GetPluralForm4SL
        else
        begin
          curGetPluralForm := GetPluralForm2EN;
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Plural form for the language was not found. English plurality system assumed.');
{$ENDIF}
        end;

WhenNewLanguage(curlang);

{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('');
{$ENDIF}
      end;

procedure TGnuGettextInstance.TranslateStrings(sl: TStrings; const textdomain: DomainString);
      var
        Line: string;
        i: Integer;
        s: TStringList;
      begin
        if sl.Count > 0 then
        begin
          sl.BeginUpdate;
          try
            s := TStringList.Create;
            try
              s.Assign(sl);
              for i := 0 to s.Count - 1 do
              begin
                Line := s.Strings[i];
                if Line <> '' then
                  s.Strings[i] := dgettext(textdomain, Line);
              end;
              sl.Assign(s);
            finally
              FreeAndNil(s);
            end;
          finally
            sl.EndUpdate;
          end;
        end;
      end;

function TGnuGettextInstance.GetTranslatorNameAndEmail: TranslatedUnicodeString;
      begin
        Result := GetTranslationProperty('LAST-TRANSLATOR');
      end;

function TGnuGettextInstance.GetTranslationProperty(const propertyname: ComponentNameString): TranslatedUnicodeString;
      begin
        Result := Getdomain(curmsgdomain, DefaultDomainDirectory, curlang).GetTranslationProperty(propertyname);
      end;

function TGnuGettextInstance.dngettext(const szDomain: DomainString; const singular, plural: MsgIdString; Number: Integer)
        : TranslatedUnicodeString;
      var
        org: MsgIdString;
        trans: TranslatedUnicodeString;
        idx: Integer;
        p: Integer;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('dngettext translation (domain ' + szDomain + ', number is ' + IntToStr(Number) + ') of ' + singular + '/' + plural);
{$ENDIF}
        org := singular + #0 + plural;
        trans := dgettext(szDomain, org);
        if org = trans then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Translation was equal to english version. English plural forms assumed.');
{$ENDIF}
          idx := GetPluralForm2EN(Number)
        end
        else
          idx := curGetPluralForm(Number);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Index ' + IntToStr(idx) + ' will be used');
{$ENDIF}
        while true do
        begin
          p := pos(#0, trans);
          if p = 0 then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Last translation used: ' + utf8encode(trans));
{$ENDIF}
            Result := trans;
            exit;
          end;
          if idx = 0 then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Translation found: ' + utf8encode(trans));
{$ENDIF}
            Result := LeftStr(trans, p - 1);
            exit;
          end;
          delete(trans, 1, p);
          dec(idx);
        end;
      end;

function TGnuGettextInstance.dngettext_NoExtract(const szDomain: DomainString; const singular, plural: MsgIdString; Number: Integer)
        : TranslatedUnicodeString;
      begin
        // This one is very useful for translating text in variables.
        // This can sometimes be necessary, and by using this function,
        // the source code scanner will not trigger warnings.
        Result := dngettext(szDomain, singular, plural, Number);
      end;

{$IFNDEF UNICODE}
      function TGnuGettextInstance.ngettext(const singular, plural: AnsiString; Number: Integer): TranslatedUnicodeString;
      begin
        Result := dngettext(curmsgdomain, singular, plural, Number);
      end;
{$ENDIF}
      function TGnuGettextInstance.ngettext(const singular, plural: MsgIdString; Number: Integer): TranslatedUnicodeString;
      begin
        Result := dngettext(curmsgdomain, singular, plural, Number);
      end;

function TGnuGettextInstance.ngettext_NoExtract(const singular, plural: MsgIdString; Number: Integer): TranslatedUnicodeString;
      begin
        // This one is very useful for translating text in variables.
        // This can sometimes be necessary, and by using this function,
        // the source code scanner will not trigger warnings.
        Result := ngettext(singular, plural, Number);
      end;

procedure TGnuGettextInstance.WhenNewDomain(const textdomain: DomainString);
      begin
        // This is meant to be empty.
      end;

procedure TGnuGettextInstance.WhenNewLanguage(const LanguageID: LanguageString);
      begin
        // This is meant to be empty.
      end;

procedure TGnuGettextInstance.WhenNewDomainDirectory(const textdomain: DomainString; const Directory: FilenameString);
      begin
        // This is meant to be empty.
      end;

procedure TGnuGettextInstance.GetListOfLanguages(const domain: DomainString; list: TStrings);
      begin
        Getdomain(domain, DefaultDomainDirectory, curlang).GetListOfLanguages(list);
      end;

procedure TGnuGettextInstance.bindtextdomainToFile(const szDomain: DomainString; const filename: FilenameString);
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Text domain "' + szDomain + '" is now bound to file named "' + filename + '"');
{$ENDIF}
        Getdomain(szDomain, DefaultDomainDirectory, curlang).SetFilename(filename);
      end;

procedure TGnuGettextInstance.DebugLogPause(PauseEnabled: boolean);
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugLogOutputPaused := PauseEnabled;
{$ENDIF}
      end;

procedure TGnuGettextInstance.DebugLogToFile(const filename: FilenameString; append: boolean = false);
{$IFDEF DXGETTEXTDEBUG}
      var
        fs: TFileStream;
        marker: AnsiString;
{$ENDIF}
      begin
{$IFDEF DXGETTEXTDEBUG}
        // Create the file if needed
        if (not FileExists(filename)) or (not append) then
          fileclose(filecreate(filename));

// Open file
        fs := TFileStream.Create(filename, fmOpenWrite or fmShareDenyWrite);
        if append then
          fs.Seek(0, soFromEnd);

// Write header if appending
        if fs.Position <> 0 then
        begin
          marker := sLinebreak + '===========================================================================' + sLinebreak;
          fs.WriteBuffer(marker[1], length(marker));
        end;

// Copy the memorystream contents to the file
        DebugLog.Seek(0, soFromBeginning);
        fs.CopyFrom(DebugLog, 0);

// Make DebugLog point to the filestream
        FreeAndNil(DebugLog);
        DebugLog := fs;
{$ENDIF}
      end;

{$IFDEF DXGETTEXTDEBUG}
      procedure TGnuGettextInstance.DebugWriteln(Line: AnsiString);
      Var
        Discard: boolean;
      begin
        Assert(DebugLogCS <> nil);
        Assert(DebugLog <> nil);

DebugLogCS.BeginWrite;
        try
          if DebugLogOutputPaused then
            exit;

if Assigned(fOnDebugLine) then
          begin
            Discard := true;
            fOnDebugLine(self, Line, Discard);
            If Discard then
              exit;
          end;

Line := Line + sLinebreak;

// Ensure that memory usage doesn't get too big.
          if (DebugLog is TMemoryStream) and (DebugLog.Position > 1000000) then
          begin
            Line := sLinebreak + sLinebreak + sLinebreak + sLinebreak + sLinebreak + 'Debug log halted because memory usage grew too much.' +
              sLinebreak + 'Specify a filename to store the debug log in or disable debug loggin in gnugettext.pas.' + sLinebreak + sLinebreak +
              sLinebreak + sLinebreak + sLinebreak;
            DebugLogOutputPaused := true;
          end;
          DebugLog.WriteBuffer(Line[1], length(Line));
        finally
          DebugLogCS.EndWrite;
        end;
      end;
{$ENDIF}
      function TGnuGettextInstance.Getdomain(const domain: DomainString; const DefaultDomainDirectory: FilenameString;
        const curlang: LanguageString): TDomain;
      // Retrieves the TDomain object for the specified domain.
      // Creates one, if none there, yet.
      var
        idx: Integer;
      begin
        idx := domainlist.IndexOf(domain);
        if idx = -1 then
        begin
          Result := TDomain.Create;
{$IFDEF DXGETTEXTDEBUG}
          Result.DebugLogger := DebugWriteln;
{$ENDIF}
          Result.domain := domain;
          Result.Directory := DefaultDomainDirectory;
          Result.SetLanguageCode(curlang);
          domainlist.AddObject(domain, Result);
        end
        else
        begin
          Result := domainlist.Objects[idx] as TDomain;
        end;
      end;

function TGnuGettextInstance.LoadResString(ResStringRec: PResStringRec): UnicodeString;
{$IFDEF MSWINDOWS}
      var
        Len: Integer;
{$IFDEF UNICODE}
        Buffer: array [0 .. 1023] of widechar;
{$ELSE}
        Buffer: array [0 .. 1023] of ansichar;
{$ENDIF}
{$ENDIF}
{$IFDEF LINUX }
      const
        ResStringTableLen = 16;
      type
        ResStringTable = array [0 .. ResStringTableLen - 1] of LongWord;
      var
        Handle: TResourceHandle;
        Tab: ^ResStringTable;
        ResMod: HModule;
{$ENDIF }
      begin
        if ResStringRec = nil then
          exit;
        if ResStringRec.Identifier >= 64 * 1024 then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('LoadResString was given an invalid ResStringRec.Identifier');
{$ENDIF}
          Result := 'ERROR';
          exit;
        end
        else
        begin
{$IFDEF LINUX}
          // This works with Unicode if the Linux has utf-8 character set
          // Result:=System.LoadResString(ResStringRec);
          ResMod := FindResourceHInstance(ResStringRec^.Module^);
          Handle := FindResource(ResMod, PAnsiChar(ResStringRec^.Identifier div ResStringTableLen), PAnsiChar(6)); // RT_STRING
          Tab := pointer(LoadResource(ResMod, Handle));
          if Tab = nil then
            Result := ''
          else
            Result := PWideChar(PAnsiChar(Tab) + Tab[ResStringRec^.Identifier mod ResStringTableLen]);
{$ENDIF}
{$IFDEF MSWINDOWS}
          if not Win32PlatformIsUnicode then
          begin
            SetString(Result, Buffer, LoadString(FindResourceHInstance(ResStringRec.Module^), ResStringRec.Identifier, Buffer, SizeOf(Buffer)))
          end
          else
          begin
            Result := '';
            Len := 0;
            While length(Result) <= Len + 1 do
            begin
              if length(Result) = 0 then
                SetLength(Result, 1024)
              else
                SetLength(Result, length(Result) * 2);
              Len := LoadStringW(FindResourceHInstance(ResStringRec.Module^), ResStringRec.Identifier, PWideChar(Result), length(Result));
            end;
            SetLength(Result, Len);
          end;
{$ENDIF}
        end;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Loaded resourcestring: ' + utf8encode(Result));
{$ENDIF}
        if CreatorThread <> GetCurrentThreadId then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('LoadResString was called from an invalid thread. Resourcestring was not translated.');
{$ENDIF}
        end
        else
          Result := ResourceStringGettext(Result);
      end;

procedure TGnuGettextInstance.RetranslateComponent(AnObject: TComponent; const textdomain: DomainString);
      var
        comp: TGnuGettextComponentMarker;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('======================================================================');
        DebugWriteln('RetranslateComponent() was called for a component with name ' + AnObject.name + '.');
{$ENDIF}
        comp := AnObject.FindComponent('GNUgettextMarker') as TGnuGettextComponentMarker;
        if comp = nil then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Retranslate was called on an object that has not been translated before. An Exception is being raised.');
{$ENDIF}
          raise EGGProgrammingError.Create
            ('Retranslate was called on an object that has not been translated before. Please use TranslateComponent() before RetranslateComponent().');
        end
        else
        begin
          if comp.LastLanguage <> curlang then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('The retranslator is being executed.');
{$ENDIF}
            comp.Retranslator.Execute;
          end
          else
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('The language has not changed. The retranslator is not executed.');
{$ENDIF}
          end;
        end;
        comp.LastLanguage := curlang;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('======================================================================');
{$ENDIF}
      end;

procedure TGnuGettextInstance.TP_IgnoreClass(IgnClass: TClass);
      var
        cm: TClassMode;
        i: Integer;
      begin
        for i := 0 to TP_ClassHandling.Count - 1 do
        begin
          cm := TObject(TP_ClassHandling.Items[i]) as TClassMode;
          if cm.HClass = IgnClass then
            raise EGGProgrammingError.Create('You cannot add a class to the ignore list that is already on that list: ' + IgnClass.ClassName + '.');
          if IgnClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := IgnClass;
            TP_ClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Locally, class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := IgnClass;
        TP_ClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Locally, class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
      end;

procedure TGnuGettextInstance.TP_IgnoreClassProperty(IgnClass: TClass; propertyname: ComponentNameString);
      var
        cm: TClassMode;
        i: Integer;
      begin
        propertyname := uppercase(propertyname);
        for i := 0 to TP_ClassHandling.Count - 1 do
        begin
          cm := TObject(TP_ClassHandling.Items[i]) as TClassMode;
          if cm.HClass = IgnClass then
          begin
            if Assigned(cm.SpecialHandler) then
              raise EGGProgrammingError.Create('You cannot ignore a class property for a class that has a handler set.');
            cm.PropertiesToIgnore.Add(propertyname);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Globally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
          if IgnClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := IgnClass;
            cm.PropertiesToIgnore.Add(propertyname);
            TP_ClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Locally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := IgnClass;
        cm.PropertiesToIgnore.Add(propertyname);
        TP_GlobalClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Locally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
      end;

procedure TGnuGettextInstance.FreeTP_ClassHandlingItems;
      begin
        while TP_ClassHandling.Count <> 0 do
        begin
          TObject(TP_ClassHandling.Items[0]).Free;
          TP_ClassHandling.delete(0);
        end;
      end;

{$IFNDEF UNICODE}
      function TGnuGettextInstance.ansi2wideDTCP(const s: AnsiString): MsgIdString;
{$IFDEF MSWindows}
      var
        Len: Integer;
{$ENDIF}
      begin
{$IFDEF MSWindows}
        if DesignTimeCodePage = CP_ACP then
        begin
          // No design-time codepage specified. Using runtime codepage instead.
{$ENDIF}
          Result := s;
{$IFDEF MSWindows}
        end
        else
        begin
          Len := length(s);
          if Len = 0 then
            Result := ''
          else
          begin
            SetLength(Result, Len);
            Len := MultiByteToWideChar(DesignTimeCodePage, 0, PAnsiChar(s), Len, PWideChar(Result), Len);
            if Len = 0 then
              raise EGGAnsi2WideConvError.Create('Cannot convert string to widestring:' + sLinebreak + s);
            SetLength(Result, Len);
          end;
        end;
{$ENDIF}
      end;
{$ENDIF}
{$IFNDEF UNICODE}
      function TGnuGettextInstance.dngettext(const szDomain: DomainString; const singular, plural: AnsiString; Number: Integer)
        : TranslatedUnicodeString;
      begin
        Result := dngettext(szDomain, ansi2wideDTCP(singular), ansi2wideDTCP(plural), Number);
      end;
{$ENDIF}
    { TClassMode }

constructor TClassMode.Create;
      begin
        PropertiesToIgnore := TStringList.Create;
        PropertiesToIgnore.Sorted := true;
        PropertiesToIgnore.Duplicates := dupError;
        PropertiesToIgnore.CaseSensitive := false;
      end;

destructor TClassMode.Destroy;
      begin
        FreeAndNil(PropertiesToIgnore);
        inherited;
      end;

{ TFileLocator }

procedure TFileLocator.Analyze;
      var
        s: RawByteString;
        i: Integer;
        Offset: int64;
        fs: TFileStream;
        fi: TEmbeddedFileInfo;
        filename: FilenameString;
        filename8bit: RawByteString;
      const
        arrch: array [0 .. 43] of ansichar = '6637DB2E-62E1-4A60-AC19-C23867046A89'#0#0#0#0#0#0#0#0;
      begin
        // Copy byte by byte, compatible with Delphi 2009 and older
        SetLength(s, high(arrch) - low(arrch) + 1);
        for i := 0 to 43 do
          s[i + 1] := arrch[i];

s := MidStr(s, length(s) - 7, 8);
        Offset := 0;
        for i := 8 downto 1 do
          Offset := Offset shl 8 + ord(s[i]);
        if Offset = 0 then
          exit;
        basedirectory := extractfilepath(ExecutableFilename);
        try
          fs := TFileStream.Create(ExecutableFilename, fmOpenRead or fmShareDenyNone);
          try
            while true do
            begin
              fs.Seek(Offset, soFromBeginning);
              Offset := ReadInt64(fs);
              if Offset = 0 then
                exit;
              fi := TEmbeddedFileInfo.Create;
              try
                fi.Offset := ReadInt64(fs);
                fi.Size := ReadInt64(fs);
                SetLength(filename8bit, Offset - fs.Position);
                fs.ReadBuffer(filename8bit[1], Offset - fs.Position);
                filename := trim(utf8decode(filename8bit));
                if PreferExternal and SysUtils.FileExists(basedirectory + filename) then
                begin
                  // Disregard the internal version and use the external version instead
                  FreeAndNil(fi);
                end
                else
                  filelist.AddObject(filename, fi);
              except
                FreeAndNil(fi);
                raise;
              end;
            end;
          finally
            FreeAndNil(fs);
          end;
        except
{$IFDEF DXGETTEXTDEBUG}
          raise;
{$ENDIF}
        end;
      end;

constructor TFileLocator.Create;
      begin
        MoFilesCS := TMultiReadExclusiveWriteSynchronizer.Create;
        MoFiles := TStringList.Create;
        filelist := TStringList.Create;
{$IFDEF LINUX}
        filelist.Duplicates := dupError;
        filelist.CaseSensitive := true;
{$ENDIF}
        MoFiles.Sorted := true;
        MoFiles.Duplicates := dupError;
        MoFiles.CaseSensitive := false;
{$IFDEF MSWINDOWS}
        filelist.Duplicates := dupError;
        filelist.CaseSensitive := false;
{$ENDIF}
        filelist.Sorted := true;
      end;

destructor TFileLocator.Destroy;
      begin
        while filelist.Count <> 0 do
        begin
          filelist.Objects[0].Free;
          filelist.delete(0);
        end;
        FreeAndNil(filelist);
        FreeAndNil(MoFiles);
        FreeAndNil(MoFilesCS);
        inherited;
      end;

function TFileLocator.FileExists(filename: FilenameString): boolean;
      var
        idx: Integer;
      begin
        if LeftStr(filename, length(basedirectory)) = basedirectory then
        begin
          // Cut off basedirectory if the file is located beneath that base directory
          filename := MidStr(filename, length(basedirectory) + 1, maxint);
        end;
        Result := filelist.Find(filename, idx);
      end;

function TFileLocator.GetMoFile(filename: FilenameString; DebugLogger: TDebugLogger): TMoFile;
      var
        fi: TEmbeddedFileInfo;
        idx: Integer;
        idxname: FilenameString;
        Offset, Size: int64;
        realfilename: FilenameString;
      begin
        // Find real filename
        Offset := 0;
        Size := 0;
        realfilename := filename;
        if LeftStr(filename, length(basedirectory)) = basedirectory then
        begin
          filename := MidStr(filename, length(basedirectory) + 1, maxint);
          idx := filelist.IndexOf(filename);
          if idx <> -1 then
          begin
            fi := filelist.Objects[idx] as TEmbeddedFileInfo;
            realfilename := ExecutableFilename;
            Offset := fi.Offset;
            Size := fi.Size;
{$IFDEF DXGETTEXTDEBUG}
            DebugLogger('Instead of ' + filename + ', using ' + realfilename + ' from offset ' + IntToStr(Offset) + ', size ' + IntToStr(Size));
{$ENDIF}
          end;
        end;

{$IFDEF DXGETTEXTDEBUG}
        DebugLogger('Reading .mo data from file ''' + filename + '''');
{$ENDIF}
        // Find TMoFile object
        MoFilesCS.BeginWrite;
        try
          idxname := realfilename + ' //\\ ' + IntToStr(Offset);
          if MoFiles.Find(idxname, idx) then
          begin
            Result := MoFiles.Objects[idx] as TMoFile;
          end
          else
          begin
            Result := TMoFile.Create(realfilename, Offset, Size);
            MoFiles.AddObject(idxname, Result);
          end;
          inc(Result.Users);
        finally
          MoFilesCS.EndWrite;
        end;
      end;

function TFileLocator.ReadInt64(str: TStream): int64;
      begin
        Assert(SizeOf(Result) = 8);
        str.ReadBuffer(Result, 8);
      end;

procedure TFileLocator.ReleaseMoFile(mofile: TMoFile);
      var
        i: Integer;
      begin
        Assert(mofile <> nil);

MoFilesCS.BeginWrite;
        try
          dec(mofile.Users);
          if mofile.Users <= 0 then
          begin
            i := MoFiles.Count - 1;
            while i >= 0 do
            begin
              if MoFiles.Objects[i] = mofile then
              begin
                MoFiles.delete(i);
                FreeAndNil(mofile);
                break;
              end;
              dec(i);
            end;
          end;
        finally
          MoFilesCS.EndWrite;
        end;
      end;

{ TTP_Retranslator }

constructor TTP_Retranslator.Create;
      begin
        list := TList.Create;
      end;

destructor TTP_Retranslator.Destroy;
      var
        i: Integer;
      begin
        for i := 0 to list.Count - 1 do
          TObject(list.Items[i]).Free;
        FreeAndNil(list);
        inherited;
      end;

procedure TTP_Retranslator.Execute;
      var
        i: Integer;
        sl: TStrings;
        item: TTP_RetranslatorItem;
        newvalue: TranslatedUnicodeString;
        comp: TGnuGettextComponentMarker;
        ppi: PPropInfo;
      begin
        for i := 0 to list.Count - 1 do
        begin
          item := TObject(list.Items[i]) as TTP_RetranslatorItem;
          if item.obj is TComponent then
          begin
            comp := TComponent(item.obj).FindComponent('GNUgettextMarker') as TGnuGettextComponentMarker;
            if Assigned(comp) and (self <> comp.Retranslator) then
            begin
              comp.Retranslator.Execute;
              continue;
            end;
          end;
          if item.obj is TStrings then
          begin
            // Since we don't know the order of items in sl, and don't have
            // the original .Objects[] anywhere, we cannot anticipate anything
            // about the current sl.Strings[] and sl.Objects[] values. We therefore
            // have to discard both values. We can, however, set the original .Strings[]
            // value into the list and retranslate that.
            sl := TStringList.Create;
            try
              sl.Text := item.OldValue;
              Instance.TranslateStrings(sl, textdomain);
              (item.obj as TStrings).BeginUpdate;
              try
                (item.obj as TStrings).Text := sl.Text;
              finally
                (item.obj as TStrings).EndUpdate;
              end;
            finally
              FreeAndNil(sl);
            end;
          end
          else
          begin
            newvalue := Instance.dgettext(textdomain, item.OldValue);
            ppi := GetPropInfo(item.obj, item.Propname);
            if ppi <> nil then
            begin
              SetWideStrProp(item.obj, ppi, newvalue);
            end
            else
            begin
{$IFDEF DXGETTEXTDEBUG}
              Instance.DebugWriteln('ERROR: On retranslation, property disappeared: ' + item.Propname + ' for object of type ' + item.obj.ClassName);
{$ENDIF}
            end;
          end;
        end;
      end;

procedure TTP_Retranslator.Remember(obj: TObject; Propname: ComponentNameString; OldValue: TranslatedUnicodeString);
      var
        item: TTP_RetranslatorItem;
      begin
        item := TTP_RetranslatorItem.Create;
        item.obj := obj;
        item.Propname := Propname;
        item.OldValue := OldValue;
        list.Add(item);
      end;

{ TGnuGettextComponentMarker }

destructor TGnuGettextComponentMarker.Destroy;
      begin
        FreeAndNil(Retranslator);
        inherited;
      end;

{ THook }

constructor THook.Create(OldProcedure, NewProcedure: pointer; FollowJump: boolean = false);
      { Idea and original code from Igor Siticov }
      { Modified by Jacques Garcia Vazquez and Lars Dybdahl }
      begin
{$IFNDEF CPU386}
        raise Exception.Create('This procedure only works on Intel i386 compatible processors.');
{$ENDIF}
        oldproc := OldProcedure;
        newproc := NewProcedure;

Reset(FollowJump);
      end;

destructor THook.Destroy;
      begin
        Shutdown;
        inherited;
      end;

procedure THook.Disable;
      begin
        Assert(PatchPosition <> nil, 'Patch position in THook was nil when Disable was called');
        PatchPosition[0] := Original[0];
        PatchPosition[1] := Original[1];
        PatchPosition[2] := Original[2];
        PatchPosition[3] := Original[3];
        PatchPosition[4] := Original[4];
      end;

procedure THook.Enable;
      begin
        Assert(PatchPosition <> nil, 'Patch position in THook was nil when Enable was called');
        PatchPosition[0] := Patch[0];
        PatchPosition[1] := Patch[1];
        PatchPosition[2] := Patch[2];
        PatchPosition[3] := Patch[3];
        PatchPosition[4] := Patch[4];
      end;

procedure THook.Reset(FollowJump: boolean);
      var
        Offset: Integer;
{$IFDEF LINUX}
        p: pointer;
        pagesize: Integer;
{$ENDIF}
{$IFDEF MSWindows}
        ov: Cardinal;
{$ENDIF}
      begin
        if PatchPosition <> nil then
          Shutdown;

PatchPosition := oldproc;
        if FollowJump and (Word(oldproc^) = $25FF) then
        begin
          // This finds the correct procedure if a virtual jump has been inserted
          // at the procedure address
          inc(Integer(PatchPosition), 2); // skip the jump
          PatchPosition := PAnsiChar(pointer(pointer(PatchPosition)^)^);
        end;
        Offset := Integer(newproc) - Integer(pointer(PatchPosition)) - 5;

Patch[0] := ansichar($E9);
        Patch[1] := ansichar(Offset and 255);
        Patch[2] := ansichar((Offset shr 8) and 255);
        Patch[3] := ansichar((Offset shr 16) and 255);
        Patch[4] := ansichar((Offset shr 24) and 255);

Original[0] := PatchPosition[0];
        Original[1] := PatchPosition[1];
        Original[2] := PatchPosition[2];
        Original[3] := PatchPosition[3];
        Original[4] := PatchPosition[4];

{$IFDEF MSWINDOWS}
        if not VirtualProtect(pointer(PatchPosition), 5, PAGE_EXECUTE_READWRITE, @ov) then
          RaiseLastOSError;
{$ENDIF}
{$IFDEF LINUX}
        pagesize := sysconf(_SC_PAGE_SIZE);
        p := pointer(PatchPosition);
        p := pointer((Integer(p) + pagesize - 1) and not(pagesize - 1) - pagesize);
        if mprotect(p, pagesize, PROT_READ + PROT_WRITE + PROT_EXEC) <> 0 then
          RaiseLastOSError;
{$ENDIF}
      end;

procedure THook.Shutdown;
      begin
        Disable;
        PatchPosition := nil;
      end;

procedure HookIntoResourceStrings(enabled: boolean = true; SupportPackages: boolean = false);
      begin
        HookLoadResString.Reset(SupportPackages);
        HookLoadStr.Reset(SupportPackages);
        HookFmtLoadStr.Reset(SupportPackages);
        if enabled then
        begin
          HookLoadResString.Enable;
          HookLoadStr.Enable;
          HookFmtLoadStr.Enable;
        end;
      end;

{ TMoFile }

function TMoFile.autoswap32(i: Cardinal): Cardinal;
      var
        cnv1, cnv2: record case Integer of 0: (arr: array [0 .. 3] of byte);
        1: (int: Cardinal);
      end;

begin
    if doswap then
    begin
      cnv1.int := i;
      cnv2.arr[0] := cnv1.arr[3];
      cnv2.arr[1] := cnv1.arr[2];
      cnv2.arr[2] := cnv1.arr[1];
      cnv2.arr[3] := cnv1.arr[0];
      Result := cnv2.int;
    end
    else
      Result := i;
  end;

function TMoFile.CardinalInMem(baseptr: PAnsiChar; Offset: Cardinal): Cardinal;
  var
    pc: ^Cardinal;
  begin
    inc(baseptr, Offset);
    pc := pointer(baseptr);
    Result := pc^;
    if doswap then
      autoswap32(Result);
  end;

constructor TMoFile.Create(filename: FilenameString; Offset, Size: int64);
  var
    i: Cardinal;
    nn: Integer;
{$IFDEF linux}
    mofile: TFileStream;
{$ENDIF}
  begin
    if SizeOf(i) <> 4 then
      raise EGGProgrammingError.Create('TDomain in gnugettext is written for an architecture that has 32 bit integers.');

{$IFDEF mswindows}
    // Map the mo file into memory and let the operating system decide how to cache
    mo := createfile(PChar(filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
    if mo = INVALID_HANDLE_VALUE then
      raise EGGIOError.Create('Cannot open file ' + filename);
    momapping := CreateFileMapping(mo, nil, PAGE_READONLY, 0, 0, nil);
    if momapping = 0 then
      raise EGGIOError.Create('Cannot create memory map on file ' + filename);
    momemoryHandle := MapViewOfFile(momapping, FILE_MAP_READ, 0, 0, 0);
    if momemoryHandle = nil then
    begin
      raise EGGIOError.Create('Cannot map file ' + filename + ' into memory. Reason: ' + GetLastWinError);
    end;
    momemory := momemoryHandle + Offset;
{$ENDIF}
{$IFDEF linux}
    // Read the whole file into memory
    mofile := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone);
    try
      if Size = 0 then
        Size := mofile.Size;
      Getmem(momemoryHandle, Size);
      momemory := momemoryHandle;
      mofile.Seek(Offset, soFromBeginning);
      mofile.ReadBuffer(momemory^, Size);
    finally
      FreeAndNil(mofile);
    end;
{$ENDIF}
    // Check the magic number
    doswap := false;
    i := CardinalInMem(momemory, 0);
    if (i <> $950412DE) and (i <> $DE120495) then
      raise EGGIOError.Create('This file is not a valid GNU gettext mo file: ' + filename);
    doswap := (i = $DE120495);

// Find the positions in the file according to the file format spec
    CardinalInMem(momemory, 4);
    // Read the version number, but don't use it for anything.
    N := CardinalInMem(momemory, 8); // Get string count
    O := CardinalInMem(momemory, 12); // Get offset of original strings
    T := CardinalInMem(momemory, 16); // Get offset of translated strings

// Calculate start conditions for a binary search
    nn := N;
    startindex := 1;
    while nn <> 0 do
    begin
      nn := nn shr 1;
      startindex := startindex shl 1;
    end;
    startindex := startindex shr 1;
    startstep := startindex shr 1;
  end;

destructor TMoFile.Destroy;
  begin
{$IFDEF mswindows}
    UnMapViewOfFile(momemoryHandle);
    CloseHandle(momapping);
    CloseHandle(mo);
{$ENDIF}
{$IFDEF linux}
    FreeMem(momemoryHandle);
{$ENDIF}
    inherited;
  end;

function TMoFile.gettext(const msgid: RawUtf8String; var found: boolean): RawUtf8String;
  var
    i, step: Cardinal;
    Offset, pos: Cardinal;
    CompareResult: Integer;
    msgidptr, a, b: PAnsiChar;
    abidx: Integer;
    Size, msgidsize: Integer;
  begin
    found := false;
    msgidptr := PAnsiChar(msgid);
    msgidsize := length(msgid);

// Do binary search
    i := startindex;
    step := startstep;
    while true do
    begin
      // Get string for index i
      pos := O + 8 * (i - 1);
      Offset := CardinalInMem(momemory, pos + 4);
      Size := CardinalInMem(momemory, pos);
      a := msgidptr;
      b := momemory + Offset;
      abidx := Size;
      if msgidsize < abidx then
        abidx := msgidsize;
      CompareResult := 0;
      while abidx <> 0 do
      begin
        CompareResult := Integer(byte(a^)) - Integer(byte(b^));
        if CompareResult <> 0 then
          break;
        dec(abidx);
        inc(a);
        inc(b);
      end;
      if CompareResult = 0 then
        CompareResult := msgidsize - Size;
      if CompareResult = 0 then
      begin // msgid=s
        // Found the msgid
        pos := T + 8 * (i - 1);
        Offset := CardinalInMem(momemory, pos + 4);
        Size := CardinalInMem(momemory, pos);
        SetString(Result, momemory + Offset, Size);
        found := true;
        break;
      end;
      if step = 0 then
      begin
        // Not found
        Result := msgid;
        break;
      end;
      if CompareResult < 0 then
      begin // msgid<s
        if i < 1 + step then
          i := 1
        else
          i := i - step;
        step := step shr 1;
      end
      else
      begin // msgid>s
        i := i + step;
        if i > N then
          i := N;
        step := step shr 1;
      end;
    end;
  end;

var
  param0: string;

initialization

{$IFDEF DXGETTEXTDEBUG}
{$IFDEF MSWINDOWS}
  MessageBox(0, 'gnugettext.pas debugging is enabled. Turn it off before releasing this piece of software.', 'Information', MB_OK);
{$ENDIF}
{$IFDEF LINUX}
writeln(stderr, 'gnugettext.pas debugging is enabled. Turn it off before releasing this piece of software.');
{$ENDIF}
{$ENDIF}
{$IFDEF FPC}
{$IFDEF LINUX}
SetLocale(LC_ALL, '');
SetCWidestringManager;
{$ENDIF LINUX}
{$ENDIF FPC}
if IsLibrary then
begin
  // Get DLL/shared object filename
  SetLength(ExecutableFilename, 300);
{$IFDEF MSWINDOWS}
  SetLength(ExecutableFilename, GetModuleFileName(FindClassHInstance(TGnuGettextInstance), PChar(ExecutableFilename), length(ExecutableFilename)));
{$ELSE}
  SetLength(ExecutableFilename, GetModuleFileName(0, PAnsiChar(ExecutableFilename), length(ExecutableFilename)));
{$ENDIF}
end
else
  ExecutableFilename := Paramstr(0);
FileLocator := TFileLocator.Create;
FileLocator.Analyze;
ResourceStringDomainList := TStringList.Create;
ResourceStringDomainList.Add(DefaultTextDomain);
ResourceStringDomainListCS := TMultiReadExclusiveWriteSynchronizer.Create;
DefaultInstance := TGnuGettextInstance.Create;
{$IFDEF MSWINDOWS}
Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT);
{$ENDIF}
// replace Borlands LoadResString with gettext enabled version:
{$IFDEF UNICODE}
HookLoadResString := THook.Create(@System.LoadResString, @LoadResStringW);
{$ELSE}
HookLoadResString := THook.Create(@System.LoadResString, @LoadResStringA);
{$ENDIF}
HookLoadStr := THook.Create(@SysUtils.LoadStr, @SysUtilsLoadStr);
HookFmtLoadStr := THook.Create(@SysUtils.FmtLoadStr, @SysUtilsFmtLoadStr);
param0 := lowercase(extractfilename(Paramstr(0)));
if (param0 <> 'delphi32.exe') and (param0 <> 'kylix') and (param0 <> 'bds.exe') then
  HookIntoResourceStrings(AutoCreateHooks, false);
param0 := '';

finalization

FreeAndNil(DefaultInstance);
FreeAndNil(ResourceStringDomainListCS);
FreeAndNil(ResourceStringDomainList);
FreeAndNil(HookFmtLoadStr);
FreeAndNil(HookLoadStr);
FreeAndNil(HookLoadResString);
FreeAndNil(FileLocator);

end.

${this.title}

Code Editor : gnugettext.pas