gnugettext.pas

Delphi的串口编程控件

  curlang := LanguageCode;
  gettext_putenv('LANG=' + LanguageCode);
  for i:=0 to domainlist.Count-1 do begin
    dom:=domainlist.Objects[i] as TDomain;
    dom.SetLanguageCode (curlang);
  end;
  {$ifdef LINUX}
  setlocale (LC_MESSAGES, PChar(LanguageCode));
  {$endif}

  l2:=lowercase(copy(curlang,1,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='cs') or (l2='sk') or (l2='uk') or (l2='hr') then curGetPluralForm:=GetPluralForm3RU else
  if (l2='pl') then curGetPluralForm:=GetPluralForm3PL else
  if (l2='sl') then curGetPluralForm:=GetPluralForm4SL else
    curGetPluralForm:=GetPluralForm2EN
end;

procedure TGnuGettextInstance.TranslateStrings(sl: TStrings;TextDomain:string);
var
  s:TStringList;
  line:string;
  i:integer;
begin
  s:=TStringList.Create;
  try
    s.AddStrings (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.Text:=s.Text;
  finally
    FreeAndNil (s);
  end;
end;

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

function TGnuGettextInstance.GetTranslationProperty(
  Propertyname: string): WideString;
var
  sl:TStringList;
  i:integer;
  s:string;
begin
  Propertyname:=uppercase(Propertyname)+': ';
  sl:=TStringList.Create;
  try
    sl.Text:=utf8encode(gettext(''));
    for i:=0 to sl.Count-1 do begin
      s:=sl.Strings[i];
      if uppercase(copy(s,1,length(Propertyname)))=Propertyname then begin
        Result:=utf8decode(trim(copy(s,length(PropertyName)+1,maxint)));
        exit;
      end;
    end;
  finally
    FreeAndNil (sl);
  end;
  Result:='';
end;

function TGnuGettextInstance.dngettext(const szDomain,singular, plural: widestring;
  Number: Integer): widestring;
var
  org,trans:widestring;
  idx:integer;
  p:integer;
begin
  org:=singular+#0+plural;
  trans:=dgettext(szDomain,org);
  if org=trans then
    idx:=GetPluralForm2EN(Number)
  else
    idx:=curGetPluralForm(Number);
  while true do begin
    p:=pos(#0,trans);
    if p=0 then begin
      Result:=trans;
      exit;
    end;
    if idx=0 then begin
      Result:=copy(trans,1,p-1);
      exit;
    end;
    delete (trans,1,p);
    dec (idx);
  end;
end;

function TGnuGettextInstance.ngettext(const singular, plural: widestring;
  Number: Integer): widestring;
begin
  Result := dngettext(curmsgdomain, singular, plural, Number);
end;

{ TClassMode }

constructor TClassMode.Create;
begin
  PropertiesToIgnore:=TStringList.Create;
  PropertiesToIgnore.Sorted:=True;
  PropertiesToIgnore.Duplicates:=dupIgnore;
end;

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

{ TAssemblyAnalyzer }

procedure TAssemblyAnalyzer.Analyze;
var
  s:ansistring;
  i:integer;
  offset:int64;
  fs:TFileStream;
  fi:TAssemblyFileInfo;
  filename:string;
begin
  s:='6637DB2E-62E1-4A60-AC19-C23867046A89'#0#0#0#0#0#0#0#0;
  s:=copy(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:=TAssemblyFileInfo.Create;
        try
          fi.Offset:=ReadInt64(fs);
          fi.Size:=ReadInt64(fs);
          SetLength (filename, offset-fs.position);
          fs.ReadBuffer (filename[1],offset-fs.position);
          filename:=trim(filename);
          filelist.AddObject(filename,fi);
        except
          FreeAndNil (fi);
          raise;
        end;
      end;
    finally
      FreeAndNil (fs);
    end;
  except
  end;
end;

constructor TAssemblyAnalyzer.Create;
begin
  filelist:=TStringList.Create;
  {$ifdef LINUX}
  filelist.Duplicates:=dupError;
  filelist.CaseSensitive:=True;
  {$endif}
  filelist.Duplicates:=dupError;
  filelist.CaseSensitive:=False;
  filelist.Sorted:=True;
end;

destructor TAssemblyAnalyzer.Destroy;
begin
  while filelist.count<>0 do begin
    filelist.Objects[0].Free;
    filelist.Delete (0);
  end;
  FreeAndNil (filelist);
  inherited;
end;

function TAssemblyAnalyzer.FileExists(filename: string): boolean;
var
  idx:integer;
begin
  if copy(filename,1,length(basedirectory))=basedirectory then 
    filename:=copy(filename,length(basedirectory)+1,maxint);
  Result:=filelist.Find(filename,idx);
end;

procedure TAssemblyAnalyzer.GetFileInfo(filename: string;
  var realfilename: string; var offset, size: int64);
var
  fi:TAssemblyFileInfo;
  idx:integer;
begin
  offset:=0;
  size:=0;
  realfilename:=filename;
  if copy(filename,1,length(basedirectory))=basedirectory then begin
    filename:=copy(filename,length(basedirectory)+1,maxint);
    idx:=filelist.IndexOf(filename);
    if idx<>-1 then begin
      fi:=filelist.Objects[idx] as TAssemblyFileInfo;
      realfilename:=ExecutableFilename;
      offset:=fi.offset;
      size:=fi.size;
    end;
  end;
end;

function TAssemblyAnalyzer.ReadInt64(str: TStream): int64;
begin
  Assert (sizeof(Result)=8);
  str.ReadBuffer(Result,8);
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:WideString;
  ppi:PPropInfo;
begin
  for i:=0 to list.Count-1 do begin
    item:=TObject(list.items[i]) as TTP_RetranslatorItem;
    if item.obj is TStrings then begin
      sl:=item.obj as TStrings;
      sl.Text:=item.OldValue;
      Instance.TranslateStrings(sl,textdomain);
    end else begin
      newValue:=instance.dgettext(textdomain,item.OldValue);
      ppi:=GetPropInfo(item.obj, item.Propname);
      if ppi=nil then
        raise Exception.Create ('Property disappeared...');
      SetWideStrProp(item.obj, ppi, newValue);
    end;
  end;
end;

procedure TTP_Retranslator.Remember(obj: TObject; PropName: String;
  OldValue: WideString);
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 }

{$ifdef MSWINDOWS}

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

  if FollowJump and (Word(OldProcedure^) = $25FF) then begin
    // This finds the correct procedure if a virtual jump has been inserted
    // at the procedure address
    Inc(Integer(OldProcedure), 2); // skip the jump
    OldProcedure := Pointer(Pointer(OldProcedure^)^);
  end;

  PatchPosition:=PChar(OldProcedure);
  offset:=integer(NewProcedure)-integer(OldProcedure)-5;

  Patch[0] := char($E9);
  Patch[1] := char(offset and 255);
  Patch[2] := char((offset shr 8) and 255);
  Patch[3] := char((offset shr 16) and 255);
  Patch[4] := char((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];

  if not VirtualProtect(Pointer(PatchPosition), 5, PAGE_EXECUTE_READWRITE, @ov) then
    RaiseLastOSError;

  Enable;
end;

destructor THook.Destroy;
var
  ov2:Cardinal;
begin
  Disable;
  if not VirtualProtect(Pointer(PatchPosition), 5, ov, @ov2) then
    RaiseLastOSError;
  inherited;
end;

procedure THook.Disable;
begin
  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
  PatchPosition[0]:=Patch[0];
  PatchPosition[1]:=Patch[1];
  PatchPosition[2]:=Patch[2];
  PatchPosition[3]:=Patch[3];
  PatchPosition[4]:=Patch[4];
end;
{$endif}

initialization
  ExecutableFilename:=Paramstr(0);
  AssemblyAnalyzer:=TAssemblyAnalyzer.Create;
  AssemblyAnalyzer.Analyze;
  TPDomainList:=TStringList.Create;
  TPDomainList.Add(DefaultTextDomain);
  TPDomainListCS:=TMultiReadExclusiveWriteSynchronizer.Create;
  DefaultInstance:=TGnuGettextInstance.Create;
  {$ifdef MSWINDOWS}
  Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT);
  // replace Borlands LoadResString with gettext enabled version:
  HookLoadResString:=THook.Create (@system.LoadResString, @LoadResStringA, RuntimePackageSupportEnabled);
  {$endif}

finalization
  FreeAndNil (DefaultInstance);
  FreeAndNil (TPDomainListCS);
  FreeAndNil (TPDomainList);
  {$ifdef mswindows}
  // Unload the dll
  if dllmodule <> 0 then
    FreeLibrary(dllmodule);
  FreeAndNil (HookLoadResString);
  {$endif}
  FreeAndNil (AssemblyAnalyzer);

end.