paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-22 21:29:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved to fcl, since it needs classes

Browse Source
This commit is contained in:
michael 1999-08-04 11:28:11 +00:00
parent be3155fdde
commit 8e54ea14a0
1 changed files with 0 additions and 259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

259
rtl/objpas/gettext.pp
View File

@ -1,259 +0,0 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1998 by the Free Pascal development team
Gettext interface to resourcestrings.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$MODE objfpc}
{$H+}
unit gettext;
interface
uses sysutils, classes;
const
MOFileHeaderMagic = $950412de;
type
TMOFileHeader = packed record
magic: LongWord; // MOFileHeaderMagic
revision: LongWord; // 0
nstrings: LongWord; // Number of string pairs
OrigTabOffset: LongWord; // Offset of original string offset table
TransTabOffset: LongWord; // Offset of translated string offset table
HashTabSize: LongWord; // Size of hashing table
HashTabOffset: LongWord; // Offset of first hashing table entry
end;
TMOStringInfo = packed record
length: LongWord;
offset: LongWord;
end;
TMOStringTable = array[LongWord] of TMOStringInfo;
PMOStringTable = ^TMOStringTable;
TLongWordArray = array[LongWord] of LongWord;
PLongWordArray = ^TLongWordArray;
TPCharArray = array[LongWord] of PChar;
PPCharArray = ^TPCharArray;
TMOFile = class
protected
HashTableSize: LongWord;
HashTable: PLongWordArray;
OrigTable, TranslTable: PMOStringTable;
OrigStrings, TranslStrings: PPCharArray;
public
constructor Create(AFilename: String);
constructor Create(AStream: TStream);
function Translate(AOrig: PChar; ALen: Integer; AHash: LongWord): String;
function Translate(AOrig: String; AHash: LongWord): String;
function Translate(AOrig: String): String;
end;
EMOFileError = class(Exception)
end;
function CalcHash(s: String): LongWord;
procedure TranslateResourceStrings(AFile: TMOFile);
procedure TranslateResourceStrings(AFilename: String);
implementation
uses dos;
function CalcHash(s: String): LongWord;
var
g, i : LongWord;
begin
Result := 0;
for i := 1 to Length(s) do begin
Result := Result shl 4 + Ord(s[i]);
g := Result and ($f shl 28);
if g <> 0 then
Result := (Result xor (g shr 24)) xor g;
end;
if Result = 0 then Result := not 0;
end;
constructor TMOFile.Create(AStream: TStream);
var
header: TMOFileHeader;
i: Integer;
s: String;
begin
inherited Create;
AStream.Read(header, Sizeof(header));
if header.magic <> MOFileHeaderMagic then
raise EMOFileError.Create('Invalid magic - not a MO file?');
{ WriteLn('Revision: ', header.revision);
WriteLn('# of strings: ', header.nstrings);
WriteLn('OrigTabOffset: ', header.OrigTabOffset);
WriteLn('TransTabOffset: ', header.TransTabOffset);
WriteLn('# of hashcodes: ', header.HashTabSize);
WriteLn('HashTabOffset: ', header.HashTabOffset);
}
GetMem(OrigTable, header.nstrings * SizeOf(TMOStringInfo));
GetMem(TranslTable, header.nstrings * SizeOf(TMOStringInfo));
GetMem(OrigStrings, header.nstrings * SizeOf(PChar));
GetMem(TranslStrings, header.nstrings * SizeOf(PChar));
AStream.Position := header.OrigTabOffset;
AStream.Read(OrigTable^, header.nstrings * SizeOf(TMOStringInfo));
AStream.Position := header.TransTabOffset;
AStream.Read(TranslTable^, header.nstrings * SizeOf(TMOStringInfo));
// Read strings
for i := 0 to header.nstrings - 1 do begin
AStream.Position := OrigTable^[i].offset;
SetLength(s, OrigTable^[i].length);
AStream.Read(s[1], OrigTable^[i].length);
OrigStrings^[i] := StrNew(PChar(s));
end;
for i := 0 to header.nstrings - 1 do begin
AStream.Position := TranslTable^[i].offset;
SetLength(s, TranslTable^[i].length);
AStream.Read(s[1], TranslTable^[i].length);
TranslStrings^[i] := StrNew(PChar(s));
end;
// Read hashing table
HashTableSize := header.HashTabSize;
GetMem(HashTable, 4 * HashTableSize);
AStream.Position := header.HashTabOffset;
AStream.Read(HashTable^, 4 * HashTableSize);
end;
constructor TMOFile.Create(AFilename: String);
var
f: TStream;
begin
f := TFileStream.Create(AFilename, fmOpenRead);
try
Self.Create(f);
finally
f.Free;
end;
end;
function TMOFile.Translate(AOrig: PChar; ALen: Integer; AHash: LongWord): String;
var
idx, incr, nstr: LongWord;
begin
idx := AHash mod HashTableSize;
incr := 1 + (AHash mod (HashTableSize - 2));
while True do begin
nstr := HashTable^[idx];
if nstr = 0 then begin
Result := '';
exit;
end;
if (OrigTable^[nstr - 1].length = ALen) and
(StrComp(OrigStrings^[nstr - 1], AOrig) = 0) then begin
Result := TranslStrings^[nstr - 1];
exit;
end;
if idx >= HashTableSize - incr then
Dec(idx, HashTableSize - incr)
else
Inc(idx, incr);
end;
end;
function TMOFile.Translate(AOrig: String; AHash: LongWord): String;
begin
Result := Translate(PChar(AOrig), Length(AOrig), AHash);
end;
function TMOFile.Translate(AOrig: String): String;
begin
Result := Translate(AOrig, CalcHash(AOrig));
end;
// -------------------------------------------------------
// Resourcestring translation procedures
// -------------------------------------------------------
type
TResourceStringRecord = Packed Record
DefaultValue, CurrentValue: AnsiString;
HashValue: longint;
end;
TResourceStringTable = Packed Record
Count : longint;
Resrec : Array[Word] of TResourceStringRecord;
end;
Var
ResourceStringTable: TResourceStringTable; External Name 'RESOURCESTRINGLIST';
procedure TranslateResourceStrings(AFile: TMOFile);
var
rst: ^TResourceStringTable;
i: Integer;
s: String;
begin
rst := @ResourceStringTable;
for i := 0 to rst^.Count - 1 do begin
// WriteLn(i, ': ', rst^.resrec[i].DefaultValue, ' / ', rst^.resrec[i].CurrentValue, ' / ', rst^.resrec[i].HashValue);
s := AFile.Translate(rst^.resrec[i].DefaultValue);
if s <> '' then
rst^.resrec[i].CurrentValue := s;
end;
end;
procedure TranslateResourceStrings(AFilename: String);
var
mo: TMOFile;
lang: String;
begin
lang := Copy(GetEnv('LANG'), 1, 2);
try
mo := TMOFile.Create(Format(AFilename, [lang]));
TranslateResourceStrings(mo);
mo.Free;
except
on e: Exception do;
end;
end;
end.
{
$Log$
Revision 1.1 1999-07-25 16:23:31 michael
+ Initial implementation from Sebastian Guenther
}