Стартовый пул

2024-04-02 08:46:59 +03:00
parent fd57fffd3a
commit 3bb34d000b
5591 changed files with 3291734 additions and 0 deletions
--- a/viewer/MappingFile.pas
+++ b/viewer/MappingFile.pas
@@ -0,0 +1,349 @@
+{ **************************************************** }
+{ MappingFile unit v1.0 for Delphi                     }
+{ Copyright (c) Razumikhin Dmitry, 2005                }
+{ E-mail: razumikhin_d@mail.ru                         }
+{                                                      }
+{ Use under terms LGPL license:                        }
+{ http://www.gnu.org/copyleft/lesser.html              }
+{ **************************************************** }
+unit MappingFile;
+
+interface
+uses
+  SysUtils, Windows, Classes, RTLConsts;
+
+type
+  EFileMappingError = class(Exception);
+
+  TMappingFile = class
+  private
+    fHandle: Integer;        //file handle
+    fFileName: string;       //file name
+    fMode: Word;             //file open mode
+    fMappingHandle: THandle; //handle of mapping file
+    fBaseAddress: PChar;     //address of file image in memory
+    fPos: Integer;           //current position
+    fSize: Integer;          //size of real data
+    fCapacity: Integer;      //size of allocated memory
+    fExtraMem: Integer;       
+    function GetChar(Index: Integer): Char;
+    procedure SetSize(const Value: Integer);
+    procedure SetChar(Index: Integer; const Value: Char);
+    procedure TryMount;
+    procedure ReMount;
+    procedure SetCapacity(const Value: Integer);
+    procedure SetPos(const Value: Integer);
+  public
+    property BaseAddress: PChar read fBaseAddress;
+    property Size: Integer read fSize write SetSize;
+    property Capacity: Integer read fCapacity write SetCapacity;
+    property ExtraMem: Integer read fExtraMem write fExtraMem;
+    property Ch[Index: Integer]: Char read GetChar write SetChar;
+    property Position: Integer read fPos write SetPos;
+
+    function Seek(Offset, Origin: Integer): Integer;
+    //read functions
+    function ReadCh(out Ch: Char): Boolean;
+    function ReadStr(out Str: string; Len: Integer): Boolean; overload;
+    function ReadStr(const Index, Len: Integer): string; overload;
+
+    function Find(Ch: Char; StartIndex: Integer = 0): Integer;
+    //write functions
+    procedure WriteCh(const Ch: Char);
+    procedure WriteStr(const Str: string); overload;
+    procedure WriteStr(const Str: string; Index: Integer); overload;
+    procedure WriteBuffer(const Buf: PChar; Count: Integer); overload;
+    procedure WriteBuffer(const Buf: PChar; Index, Count: Integer); overload;
+
+    //insert functions (expand + write)
+    procedure InsertBuffer(const Buf: PChar; Count: Integer); overload;
+    procedure InsertBuffer(const Buf: PChar; Index, Count: Integer); overload;
+    procedure InsertStr(const Str: string); overload;
+    procedure InsertStr(const Str: string; Index: Integer); overload;
+
+    constructor Create(const FileName: string; Mode: Word);
+    destructor Destroy; override;
+  end;
+
+function FileResize(Handle: THandle; Size: Integer): LongBool;
+function FileMount(var MappingHandle: THandle; const FileHandle: Integer; ReadOnly: Boolean = True): Pointer;
+procedure FileUmount(MappingHandle: THandle; BaseAddress: Pointer);
+
+implementation
+
+{ TMappingFile }
+
+constructor TMappingFile.Create(const FileName: string; Mode: Word);
+begin
+  inherited Create;
+  fFileName:=FileName;
+  fMode:=Mode;
+  fPos:=0;
+  fSize:=0;
+  fCapacity:=0;
+  fExtraMem:=1024;
+  fBaseAddress:=nil;
+  if Mode = fmCreate then
+    begin
+    fHandle:=FileCreate(FileName);
+    if fHandle < 0 then
+      raise EFCreateError.CreateResFmt(@SFCreateErrorEx, [ExpandFileName(FileName), SysErrorMessage(GetLastError)]);
+    end
+  else
+    begin
+    fHandle:=FileOpen(FileName, Mode);
+    if fHandle < 0 then
+      raise EFOpenError.CreateResFmt(@SFOpenErrorEx, [ExpandFileName(FileName), SysErrorMessage(GetLastError)]);
+    end;
+  fSize:=GetFileSize(fHandle, nil);
+  fCapacity:=fSize;
+  TryMount;
+end;
+
+destructor TMappingFile.Destroy;
+begin
+  FileUmount(fMappingHandle, fBaseAddress);
+  if fSize <> fCapacity then
+    FileResize(fHandle, fSize);
+  if fHandle >=0 then FileClose(fHandle);
+  inherited;
+end;
+
+function TMappingFile.Find(Ch: Char; StartIndex: Integer): Integer;
+var
+  i: Integer;
+begin
+  for i:=StartIndex to fSize-1 do
+    if Ch = PChar(fBaseAddress + i)^ then
+      begin
+      Result:=i;
+      Exit;
+      end;
+  Result:=-1;
+end;
+
+function TMappingFile.GetChar(Index: Integer): Char;
+begin
+  Result:=PChar(fBaseAddress + Index)^; //Not control the bounds
+end;
+
+procedure TMappingFile.InsertBuffer(const Buf: PChar; Count: Integer);
+begin
+  InsertBuffer(Buf, fPos, Count);
+  Inc(fPos, Count);
+end;
+
+procedure TMappingFile.InsertBuffer(const Buf: PChar; Index,
+  Count: Integer);
+var
+  MoveCount: Integer;
+begin
+  if Count <> 0 then
+    begin
+    MoveCount:=fSize - Index;
+    SetSize(fSize + Count);
+    Move(PChar(fBaseAddress + Index)^, PChar(fBaseAddress + Index + Count)^, MoveCount);
+    Move(Buf^, PChar(fBaseAddress + Index)^, Count);
+    end;
+end;
+
+procedure TMappingFile.InsertStr(const Str: string);
+begin
+  InsertBuffer(PChar(Str), Length(Str));
+end;
+
+procedure TMappingFile.InsertStr(const Str: string; Index: Integer);
+begin
+  InsertBuffer(PChar(Str), Index, Length(Str));
+end;
+
+function TMappingFile.ReadCh(out Ch: Char): Boolean;
+begin
+  Result:=fPos < fSize;
+  if Result then
+    begin
+    Ch:=PChar(fBaseAddress + fPos)^;
+    Inc(fPos, SizeOf(Char));
+    end
+  else
+    Ch:=#0;
+end;
+
+function TMappingFile.ReadStr(out Str: string; Len: Integer): Boolean;
+begin
+  Result:=(fPos + Len) <= fSize;
+  SetLength(Str, Len);
+  Move(PChar(fBaseAddress + fPos)^, Str[1], Len);
+  Inc(fPos, Len);
+end;
+
+function TMappingFile.ReadStr(const Index, Len: Integer): string;
+begin
+  SetLength(Result, Len);
+  Move(PChar(fBaseAddress + Index)^, Result[1], Len);
+end;
+
+procedure TMappingFile.Remount;
+begin
+  if Assigned(fBaseAddress) then
+    FileUmount(fMappingHandle, fBaseAddress);
+  TryMount;
+end;
+
+function TMappingFile.Seek(Offset, Origin: Integer): Integer;
+var
+  NewPos: Integer;
+begin
+  Result:=-1;
+  case Origin of
+    0:
+      begin
+      if Offset >= 0 then
+        begin
+        if (Offset > fSize) then
+          SetSize(Offset);
+        fPos:=Offset;
+        Result:=Offset;
+        end;
+      end;
+    1:
+      begin
+      NewPos:= fPos + Offset;
+      if NewPos >=0 then
+        begin
+        if (NewPos > fSize) then
+          SetSize(NewPos);
+        fPos:=NewPos;
+        Result:=NewPos;
+        end;
+      end;
+    2:
+      begin
+      NewPos:=fSize - Offset - 1;
+      if NewPos >=0 then
+        begin
+        if (NewPos > fSize) then
+          SetSize(NewPos);
+        fPos:=NewPos;
+        Result:=NewPos;
+        end;
+      end;
+  end;
+end;
+
+procedure TMappingFile.SetCapacity(const Value: Integer);
+begin
+  if fCapacity <> Value then
+    begin
+    fCapacity := Value;
+    FileResize(fHandle, fCapacity);
+    Remount;
+    end;
+end;
+
+procedure TMappingFile.SetChar(Index: Integer; const Value: Char);
+begin
+  PChar(fBaseAddress + Index)^:=Value;  //Not control the bounds
+end;
+
+procedure TMappingFile.SetPos(const Value: Integer);
+begin
+  Seek(Value, 0);
+end;
+
+procedure TMappingFile.SetSize(const Value: Integer);
+begin
+  if fSize <> Value then
+    begin
+    fSize := Value;
+    if fPos >= fSize then fPos:=fSize - 1;
+    if fSize > fCapacity then
+      SetCapacity(fSize + fExtraMem);
+    end;
+end;
+
+procedure TMappingFile.TryMount;
+begin
+  if fSize > 0 then
+    begin
+    fBaseAddress:=FileMount(fMappingHandle, fHandle, fMode = fmOpenRead);
+    if not Assigned(fBaseAddress) then
+      raise EFileMappingError.CreateFmt('Could not mapped file ''%s''',[fFileName]);
+    end;
+end;
+
+procedure TMappingFile.WriteBuffer(const Buf: PChar;
+  Count: Integer);
+begin
+  if (fPos + Count) > fSize then
+    SetSize(fPos + Count);
+  Move(Buf^, PChar(fBaseAddress + fPos)^, Count);
+  fPos:=fPos + Count;
+end;
+
+procedure TMappingFile.WriteBuffer(const Buf: PChar; Index,
+  Count: Integer);
+begin
+  if (Index + Count) > fSize then
+    SetSize(Index + Count);
+  Move(Buf^, PChar(fBaseAddress + Index)^, Count);
+end;
+
+procedure TMappingFile.WriteCh(const Ch: Char);
+begin
+  WriteBuffer(@Ch, SizeOf(Char));
+end;
+
+procedure TMappingFile.WriteStr(const Str: string);
+begin
+  WriteBuffer(PChar(Str), Length(Str));
+end;
+
+procedure TMappingFile.WriteStr(const Str: string; Index: Integer);
+begin
+  WriteBuffer(PChar(Str), Index, Length(Str));
+end;
+
+//-----------------------------------------------------------------------
+
+function FileMount(var MappingHandle: THandle; const FileHandle: Integer; ReadOnly: Boolean = True): Pointer;
+var
+  FileMappingMode,
+  MapViewMode: DWORD;
+begin
+  if ReadOnly then
+    begin
+    FileMappingMode:=PAGE_READONLY;
+    MapViewMode:=FILE_MAP_READ;
+    end
+  else
+    begin
+    FileMappingMode:=PAGE_READWRITE;
+    MapViewMode:=FILE_MAP_READ + FILE_MAP_WRITE;
+    end;
+
+  MappingHandle:=CreateFileMapping(FileHandle, nil, FileMappingMode, 0, 0, nil);
+  if MappingHandle <> 0 then
+    begin
+    Result:=MapViewOfFile(MappingHandle, MapViewMode, 0, 0, 0);
+    end
+  else
+    Result:=nil;
+end;
+
+procedure FileUmount(MappingHandle: THandle; BaseAddress: Pointer);
+begin
+  if Assigned(BaseAddress) then
+    UnmapViewOfFile(BaseAddress);
+  if MappingHandle <> 0 then
+    CloseHandle(MappingHandle);
+end;
+
+function FileResize(Handle: THandle; Size: Integer): LongBool;
+begin
+  FileSeek(Handle, Size, 0);
+  Result:=SetEndOfFile(Handle);
+end;
+
+end.
+
--- a/viewer/unicodeutils.pas
+++ b/viewer/unicodeutils.pas
@@ -0,0 +1,518 @@
+{
+  Most of this code is based on similar functions from Lazarus LCLProc.
+}
+
+unit UnicodeUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils; 
+
+{en
+   Retrieves length in bytes of the next UTF-8 character.
+
+   @param(P
+          Pointer to the UTF-8 characters.)
+   @param(aMaxBytes
+          States how many bytes from P can be read.)
+   @param(InvalidCharLen
+          If an invalid UTF-8 character was found then InvalidCharLen has
+          the number of bytes this character spans. If the character was valid
+          InvalidCharLen is zero.)
+}
+function SafeUTF8NextCharLen(P: PByte; aMaxBytes: Integer; out InvalidCharLen: Integer): Integer;
+
+{en
+   Retrieves length in bytes of the previous UTF-8 character.
+   It does not read from P, but rather from memory locations before P.
+
+   @param(P
+          Pointer to the UTF-8 characters.)
+   @param(aMaxBytes
+          States how many bytes from P *backwards* can be read.
+          So, to safely read 3 bytes backwards ([p-1], [p-2], [p-3])
+          this parameter should be at least 3.)
+   @param(InvalidCharLen
+          If an invalid UTF-8 character was found then InvalidCharLen has
+          the number of bytes this character spans. If the character was valid
+          InvalidCharLen is zero.)
+}
+function SafeUTF8PrevCharLen(P: PByte; aMaxBytes: Integer; out InvalidCharLen: Integer): Integer;
+function SafeUTF8NextCharStart(UTF8Str: PByte; Len: PtrInt): PByte;
+function SafeUTF8PrevCharEnd(UTF8Str: PByte; Len: PtrInt): PByte;
+{en
+   Returns UTF-16 character length, which is either 1 or 2.
+   @param(utf16char
+          Any UTF-16 char or one of the surrogate pairs.)
+}
+function UTF16CharLen(utf16char: Word): Integer;
+{en
+   Converts an UTF-16 surrogate pair into a unicode character.
+}
+function utf16PairToUnicode(u1, u2: Word): Cardinal;
+
+function Utf16LEToUtf8(const s: string): string; // UTF16-LE 2 or 4 byte little endian
+function Utf16BEToUtf8(const s: string): string; // UTF16-BE 2 or 4 byte big endian
+function Utf32LEToUtf8(const s: string): string; // UTF32-LE 4 byte little endian
+function Utf32BEToUtf8(const s: string): string; // UTF32-BE 4 byte big endian
+
+function Utf8ToUtf16LE(const s: string): string; // UTF16-LE 2 or 4 byte little endian
+function Utf8ToUtf16BE(const s: string): string; // UTF16-BE 2 or 4 byte big endian
+
+{en
+   Replaces invalid UTF-8 characters with '?'.
+}
+function Utf8ReplaceBroken(const s: UTF8String): UTF8String;
+
+implementation
+
+uses
+  LCLProc, LazUTF8;
+
+const
+  maxUTF8Len = 7;  // really is 4, but this includes any invalid characters up to length 7
+
+function SafeUTF8NextCharLen(P: PByte; aMaxBytes: Integer; out InvalidCharLen: Integer): Integer;
+var
+  BytesLen: Integer;
+  i: Integer;
+begin
+  if (p=nil) or (aMaxBytes = 0) then
+  begin
+    InvalidCharLen := 0;
+    Result := 0;
+  end
+  else if p^<%10000000 then begin
+    // regular single byte character
+    InvalidCharLen := 0;
+    Result := 1;
+  end
+  else if p^<%11000000 then begin
+    // invalid single byte character
+    InvalidCharLen := 1;
+    Result := 1;
+  end
+  else
+  begin
+    // Read length of UTF-8 character in bytes.
+         if ((p^ and %11100000) = %11000000) then BytesLen := 2
+    else if ((p^ and %11110000) = %11100000) then BytesLen := 3
+    else if ((p^ and %11111000) = %11110000) then BytesLen := 4
+    else if ((p^ and %11111100) = %11111000) then BytesLen := 5
+    else if ((p^ and %11111110) = %11111100) then BytesLen := 6
+    else if ((p^ and %11111111) = %11111110) then BytesLen := 7
+    else
+      begin
+        InvalidCharLen := 1;
+        exit(1);
+      end;
+
+    // Check if the next bytes are from the middle of a character.
+    for i := 1 to BytesLen - 1 do
+    begin
+      if (aMaxBytes < i) or ((p[i] and %11000000) <> %10000000) then
+      begin
+        InvalidCharLen := i;
+        exit(1);
+      end;
+    end;
+
+    InvalidCharLen := 0;
+    Result := BytesLen;
+  end;
+end;
+
+function SafeUTF8PrevCharLen(P: PByte; aMaxBytes: Integer; out InvalidCharLen: Integer): Integer;
+var
+  BytesLen: Integer;
+  signature: Byte;
+begin
+  if (p=nil) or (aMaxBytes = 0) then
+  begin
+    InvalidCharLen := 0;
+    Result := 0;
+  end
+  else if p[-1]<%10000000 then begin
+    // regular single byte character
+    InvalidCharLen := 0;
+    Result := 1;
+  end
+  else
+  begin
+    for BytesLen := 1 to maxUTF8Len do
+    begin
+      if (aMaxBytes < BytesLen) then
+      begin
+        InvalidCharLen := aMaxBytes;
+        exit(1);
+      end;
+
+      // Move past all the bytes in the middle of a character.
+      if (p[-BytesLen] and %11000000) <> %10000000 then
+        break;
+
+      if BytesLen = maxUTF8Len then
+      begin
+        InvalidCharLen := BytesLen;
+        exit(1);
+      end;
+    end;
+
+    if p[-BytesLen]<%11000000 then
+    begin
+      // invalid first byte of a character
+      InvalidCharLen := BytesLen;
+      Result := 1;
+    end
+    else
+    begin
+      signature := Byte($FF shl (7 - BytesLen));
+      if (p[-BytesLen] and signature) = Byte(signature shl 1) then
+      begin
+        // Correct first byte of a character.
+        InvalidCharLen := 0;
+        Result := BytesLen;
+      end
+      else
+      begin
+        // Invalid first byte of a character, or p is in the middle of a character.
+        InvalidCharLen := BytesLen;
+        Result := 1;
+      end;
+    end;
+  end;
+end;
+
+function SafeUTF8NextCharStart(UTF8Str: PByte; Len: PtrInt): PByte;
+var
+  CharLen: LongInt;
+  InvalidCharLen: Integer;
+begin
+  Result:=UTF8Str;
+  if Result<>nil then begin
+    while (Len>0) do begin
+      CharLen := SafeUTF8NextCharLen(Result, Len, InvalidCharLen);
+      if InvalidCharLen > 0 then
+      begin
+        dec(Len,InvalidCharLen);
+        inc(Result,InvalidCharLen);
+      end
+      else if CharLen = 0 then
+        exit(nil)
+      else
+        exit(Result);
+    end;
+    Result:=nil;
+  end;
+end;
+
+function SafeUTF8PrevCharEnd(UTF8Str: PByte; Len: PtrInt): PByte;
+var
+  CharLen: LongInt;
+  InvalidCharLen: Integer;
+begin
+  Result:=UTF8Str;
+  if Result<>nil then begin
+    while (Len>0) do begin
+      CharLen := SafeUTF8PrevCharLen(Result, Len, InvalidCharLen);
+      if InvalidCharLen > 0 then
+      begin
+        dec(Len,InvalidCharLen);
+        dec(Result,InvalidCharLen);
+      end
+      else if CharLen = 0 then
+        exit(nil)
+      else
+        exit(Result);  // Result is the character beginning
+    end;
+    Result:=nil;
+  end;
+end;
+
+function UTF16CharLen(utf16char: Word): Integer; inline;
+begin
+  if (utf16char < $D800) or (utf16char > $DFFF) then
+    Result := 1
+  else
+    Result := 2;
+end;
+
+function utf16PairToUnicode(u1, u2: Word): Cardinal;
+begin
+  if (u1 >= $D800) and (u1 <= $DBFF) then
+  begin
+    if (u2 >= $DC00) and (u2 <= $DFFF) then
+      Result := (Cardinal(u1 - $D800) shl 10) + Cardinal(u2 - $DC00) + $10000
+    else
+      Result := 0;
+  end
+  else
+    Result := u1;
+end;
+
+function Utf16LEToUtf8(const s: string): string;
+var
+  len: Integer;
+  Src, Limit: PWord;
+  Dest: PAnsiChar;
+  u: Cardinal;
+begin
+  if Length(s) < 2 then begin
+    Result:='';
+    exit;
+  end;
+  Src:=PWord(Pointer(s));
+  Limit := PWord(Pointer(Src) + Length(s));
+  SetLength(Result, length(s) * 2);
+  Dest:=PAnsiChar(Result);
+  while Src + 1 <= Limit do begin
+    len := UTF16CharLen(Src^);
+    if len = 1 then
+      u := LEtoN(Src^)
+    else
+    begin
+      if Src + 2 <= Limit then
+        u := utf16PairToUnicode(LEtoN(Src[0]), LEtoN(Src[1]))
+      else
+        break;
+    end;
+    inc(Src, len);
+    if u<128 then begin
+      Dest^:=chr(u);
+      inc(Dest);
+    end else begin
+      inc(Dest,UnicodeToUTF8SkipErrors(u,Dest));
+    end;
+  end;
+  len:=PtrUInt(Dest)-PtrUInt(Result);
+  if len>length(Result) then
+    RaiseGDBException('');
+  SetLength(Result,len);
+end;
+
+function Utf16BEToUtf8(const s: string): string;
+var
+  len: Integer;
+  Src, Limit: PWord;
+  Dest: PAnsiChar;
+  u: Cardinal;
+begin
+  if Length(s) < 2 then begin
+    Result:='';
+    exit;
+  end;
+  Src:=PWord(Pointer(s));
+  Limit := PWord(Pointer(Src) + Length(s));
+  SetLength(Result, length(s) * 2);
+  Dest:=PAnsiChar(Result);
+  while Src + 1 <= Limit do begin
+    len := UTF16CharLen(Src^);
+    if len = 1 then
+      u := BEtoN(Src^)
+    else
+    begin
+      if Src + 2 <= Limit then
+        u := utf16PairToUnicode(BEtoN(Src[0]), BEtoN(Src[1]))
+      else
+        break;
+    end;
+    inc(Src, len);
+    if u<128 then begin
+      Dest^:=chr(u);
+      inc(Dest);
+    end else begin
+      inc(Dest,UnicodeToUTF8SkipErrors(u,Dest));
+    end;
+  end;
+  len:=PtrUInt(Dest)-PtrUInt(Result);
+  if len>length(Result) then
+    RaiseGDBException('');
+  SetLength(Result,len);
+end;
+
+function Utf32LEToUtf8(const s: string): string;
+var
+  len: Integer;
+  Src: PLongWord;
+  Dest: PAnsiChar;
+  i: Integer;
+  c: LongWord;
+begin
+  if Length(s) < 4 then begin
+    Result:='';
+    exit;
+  end;
+  len:=length(s) div 4;
+  SetLength(Result,len*4);
+  Src:=PLongWord(Pointer(s));
+  Dest:=PAnsiChar(Result);
+  for i:=1 to len do begin
+    c:=LEtoN(Src^);
+    inc(Src);
+    if c<128 then begin
+      Dest^:=chr(c);
+      inc(Dest);
+    end else begin
+      inc(Dest,UnicodeToUTF8SkipErrors(c,Dest));
+    end;
+  end;
+  len:=PtrUInt(Dest)-PtrUInt(Result);
+  if len>length(Result) then
+    RaiseGDBException('');
+  SetLength(Result,len);
+end;
+
+function Utf32BEToUtf8(const s: string): string;
+var
+  len: Integer;
+  Src: PLongWord;
+  Dest: PAnsiChar;
+  i: Integer;
+  c: LongWord;
+begin
+  if Length(s) < 4 then begin
+    Result:='';
+    exit;
+  end;
+  len:=length(s) div 4;
+  SetLength(Result,len*4);
+  Src:=PLongWord(Pointer(s));
+  Dest:=PAnsiChar(Result);
+  for i:=1 to len do begin
+    c:=BEtoN(Src^);
+    inc(Src);
+    if c<128 then begin
+      Dest^:=chr(c);
+      inc(Dest);
+    end else begin
+      inc(Dest,UnicodeToUTF8SkipErrors(c,Dest));
+    end;
+  end;
+  len:=PtrUInt(Dest)-PtrUInt(Result);
+  if len>length(Result) then
+    RaiseGDBException('');
+  SetLength(Result,len);
+end;
+
+function Utf8ToUtf16LE(const s: string): string;
+var
+  P: PWord;
+  I, L: SizeUInt;
+begin
+  if Length(S) = 0 then
+  begin
+    Result := '';
+    Exit;
+  end;
+  // Wide chars of UTF-16 <= bytes of UTF-8 string
+  SetLength(Result, Length(S) * SizeOf(WideChar));
+  if ConvertUTF8ToUTF16(PWideChar(PAnsiChar(Result)), Length(Result) + SizeOf(WideChar),
+                        PAnsiChar(S), Length(S), [toInvalidCharToSymbol], L) <> trNoError
+  then
+    Result := ''
+  else
+    begin
+      SetLength(Result, (L - 1) * SizeOf(WideChar));
+      // Swap endian if needed
+      if (NtoLE($FFFE) <> $FFFE) then
+      begin
+        P := PWord(PAnsiChar(Result));
+        for I := 0 to L - 1 do
+        begin
+          P[I] := SwapEndian(P[I]);
+        end;
+      end;
+    end;
+end;
+
+function Utf8ToUtf16BE(const s: string): string;
+var
+  P: PWord;
+  I, L: SizeUInt;
+begin
+  if Length(S) = 0 then
+  begin
+    Result := '';
+    Exit;
+  end;
+  // Wide chars of UTF-16 <= bytes of UTF-8 string
+  SetLength(Result, Length(S) * SizeOf(WideChar));
+  if ConvertUTF8ToUTF16(PWideChar(PAnsiChar(Result)), Length(Result) + SizeOf(WideChar),
+                        PAnsiChar(S), Length(S), [toInvalidCharToSymbol], L) <> trNoError
+  then
+    Result := ''
+  else
+    begin
+      SetLength(Result, (L - 1) * SizeOf(WideChar));
+      // Swap endian if needed
+      if (NtoBE($FEFF) <> $FEFF) then
+      begin
+        P := PWord(PAnsiChar(Result));
+        for I := 0 to L - 1 do
+        begin
+          P[I] := SwapEndian(P[I]);
+        end;
+      end;
+    end;
+end;
+
+function Utf8ReplaceBroken(const s: UTF8String): UTF8String;
+var
+  Src, Dst, LastGoodPos: PByte;
+  BytesLeft: Integer;
+  InvalidCharLen: Integer;
+  CharLen: Integer;
+begin
+  if Length(s) = 0 then
+    Exit(s);
+
+  BytesLeft := Length(s);
+  SetLength(Result, BytesLeft); // at most the same length
+
+  Src := PByte(s);
+  Dst := PByte(Result);
+  LastGoodPos := Src;
+
+  while BytesLeft > 0 do
+  begin
+    CharLen := SafeUTF8NextCharLen(Src, BytesLeft, InvalidCharLen);
+    if InvalidCharLen > 0 then
+    begin
+      if LastGoodPos < Src then
+      begin
+        System.Move(LastGoodPos^, Dst^, Src - LastGoodPos);
+        Inc(Dst, Src - LastGoodPos);
+      end;
+
+      Inc(Src, InvalidCharLen);
+      Dec(BytesLeft, InvalidCharLen);
+      LastGoodPos := Src;
+      Dst^ := ord('?');
+      Inc(Dst);
+    end
+    else
+    begin
+      Inc(Src, CharLen);
+      Dec(BytesLeft, CharLen);
+    end;
+  end;
+
+  if LastGoodPos = PByte(s) then
+    Result := s    // All characters are good.
+  else
+  begin
+    if LastGoodPos < Src then
+    begin
+      System.Move(LastGoodPos^, Dst^, Src - LastGoodPos);
+      Inc(Dst, Src - LastGoodPos);
+    end;
+
+    SetLength(Result, Dst - PByte(Result));
+  end;
+end;
+
+end.
+
--- a/viewer/viewercontrol.pas
+++ b/viewer/viewercontrol.pas
--- a/viewer/viewerpackage.lpk
+++ b/viewer/viewerpackage.lpk
@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <Package Version="4">
+    <PathDelim Value="\"/>
+    <Name Value="viewerpackage"/>
+    <Author Value="Radek Červinka"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Parsing>
+        <SyntaxOptions>
+          <UseAnsiStrings Value="False"/>
+        </SyntaxOptions>
+      </Parsing>
+      <Linking>
+        <Debugging>
+          <DebugInfoType Value="dsDwarf2Set"/>
+        </Debugging>
+      </Linking>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Version Major="1"/>
+    <Files Count="2">
+      <Item1>
+        <Filename Value="viewercontrol.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="ViewerControl"/>
+      </Item1>
+      <Item2>
+        <Filename Value="unicodeutils.pas"/>
+        <UnitName Value="UnicodeUtils"/>
+      </Item2>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="2">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item2>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <DestinationDirectory Value="$(TestDir)\publishedpackage\"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>
--- a/viewer/viewerpackage.pas
+++ b/viewer/viewerpackage.pas
@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. do not edit ! 
+  This source is only used to compile and install the package.
+ }
+
+unit viewerpackage; 
+
+interface
+
+uses
+  ViewerControl, UnicodeUtils, LazarusPackageIntf;
+
+implementation
+
+procedure Register; 
+begin
+  RegisterUnit('ViewerControl', @ViewerControl.Register); 
+end; 
+
+initialization
+  RegisterPackage('viewerpackage', @Register); 
+end.