1 {************************************************************
2 Copyright (c) 2010 Alex Cherednichenko, aka Alex7Che.
3 Copyright (c) 2011-2013 Yury Sidorov.
4
5 Published at GNU General Public License as Free Software.
6 ************************************************************}
7
8 unit ResTranslator;
9
10 {$MODE objfpc}{$H+}
11
12 interface
13
14 uses
15 Classes, StrUtils, SysUtils, FileUtil, LazFileUtils, LResources, TypInfo, LCLProc, LazUTF8;
16
17 type
18
19 TWordDelimitersOptions = set of (wdIgnoreLeading, wdIgnoreTrailing);
20
21 TResTranslator = class;
22
23 TTranslateStringEvent = procedure(Sender: TResTranslator; const ResourceName: AnsiString; var Accept: boolean);
24
25 TTranslateStringOption = (tsoNew, tsoUsed, tsoExternal);
26 TTranslateStringOptions = set of TTranslateStringOption;
27
28 { TTranslateStringList }
29
30 TTranslateStringList = class(TStringList)
31 private
CorrectGetNamenull32 function CorrectGetName(Index: integer): string;
CorrectGetValuenull33 function CorrectGetValue(const Name: string): string;
GetOptionsnull34 function GetOptions(Index: integer): TTranslateStringOptions;
NormaliseQuotedStrnull35 function NormaliseQuotedStr(const S: string): string;
ScanQuotSepnull36 function ScanQuotSep(P: PChar):integer;
37 procedure SetOptions(Index: integer; const AValue: TTranslateStringOptions);
38 protected
DoCompareTextnull39 function DoCompareText(const s1,s2 : string) : PtrInt; override;
40 public
41 constructor Create(const FileName: string); overload;
IndexOfNamenull42 function IndexOfName(const Name: string; var Offset: integer): integer;
IndexOfNamenull43 function IndexOfName(const Name: string): integer; override;
44 procedure LoadFromFile(const FileName: string); override;
45 procedure SaveToFile(const FileName: string); override;
46 procedure Merge(Source: TTranslateStringList; const NamesOnly: boolean = false);
47 property CValues[const Name: string]: string read CorrectGetValue;
48 property CNames[Index: integer]: string read CorrectGetName;
49 property Options[Index: integer]: TTranslateStringOptions read GetOptions write SetOptions;
50 end;
51
52 { TResTranslator }
53
54 TResTranslator = class(TAbstractTranslator)
55 private
56 FIgnoreDelimiters: TWordDelimitersOptions;
57 FOnTranslateString: TTranslateStringEvent;
58 FStrResLst: TTranslateStringList;
59 FModified: boolean;
60 FTranslationLanguage: AnsiString;
61 FWordDelims: TSysCharset;
GetStringsnull62 function GetStrings: TStringList;
63 procedure SetIgnoreDelimiters(const AValue: TWordDelimitersOptions);
64 procedure SetOnTranslateString(const AValue: TTranslateStringEvent);
65 procedure SetWordDelims(const AValue: TSysCharset);
InternalTranslateStringnull66 function InternalTranslateString(const Value: AnsiString; IsExternal: boolean = False): AnsiString;
67 public
68 FTranslationFile: string;
69 constructor Create(TranslationFile: AnsiString);
70 destructor Destroy; override;
71 procedure TranslateStringProperty(Sender: TObject; const Instance: TPersistent; PropInfo: PPropInfo; var Content: string); override;
72 procedure SaveFile; overload;
73 procedure SaveFile(const aFileName: string); overload;
74 property Modified: boolean Read FModified;
75 property Strings: TStringList Read GetStrings;
76 property IgnoreDelimiters: TWordDelimitersOptions Read FIgnoreDelimiters Write SetIgnoreDelimiters;
77 property WordDelims: TSysCharset Read FWordDelims Write SetWordDelims;
78 property TranslationLanguage: AnsiString read FTranslationLanguage;
79 property OnTranslateString: TTranslateStringEvent Read FOnTranslateString Write SetOnTranslateString;
80 end;
81
LoadTranslationFilenull82 function LoadTranslationFile(const TranslationFile: AnsiString; const OnTranslate: TTranslateStringEvent = nil): AnsiString;
83 procedure SaveTranslationFile; overload;
84 procedure SaveTranslationFile(const FileName: AnsiString); overload;
85 procedure MakeTranslationFile; overload;
86 procedure MakeTranslationFile(Language: AnsiString); overload;
87 procedure MakeTranslationFile(const FileName, Language: AnsiString); overload;
88 procedure SupplementTranslationFile(const FileName: AnsiString);
89 procedure SupplementTranslationFiles; overload;
90 procedure SupplementTranslationFiles(const TranslationFilesPath: AnsiString); overload;
LoadDefaultTranslationFilenull91 function LoadDefaultTranslationFile(const OnTranslate: TTranslateStringEvent = nil): TFileName;
LoadDefaultTranslationFilenull92 function LoadDefaultTranslationFile(const TranslationFilesPath: AnsiString; const OnTranslate: TTranslateStringEvent = nil): TFileName;
LoadLanguageTranslationnull93 function LoadLanguageTranslation(const Language: AnsiString; const OnTranslate: TTranslateStringEvent = nil): TFileName;
LoadLanguageTranslationnull94 function LoadLanguageTranslation(const Language, TranslationFilesPath: AnsiString; const OnTranslate: TTranslateStringEvent = nil): TFileName;
TranslateStringnull95 function TranslateString(const Value: AnsiString; IsExternal: boolean = False): AnsiString;
ExtractLangNamenull96 function ExtractLangName(const FileName: TFilename): AnsiString;
GetAvailableTranslationsnull97 function GetAvailableTranslations: TStringList;
GetAvailableTranslationsnull98 function GetAvailableTranslations(const SearchPath: AnsiString): TStringList;
GetTranslationFileNamenull99 function GetTranslationFileName(const Language: AnsiString; AvailableTranslations: TStringList): AnsiString;
DefaultLangDirnull100 function DefaultLangDir: AnsiString;
IsTranslationFileValidnull101 function IsTranslationFileValid(const TranslationFile: AnsiString): boolean;
102
103 const
104 sLanguageIDName = 'TranslationLanguage';
105
106 var
107 IniFileName: string;
108
109 implementation
110
111 uses
112 Forms, utils;
113
114 const
115 LineSeparator = '###################';
116
117 { procedures and functions }
118
IsQuotednull119 function IsQuoted(const S: AnsiString; QuoteChar: char): boolean; inline;
120 var
121 L: integer;
122 begin
123 L:= Length(S);
124 if L > 1 then
125 Result := (S[1] = QuoteChar) and (S[L] = QuoteChar)
126 else
127 Result := false;
128 end;
129
HasSeparatornull130 function HasSeparator(const S: AnsiString; Separator: char): boolean; inline;
131 begin
132 Result := Pos(Separator, S) > 0;
133 end;
134
ExtractLangNamenull135 function ExtractLangName(const FileName: TFilename): AnsiString;
136 begin
137 with TTranslateStringList.Create(FileName) do
138 try
139 Result := AnsiDequotedStr(CValues[sLanguageIDName], QuoteChar);
140 finally
141 Free;
142 end;
143 end;
144
GetAvailableTranslationsnull145 function GetAvailableTranslations: TStringList;
146 begin
147 Result:= GetAvailableTranslations(DefaultLangDir);
148 end;
149
GetAvailableTranslationsnull150 function GetAvailableTranslations(const SearchPath: AnsiString): TStringList;
151 var
152 Sr: TSearchRec;
153 LangName, s: AnsiString;
154 begin
155 Result:= TStringList.Create;
156 if FindFirstUTF8(IncludeTrailingPathDelimiter(SearchPath) + '*', faArchive or faReadOnly, Sr) = 0 then
157 with Result do begin
158 NameValueSeparator:= '=';
159 QuoteChar:= '"';
160 repeat
161 if ExtractFileExt(Sr.Name) = '.template' then
162 continue;
163 s:=IncludeTrailingPathDelimiter(ExtractFilePath(SearchPath)) + Sr.Name;
164 if IsTranslationFileValid(s) then begin
165 LangName:= ExtractLangName(s);
166 if LangName <> '' then
167 Add(LangName + NameValueSeparator + Sr.Name);
168 end;
169 until FindNextUTF8(Sr) <> 0;
170 FindClose(Sr);
171 end;
172 end;
173
174 var
175 FDefaultLangDir: AnsiString;
176
DefaultLangDirnull177 function DefaultLangDir: AnsiString;
178 {$ifdef unix}
_IsLangDirnull179 function _IsLangDir(const dir: string): boolean;
180 var
181 sr: TSearchRec;
182 begin
183 Result:=FindFirstUtf8(dir + ExtractFileNameOnly(ParamStrUtf8(0)) + '.*', faAnyFile, sr) = 0;
184 FindClose(sr);
185 end;
186
187 var
188 s: string;
189 {$endif unix}
190 begin
191 if FDefaultLangDir = '' then begin
192 FDefaultLangDir:=ExtractFilePath(ParamStrUtf8(0)) + 'lang' + DirectorySeparator;
193 {$ifdef unix}
194 if not _IsLangDir(FDefaultLangDir) then begin
195 s:='/usr/share/' + ExtractFileNameOnly(ParamStrUtf8(0)) + '/lang/';
196 if _IsLangDir(s) then
197 FDefaultLangDir:=s
198 else begin
199 s:='/usr/local/share/transmission-remote-gui/lang/';
200 if _IsLangDir(s) then
201 FDefaultLangDir:=s;
202 end;
203 end;
204 {$endif unix}
205 end;
206 Result:=FDefaultLangDir;
207 end;
208
GetResStringsnull209 function GetResStrings(Name, Value: AnsiString; Hash: longint; P: pointer): AnsiString;
210 var
211 Accept: boolean;
212 begin
213 with TResTranslator(P) do begin
214 Accept := True;
215 if Assigned(OnTranslateString) then
216 OnTranslateString(TResTranslator(P), Name, Accept);
217 if Accept then
218 Result := InternalTranslateString(Value)
219 else
220 Result := Value;
221 end;
222 end;
223
LoadTranslationFilenull224 function LoadTranslationFile(const TranslationFile: AnsiString; const OnTranslate: TTranslateStringEvent = nil): AnsiString;
225 begin
226 LRSTranslator := TResTranslator.Create(TranslationFile);
227 TResTranslator(LRSTranslator).OnTranslateString := OnTranslate;
228 SetResourceStrings(@GetResStrings, LRSTranslator);
229 Result := TResTranslator(LRSTranslator).TranslationLanguage;
230 end;
231
232 procedure SupplementTranslationFiles; overload;
233 begin
234 SupplementTranslationFiles(DefaultLangDir);
235 end;
236
237 procedure MakeTranslationFile; overload;
238 begin
239 MakeTranslationFile('???');
240 end;
241
242 procedure MakeTranslationFile(Language: AnsiString); overload;
243 var
244 lLang, sLang, s: string;
245 begin
246 LazGetLanguageIDs(lLang, sLang);
247 sLang:=AnsiLowerCase(sLang);
248 s:=ExtractFileNameOnly(ParamStrUtf8(0));
249 if (sLang <> '') and not FileExistsUTF8(DefaultLangDir + s + '.' + sLang) then
250 s:=s + '.' + sLang
251 else
252 s:=s + '.lng';
253 MakeTranslationFile(DefaultLangDir + s, Language);
254 end;
255
256 procedure MakeTranslationFile(const FileName, Language: AnsiString);
257 var
258 Dst: TTranslateStringList;
259 begin
260 if Assigned(LRSTranslator) and (LRSTranslator is TResTranslator) then begin
261 Dst := TTranslateStringList.Create;
262 try
263 Dst.Values[sLanguageIDName]:= Language;
264 with LRSTranslator as TResTranslator do
265 Dst.Merge(Strings as TTranslateStringList, true);
266 ForceDirectories(ExtractFilePath(FileName));
267 Dst.SaveToFile(FileName);
268 finally
269 Dst.Free;
270 end;
271 end;
272 end;
273
274 procedure SupplementTranslationFile(const FileName: AnsiString);
275 var
276 Dst: TTranslateStringList;
277 begin
278 if Assigned(LRSTranslator) and (LRSTranslator is TResTranslator) then begin
279 Dst := TTranslateStringList.Create(FileName);
280 try
281 with LRSTranslator as TResTranslator do
282 Dst.Merge(Strings as TTranslateStringList, true);
283 Dst.SaveToFile(FileName);
284 finally
285 Dst.Free;
286 end;
287 end;
288 end;
289
290 procedure SupplementTranslationFiles(const TranslationFilesPath: AnsiString);
291 var
292 Sl: TStringList;
293 i: integer;
294 s: string;
295 begin
296 if Assigned(LRSTranslator) and (LRSTranslator is TResTranslator) then begin
297 Sl := GetAvailableTranslations(TranslationFilesPath);
298 with Sl do
299 for i := 0 to Count - 1 do
300 SupplementTranslationFile(IncludeTrailingPathDelimiter(TranslationFilesPath) + ValueFromIndex[i]);
301 // Supplement template file
302 s:=IncludeTrailingPathDelimiter(TranslationFilesPath) + ExtractFileNameOnly(ParamStrUtf8(0)) + '.template';
303 if FileExistsUTF8(s) then
304 SupplementTranslationFile(s);
305 end;
306 end;
307
308 const
309 InvalidLangExt: array[1..6] of string = ('ua', 'by', 'cn', 'cz', 'se', 'tw');
310
IsTranslationFileValidnull311 function IsTranslationFileValid(const TranslationFile: AnsiString): boolean;
312 var
313 s: string;
314 i: integer;
315 begin
316 Result:=FileExistsUTF8(TranslationFile);
317 if not Result then
318 exit;
319 s:=LowerCase(ExtractFileExt(TranslationFile));
320 Delete(s, 1, 1);
321 for i:=Low(InvalidLangExt) to High(InvalidLangExt) do
322 if s = InvalidLangExt[i] then begin
323 Result:=False;
324 exit;
325 end;
326 end;
327
LoadDefaultTranslationFilenull328 function LoadDefaultTranslationFile(const OnTranslate: TTranslateStringEvent): TFileName;
329 begin
330 Result := LoadDefaultTranslationFile(DefaultLangDir, OnTranslate);
331 end;
332
LoadDefaultTranslationFilenull333 function LoadDefaultTranslationFile(const TranslationFilesPath: AnsiString; const OnTranslate: TTranslateStringEvent): TFileName;
334 var
335 lLang, sLang, s: string;
336 i: integer;
337 begin
338 LazGetLanguageIDs(lLang, sLang);
339 lLang:=LowerCase(lLang);
340 sLang:=LowerCase(sLang);
341 {$ifdef windows}
342 if sLang = 'ch' then begin
343 sLang:='zh';
344 lLang:=StringReplace(lLang, 'ch_', 'zh_', []);
345 end;
346 {$endif windows}
347 i:=Pos('.', lLang);
348 if i > 0 then
349 SetLength(lLang, i - 1);
350 s:=IncludeTrailingPathDelimiter(TranslationFilesPath) + ExtractFileNameOnly(ParamStrUtf8(0))+ '.';
351 Result := s + lLang;
352 // First check full language name (uk_ua)
353 if not IsTranslationFileValid(Result) then begin
354 Result := s + sLang;
355 // Check fallback language name (uk)
356 if not IsTranslationFileValid(Result) then begin
357 // Finally use country name (ua)
358 i:=Pos('_', lLang);
359 if i > 0 then
360 lLang:=Copy(lLang, i + 1, MaxInt);
361 Result := s + lLang;
362 if not IsTranslationFileValid(Result) then begin
363 Result:='';
364 exit;
365 end;
366 end;
367 end;
368 IniFileName:=Result;
369 Result := LoadTranslationFile(Result, OnTranslate);
370 end;
371
LoadLanguageTranslationnull372 function LoadLanguageTranslation(const Language: AnsiString; const OnTranslate: TTranslateStringEvent): TFileName;
373 begin
374 Result := LoadLanguageTranslation(Language, DefaultLangDir, OnTranslate);
375 end;
376
LoadLanguageTranslationnull377 function LoadLanguageTranslation(const Language, TranslationFilesPath: AnsiString; const OnTranslate: TTranslateStringEvent): TFileName;
378 var
379 Sl: TStringList;
380 begin
381 Sl:= GetAvailableTranslations(TranslationFilesPath);
382 Result:= GetTranslationFileName(Language, Sl);
383 if Result <> '' then
384 Result := IncludeTrailingPathDelimiter(TranslationFilesPath) + Result;
385 if FileExistsUTF8(Result) then
386 LoadTranslationFile(Result, OnTranslate);
387 end;
388
GetTranslationFileNamenull389 function GetTranslationFileName(const Language: AnsiString; AvailableTranslations: TStringList): AnsiString;
390 var
391 i: integer;
392 aName, aValue: string;
393 begin
394 Result := '';
395 if Assigned(AvailableTranslations) then
396 with AvailableTranslations do
397 for i := 0 to Count - 1 do begin
398 GetNameValue(i, aName, aValue);
399 if AnsiSameText(AnsiDequotedStr(Language, QuoteChar), AnsiDequotedStr(aName, QuoteChar)) then begin
400 Result:= AnsiDequotedStr(aValue, QuoteChar);
401 Break;
402 end;
403 end;
404 end;
405
406 procedure SaveTranslationFile; overload;
407 begin
408 if Assigned(LRSTranslator) and (LRSTranslator is TResTranslator) then
409 with LRSTranslator as TResTranslator do
410 if Modified then
411 SaveFile;
412 end;
413
414 procedure SaveTranslationFile(const FileName: AnsiString); overload;
415 begin
416 if Assigned(LRSTranslator) and (LRSTranslator is TResTranslator) then
417 with LRSTranslator as TResTranslator do
418 if Modified then
419 SaveFile(FileName);
420 end;
421
TranslateStringnull422 function TranslateString(const Value: AnsiString; IsExternal: boolean): AnsiString;
423 begin
424 if Assigned(LRSTranslator) and (LRSTranslator is TResTranslator) then
425 with LRSTranslator as TResTranslator do
426 result := InternalTranslateString(Value, IsExternal)
427 else
428 result := Value;
429 end;
430
431 { TTranslateStringList }
432
CorrectGetValuenull433 function TTranslateStringList.CorrectGetValue(const Name: string): string;
434 var
435 Index: integer;
436 offset: integer;
437 begin
438 Index := IndexOfName(Name, offset);
439 if Index >= 0 then begin
440 Result := Copy(Strings[Index], offset, MaxInt);
441 Options[Index]:=Options[Index] + [tsoUsed];
442 end
443 else
444 result := '';
445 end;
446
TTranslateStringList.GetOptionsnull447 function TTranslateStringList.GetOptions(Index: integer): TTranslateStringOptions;
448 begin
449 Result:=TTranslateStringOptions(cardinal(ptruint(Objects[Index])));
450 end;
451
CorrectGetNamenull452 function TTranslateStringList.CorrectGetName(Index: integer): string;
453 var
454 Offset: integer;
455 s: string;
456 begin
457 CheckSpecialChars;
458 Result := '';
459 s := Strings[Index];
460 Offset := ScanQuotSep(PChar(s));
461 if (Offset > 0) then
462 Result := NormaliseQuotedStr(LeftStr(s, offset));
463 end;
464
ScanQuotSepnull465 function TTranslateStringList.ScanQuotSep(P: PChar): integer;
466 var
467 i, len: integer;
468 QuoteCount: integer;
469 begin
470 result := 0;
471 QuoteCount := 0;
472 i := 0;
473 len:=strlen(P);
474 while (i < len) and (result = 0) do begin
475 if P[i] = QuoteChar then
476 inc(QuoteCount)
477 else if (P[i] = NameValueSeparator) and not odd(QuoteCount) then
478 result := i;
479 inc(i);
480 end;
481 end;
482
483 procedure TTranslateStringList.SetOptions(Index: integer; const AValue: TTranslateStringOptions);
484 begin
485 Objects[Index]:=TObject(ptruint(cardinal(AValue)));
486 end;
487
TTranslateStringList.DoCompareTextnull488 function TTranslateStringList.DoCompareText(const s1, s2: string): PtrInt;
489 begin
490 if CaseSensitive then
491 result:=AnsiCompareText(s1,s2)
492 else
493 result:=AnsiCompareText(UTF8UpperCase(s1),UTF8UpperCase(s2));
494 end;
495
496 constructor TTranslateStringList.Create(const FileName: string);
497 begin
498 inherited Create;
499 CheckSpecialChars;
500 LoadFromFile(FileName);
501 end;
502
NormaliseQuotedStrnull503 function TTranslateStringList.NormaliseQuotedStr(const S: string): string;
504 begin
505 if not HasSeparator(S, NameValueSeparator) then
506 Result := AnsiDequotedStr(S, QuoteChar)
507 else if not IsQuoted(S, QuoteChar) then
508 Result := AnsiQuotedStr(S, QuoteChar)
509 else
510 Result := S;
511 end;
512
IndexOfNamenull513 function TTranslateStringList.IndexOfName(const Name: string; var Offset: integer): integer;
514 var
515 s, n: string;
516 begin
517 CheckSpecialChars;
518 result := 0;
519 n:=NormaliseQuotedStr(Name);
520 while (result < Count) do begin
521 s:=Strings[result];
522 Offset := ScanQuotSep(PChar(s));
523 if (Offset > 0) and (n = Copy(s, 1, Offset)) then begin
524 inc(Offset, 2);
525 exit;
526 end;
527 inc(result);
528 end;
529 result := -1;
530 end;
531
IndexOfNamenull532 function TTranslateStringList.IndexOfName(const Name: string): integer;
533 var
534 i: integer;
535 begin
536 Result:=IndexOfName(Name, i);
537 end;
538
539 procedure TTranslateStringList.LoadFromFile(const FileName: string);
540 var
541 FS: TFileStreamUTF8;
542 buff: array[1..3] of char;
543 i, j, k: integer;
544 s, esep: string;
545 begin
546 FS:= TFileStreamUTF8.Create(FileName, fmOpenRead);
547 try
548 // Skip UTF8 header
549 buff := '';
550 FS.Read(buff, SizeOf(UTF8FileHeader));
551 if buff <> UTF8FileHeader then
552 FS.Position:=0;
553 LoadFromStream(FS);
554 finally
555 FS.Free;
556 end;
557
558 i:=IndexOf(LineSeparator);
559 if i >= 0 then
560 Delete(i);
561
562 // Normalize quotations
563 esep:=NameValueSeparator + NameValueSeparator;
564 for i:=0 to Count - 1 do begin
565 s:=Strings[i];
566 j:=ScanQuotSep(PChar(s));
567 if j > 0 then begin
568 k:=j + 2;
569 if Copy(s, j + 1, 2) = esep then begin
570 Options[i]:=[tsoExternal];
571 Inc(k);
572 end;
573 Strings[i]:=NormaliseQuotedStr(Copy(s, 1, j)) + NameValueSeparator + NormaliseQuotedStr(Copy(s, k, MaxInt));
574 end;
575 end;
576 end;
577
578 procedure TTranslateStringList.SaveToFile(const FileName: string);
579 var
580 FS: TFileStreamUTF8;
581 i, j: integer;
582 s, esep: string;
583 begin
584 ForceDirectories(ExtractFilePath(FileName));
585 FS := TFileStreamUTF8.Create(FileName, fmCreate);
586 try
587 FS.WriteBuffer(UTF8FileHeader, SizeOf(UTF8FileHeader));
588 esep:=NameValueSeparator + NameValueSeparator;
589 for i:=0 to Count - 1 do begin
590 s:=Strings[i];
591 if tsoExternal in Options[i] then begin
592 j:=ScanQuotSep(PChar(s));
593 if j > 0 then
594 s:=NormaliseQuotedStr(Copy(s, 1, j)) + esep + NormaliseQuotedStr(Copy(s, j + 2, MaxInt));
595 end;
596 if s <> '' then
597 FS.WriteBuffer(s[1], Length(s));
598 s:=LineEnding;
599 FS.WriteBuffer(s[1], Length(s));
600 end;
601 finally
602 FS.Free;
603 end;
604 end;
605
606 procedure TTranslateStringList.Merge(Source: TTranslateStringList; const NamesOnly: boolean = false);
607 var
608 i, j: integer;
609 n: string;
610 begin
611 CheckSpecialChars;
612 Source.Sort;
613 for i:=0 to Count - 1 do
614 Options[i]:=[];
615 for i:=0 to Source.Count - 1 do begin
616 if Source.Options[i]*[tsoUsed, tsoExternal] = [] then
617 continue;
618 n:=Source.CNames[i];
619 if n <> '' then begin
620 j:=IndexOfName(n);
621 if j < 0 then begin
622 // New string
623 if NamesOnly then
624 j:=Add(n + NameValueSeparator + n)
625 else
626 j:=Add(Source.Strings[i]);
627 end;
628 Options[j]:=Source.Options[i] + [tsoUsed];
629 end;
630 end;
631 // Delete unused strings
632 i:=0;
633 while i < Count do begin
634 n:=CNames[i];
635 if (Options[i] = []) and (n <> '') and (CompareText(n, sLanguageIDName) <> 0) then
636 Delete(i)
637 else
638 Inc(i);
639 end;
640 end;
641
642 { TResTranslator }
643
644 constructor TResTranslator.Create(TranslationFile: AnsiString);
645 begin
646 inherited Create;
647 FTranslationFile := TranslationFile;
648 FIgnoreDelimiters := [wdIgnoreTrailing];
649 FWordDelims := ['.', ',', ':'];
650
651 FStrResLst := TTranslateStringList.Create;
652 with FStrResLst do begin
653 Duplicates := dupIgnore;
654 CaseSensitive := False;
655 CheckSpecialChars;
656 if FileExistsUTF8(FTranslationFile) then begin
657 LoadFromFile(FTranslationFile);
658 FTranslationLanguage := AnsiDequotedStr(CValues[AnsiQuotedStr(sLanguageIDName, QuoteChar)], QuoteChar);
659 end;
660 end;
661 end;
662
663 destructor TResTranslator.Destroy;
664 begin
665 FStrResLst.Free;
666 inherited Destroy;
667 end;
668
InternalTranslateStringnull669 function TResTranslator.InternalTranslateString(const Value: AnsiString; IsExternal: boolean): AnsiString;
670
IsAlphanull671 function IsAlpha(Ch: char): boolean; inline;
672 begin
673 Result := Ch in ['A'..'Z', 'a'..'z'];
674 end;
675
HasAlphanull676 function HasAlpha: boolean;
677 var
678 i: integer;
679 begin
680 Result := False;
681 i := 1;
682 while not Result and (i <= Length(Value)) do begin
683 Result := IsAlpha(Value[i]);
684 Inc(i);
685 end;
686 end;
687
688 var
689 ClearValue: AnsiString;
690 Original, s, n: AnsiString;
691 i: integer;
692 begin
693 Original := Value;
694 ClearValue := StringReplace(AdjustLineBreaks(Value), LineEnding, '~', [rfReplaceAll]);
695 Result := ClearValue;
696
697 if wdIgnoreLeading in IgnoreDelimiters then
698 RemoveLeadingChars(ClearValue, FWordDelims);
699
700 if wdIgnoreTrailing in IgnoreDelimiters then
701 RemoveTrailingChars(ClearValue, FWordDelims);
702 if HasAlpha then
703 begin
704 with FStrResLst do begin
705 if HasSeparator(ClearValue, NameValueSeparator) then
706 n := AnsiQuotedStr(ClearValue, QuoteChar)
707 else
708 n := ClearValue;
709
710 s:=CValues[n];
711 if (s = '') then begin
712 i:=Add(n + NameValueSeparator + n);
713 Options[i]:=[tsoNew, tsoUsed];
714 FModified := True;
715 Result := Original;
716 end
717 else begin
718 Result := StringReplace(Result, ClearValue, AnsiDequotedStr(s, QuoteChar), [rfReplaceAll]);
719 Result := StringReplace(Result, '~', LineEnding, [rfReplaceAll]);
720 end;
721 if IsExternal then begin
722 i:=IndexOfName(n);
723 if i >= 0 then
724 Options[i]:=Options[i] + [tsoExternal];
725 end;
726 end;
727 end;
728 end;
729
730 procedure TResTranslator.SetIgnoreDelimiters(const AValue: TWordDelimitersOptions);
731 begin
732 if FIgnoreDelimiters = AValue then
733 exit;
734 FIgnoreDelimiters := AValue;
735 end;
736
TResTranslator.GetStringsnull737 function TResTranslator.GetStrings: TStringList;
738 begin
739 Result := FStrResLst;
740 end;
741
742 procedure TResTranslator.SetOnTranslateString(const AValue: TTranslateStringEvent);
743 begin
744 if FOnTranslateString = AValue then
745 exit;
746 FOnTranslateString := AValue;
747 end;
748
749 procedure TResTranslator.SetWordDelims(const AValue: TSysCharset);
750 begin
751 if FWordDelims = AValue then
752 exit;
753 FWordDelims := AValue;
754 end;
755
756 procedure TResTranslator.TranslateStringProperty(Sender: TObject; const Instance: TPersistent; PropInfo: PPropInfo; var Content: string);
757 var
758 Accept: boolean;
759 ResourceName: AnsiString;
760 OwnerName: AnsiString;
761 begin
762 if Sender is TReader and Assigned(TReader(Sender).Owner) then
763 OwnerName := TReader(Sender).Owner.GetNamePath;
764
765 if Instance.InheritsFrom(TForm) then
766 ResourceName := OwnerName + '.' + PropInfo^.Name
767 else
768 ResourceName := OwnerName + '.' + Instance.GetNamePath + '.' + PropInfo^.Name;
769
770 Accept := True;
771
772 if Assigned(OnTranslateString) then
773 OnTranslateString(Self, ResourceName, Accept);
774
775 if (PropInfo^.Name = 'Caption') and (Instance.GetNamePath = Content) then
776 Accept:=False
777 else
778 if PropInfo^.Name = 'Name' then
779 Accept:=False;
780
781 if Accept then
782 Content := InternalTranslateString(Content);
783 end;
784
785 procedure TResTranslator.SaveFile;
786 begin
787 SaveTranslationFile(FTranslationFile);
788 end;
789
790 procedure TResTranslator.SaveFile(const aFileName: string);
791 begin
792 FStrResLst.SaveToFile(aFileName);
793 end;
794
795 finalization
796 FreeAndNil(LRSTranslator);
797
798 end.
799