jvgnugettext.pas

East make Tray Icon in delphi

  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: string): Boolean;
    function GetMoFile(Filename: string; DebugLogger: TDebugLogger): TMoFile;
    procedure ReleaseMoFile(var moFile: TMoFile);
  private
    BaseDirectory: string;
    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: AnsiString;
    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;

  {$ifndef CLR}
  THook = class // Replaces a runtime library procedure with a custom procedure
  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: PChar;
    procedure Shutdown; // Same as destroy, except that object is not destroyed
  end;
  {$endif}

var
  // System information
  Win32PlatformIsUnicode: Boolean = False;

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

  ResourceStringDomainListCS: TMultiReadExclusiveWriteSynchronizer;
  ResourceStringDomainList: TStringList;
  {$ifndef CLR}
  // Hooks into runtime library functions
  HookLoadResString: THook;
  HookLoadStr: THook;
  HookFmtLoadStr: THook;
  {$endif}

function Utf8EncodeChar(wc: WideChar): AnsiString;
var
  w: Word;
begin
  w := Ord(wc);
  case w of
    0..$7F:
      Result := AnsiChar(w);
    $80..$3FF:
      Result := AnsiChar($C0 + (w shr 6)) +
                AnsiChar($80 + (w and $3F));
    $400..$FFFF:
      Result := AnsiChar($E0 +(w shr 12))+
                AnsiChar($80 +((w shr 6) and $3F)) +
                AnsiChar($80 +(w and $3F));
  else
    raise Exception.Create('Huh, what happened here?');
  end;
end;

function Utf8Encode(ws: WideString): AnsiString;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(ws) do
    Result := Result + Utf8EncodeChar(ws[i]);
end;

// If dummychar is #0, it will raise Exception when an error occurs
function Utf8Decode(s: AnsiString; dummychar: WideChar = #0): WideString;
var
  i: Integer;
  b: Byte;
  c: Cardinal;
  mode: 0..5;
begin
  Result := '';
  mode := 0;
  c := 0;
  for i := 1 to Length(s) do
  begin
    b := Ord(s[i]);
    if mode = 0 then
    begin
      case b of
        0..$7F:
          Result := Result + WideChar(b);
        $80..$BF, $FF:
          begin
            if dummychar = #0 then
              raise Exception.Create ('Invalid byte sequence encountered in utf-8 string')
            else
              Result := Result + dummychar;
            mode := 0;
          end;
        $C0..$DF:
          begin
            c := (b and $1F);
            mode := 1;
          end;
        $E0..$EF:
          begin
            c := (b and $F);
            mode := 2;
          end;
        $F0..$F7:
          begin
            c := (b and $7);
            mode := 3;
          end;
        $F8..$FB:
          begin
            c := (b and $3);
            mode := 4;
          end;
        $FC..$FE:
          begin
            c := (b and $1);
            mode := 5;
          end;
      end;
    end
    else
    begin
      case b of
        $00..$7F, $C0..$FF:
          if dummychar = #0 then
            raise Exception.Create('Invalid byte sequence encountered in utf-8 string')
          else
            Result:=Result+dummychar;
        $80..$BF:
          begin
            c := c * $40 + (b and $3F);
            Dec(mode);
            if mode = 0 then
            begin
              if c <= $FFFF then
                Result := Result + WideChar(c)
              else
              begin
                if dummychar = #0 then
                  raise Exception.Create('Utf-8 string contained unicode character larger than $FFFF. This is not supported.')
                else
                  Result := Result + dummychar;
              end;
            end;
          end;
      else
        raise Exception.Create ('Huh? More than 256 different values in a byte?');
      end;
    end;
  end;
  if mode <> 0 then begin
    if dummychar = #0 then
      raise Exception.Create ('Utf-8 string terminated unexpectedly in the middle of a multibyte sequence')
    else
      Result := Result + dummychar;
  end;
end;

function StripCR(s: AnsiString): AnsiString;
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 GGGetEnvironmentVariable(const Name: string): string;
{$ifdef DELPHI5OROLDER}
var
  Len: DWORD;
{$endif}
begin
  {$ifdef DELPHI5OROLDER}
  SetLength(Result, 1024);
  Len := Windows.GetEnvironmentVariable(PChar(Name), PChar(Result), 1024);
  SetLength(Result, Len);
  if Len > 1024 then
    if Windows.GetEnvironmentVariable(PChar(Name),PChar(Result), Len) <> Len then
      Result := 'ERROR: Windows environment changes concurrently with this application';
  {$endif}
  {$ifndef DELPHI5OROLDER}
  Result := SysUtils.GetEnvironmentVariable(Name);
  {$endif}
end;

function StartsWith(const Text, StartText: string; CaseInsensitive: Boolean = False): Boolean;
var
  Len, i: Integer;
begin
  Result := False;
  Len := Length(StartText);
  if Len > Length(Text) then
    Exit;
  if CaseInsensitive then
  begin
    for i := 1 to Len do
      if UpCase(Text[i]) <> UpCase(StartText[i]) then
        Exit;
  end
  else
  begin
    for i := 1 to Len do
      if Text[i] <> StartText[i] then
        Exit;
  end;
  Result := True;
end;

function EndsWith(const Text, EndText: string; CaseInsensitive: Boolean): Boolean;
var
  Len, i, x: Integer;
begin
  Result := False;
  Len := Length(EndText);
  x := Length(Text);
  if Len > x then
    Exit;
  if CaseInsensitive then
  begin
    for i := Len downto 1 do
      if UpCase(Text[x]) <> UpCase(EndText[i]) then
        Exit
      else
        Dec(x);
  end
  else
  begin
    for i := Len downto 1 do
      if Text[x] <> EndText[i] then
        Exit
      else
        Dec(x);
  end;
  Result := True;
end;

function IsInDirStrOf(const Filename, Dir: string): Boolean;
begin
  Result := StartsWith(Filename, Dir, {$ifdef MSWINDOWS}True{$else}False{$endif});
end;

function EndsWithFilename(const Path, Filename: string): Boolean;
begin
  Result := EndsWith(Path, Filename, {$ifdef MSWINDOWS}True{$else}False{$endif});
end;

{$ifdef CLR}
function TrimCopy(const S: string; Index, Count: Integer): string; overload;
var
  Len, StartIndex, EndIndex: Integer;
begin
  Result := '';

  Len := Length(S);
  if Index <= 0 then
    Index := 1;
  if Count > Len then
    Count := Len;

  if (Count > 0) and (Len > 0) then
  begin
    StartIndex := Index;
    while (StartIndex <= Len) and (S[StartIndex] <= #32) do
      Inc(StartIndex);
    Dec(Count, StartIndex - Index);

    EndIndex := StartIndex + Count - 1;
    if EndIndex > Len then
    begin
      Dec(Count, EndIndex - Len);
      EndIndex := Len;
    end;

    while (EndIndex > 0) and (S[EndIndex] <= #32) do
    begin
      Dec(EndIndex);
      Dec(Count);
    end;

    if EndIndex >= StartIndex then
      Result := Copy(S, StartIndex, Count);
  end;
end;
{$endif}

function TrimCopy(const S: AnsiString; Index, Count: Integer): AnsiString; overload;
var
  Len, StartIndex, EndIndex: Integer;
begin
  Result := '';

  Len := Length(S);
  if Index <= 0 then
    Index := 1;
  if Count > Len then
    Count := Len;

  if (Count > 0) and (Len > 0) then
  begin
    StartIndex := Index;
    while (StartIndex <= Len) and (S[StartIndex] <= #32) do
      Inc(StartIndex);
    Dec(Count, StartIndex - Index);

    EndIndex := StartIndex + Count - 1;
    if EndIndex > Len then
    begin
      Dec(Count, EndIndex - Len);
      EndIndex := Len;
    end;

    while (EndIndex > 0) and (S[EndIndex] <= #32) do
    begin
      Dec(EndIndex);
      Dec(Count);
    end;

    if EndIndex >= StartIndex then
      {$ifdef CLR}
      Result := Copy(S, StartIndex, Count);
      {$else}
      SetString(Result, PChar(Pointer(S)) + StartIndex - 1, Count);
      {$endif CLR}
  end;
end;

function LF2LineBreakA(s: AnsiString): AnsiString;
{$ifdef MSWINDOWS}
var
  i: Integer;
{$endif}
begin
  {$ifdef MSWINDOWS}
  Assert(sLinebreak = #13#10);
  i := 1;
  while i <= Length(s) do
  begin
    if (s[i] = #10) and (i > 1) and (s[i - 1] <> #13) then
    begin
      Insert(#13, s, i);
      Inc(i, 2);
    end
    else
      Inc(i);
  end;
  {$endif}
  Result := s;
end;

function IsWriteProp(Info: PPropInfo): Boolean;
begin
  {$ifndef CLR}
  Result := Assigned(Info) and (Info^.SetProc <> nil);
  {$else}
  Result := Assigned(Info) and CanWrite(Info);
  {$endif}
end;

{ not used }
{
function string2csyntax(const s: AnsiString): AnsiString;
  // Converts a string to the syntax that is used in .po files
var
  i: Integer;
  c: AnsiChar;
begin
  Result := '';
  for i := 1 to Length(s) do
  begin
    c := s[i];
    case c of
      #32..#33, #35..#255: Result := Result + c;
      #13: Result := Result + '\r';
      #10: Result := Result + '\n"'#13#10'"';
      #34: Result := Result + '\"';
      else
        Result := Result + '\0x' + IntToHex(Ord(c), 2);
    end;
  end;
  Result := '"' + Result + '"';
end;
}

{$ifdef DELPHI5OROLDER}
function GetPropList(AObject: TObject; out PropList: PPropList): Integer;