{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: FreePascal resource string translator.       | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2019 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code dstributed under MIT license.                 | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMPoTrnslt;

interface

uses // {$IFDEF JEDIAPI}jwaWinType, {$ELSE}Windows,{$ENDIF}
     GMActiveX, GMStrDef, GMCollections, GMIntf, GMCommon{$IFDEF USE_XML_DICTIONARIES}, GMXml{$ENDIF};

type

  TResStrType = AnsiString;

  PResStrValue = ^RResStrValue;
  RResStrValue = record
    Key: TGMString;
    Original: TGMString;
    Translation: TGMString;
    Context: TGMString;
  end;

  TTellPoFileEntryFunc = function (const AEntry: RResStrValue; const AAppParam: PtrInt): Boolean;


  {$IFDEF USE_XML_DICTIONARIES}
  TTranslatorFromXml = class;

  ITranslatorFromXml = interface(IUnknown)
    ['{19147213-4B2F-40F9-844A-403641F5AE52}']
    function Obj: TTranslatorFromXml;
  end;

  TTranslatorFromXml = class(TGMRefCountedObj, ITranslatorFromXml)
   protected
    FTranslationSubNodeIdx: LongInt;
    FLangShortName: TGMString;
    FTranslationTable: IGMGenericCollection<RResStrValue>;

    function ProcessTranslationNode(const ANode: IGMXmlNode; const AFlags: TXmlSearchFlags = cDfltXmlSearchFlags; const AParameter: IUnknown = nil): Boolean;

   public
    constructor Create(const ALangShortName: TGMString; const ATranslations: IGMGenericCollection<RResStrValue>; const ARefLifeTime: Boolean = True); reintroduce; overload;
    procedure ReadTranslationsFromXmlTree(const AXml: IGMXmlTree);
    function Obj: TTranslatorFromXml;
  end;
  {$ENDIF}


function EncodeTranslationStrValue(const AValue: TGMString): TGMString;

function GMInitResStrValue(const AKey: TGMString; const AOriginal: TGMString = ''; const ATranslation: TGMString = ''; const AContext: TGMString = ''): RResStrValue;
function GMCompareResStrKeys(const AValueA, AValueB: RResStrValue): TGMCompareResult;

procedure TranslateResourceStrings(ALangShortName: TGMString = '');
procedure ResetResourcestringTranslations;
procedure DumpResourceStrings(AFileExtension, AOutputFolder: TGMString);
function GMBuildResStrKey(const AValue: TGMString): TGMString;

procedure ParsePOFile(const AFileStream: IStream; ACharKind: TGMCharKind; const ACallBackFunc: TTellPoFileEntryFunc; const AAppParam: PtrInt; const ACaller: TObject = nil);

procedure WritePOEntry(const ADest: ISequentialStream; const AEntry: RResStrValue; const ACharKind: TGMCharKind);
procedure GMWriteString(const ADest: ISequentialStream; AStrValue: TGMString; const ACharKind: TGMCharKind; const AAppendNewLine: Boolean = True);

function GMLangShortNameFromLangID(ALangID: Word): TGMString;
function GMUserDefaultLangShortName: TGMString;


const

  cPOResStrFileExt = 'pot';

var

  vDefaultResStrLanguage: TGMString = 'en';


implementation

uses
  {$IFDEF JEDIAPI}jwaWinNLS, jwaWinNT{$IFDEF USE_XML_DICTIONARIES},jwaWinType, jwaWinBase{$ENDIF}{$ELSE}Windows{$ENDIF};


{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

function GMCompareResStrKeys(const AValueA, AValueB: RResStrValue): TGMCompareResult;
var cmp: PtrInt;
begin
  cmp := GMStrLComp(PGMChar(AValueA.Key), PGMChar(AValueB.Key), Max(0 , Min(Length(AValueA.Key), Length(AValueB.Key))));

  if cmp < 0 then Result := crALessThanB
  else
  if cmp > 0 then Result := crAGreaterThanB
  else
   if Length(AValueA.Key) < Length(AValueB.Key) then Result := crALessThanB
   else
   if Length(AValueA.Key) = Length(AValueB.Key) then Result := crAEqualToB else Result := crAGreaterThanB;
end;

function GMInitResStrValue(const AKey, AOriginal, ATranslation, AContext: TGMString): RResStrValue;
begin
  Result.Key := AKey;
  Result.Original := AOriginal;
  Result.Translation := ATranslation;
  Result.Context := AContext;
end;

function GMBuildResStrKey(const AValue: TGMString): TGMString;
const cStrNoiseChars: TGMString = cWhiteSpace + ',;:.?!''&'; // " not in cStrNoiseChars because of \" use StripDoubleQuotes instead
      //cNoiseWords: array [0..3] of TGMString = ('\r', '\n', '\t', '\"'); // , '\s'
begin
  //Name := StripDoubleQuotes(GMDeleteChars(GMDeleteWords(AOriginal, cNoiseWords, '', False), cStrNoiseChars));
  //Result := GMUpperCase(GMDeleteChars(GMDeleteWords(AValue, cNoiseWords, '', False), cStrNoiseChars));
  Result := GMUpperCase(GMDeleteChars(AValue, cStrNoiseChars));
end;

function EncodeTranslationStrValue(const AValue: TGMString): TGMString;
begin
  Result := '"' + GMInsertQuotedStrEscChars(AValue) + '"';
end;


{ ---------------------------- }
{ ---- TTranslatorFromXml ---- }
{ ---------------------------- }

{$IFDEF USE_XML_DICTIONARIES}
constructor TTranslatorFromXml.Create(const ALangShortName: TGMString; const ATranslations: IGMGenericCollection<RResStrValue>;
                                      const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FLangShortName := ALangShortName;
  FTranslationTable := ATranslations;
  FTranslationSubNodeIdx := -1;
end;

function TTranslatorFromXml.Obj: TTranslatorFromXml;
begin
  Result := Self;
end;

function TTranslatorFromXml.ProcessTranslationNode(const ANode: IGMXmlNode; const AFlags: TXmlSearchFlags; const AParameter: IUnknown): Boolean;
var newEntry: RResStrValue; stringsNode: IGMXmlNode;
begin
  Result := True; // <- continue iteration to remaining nodes

  if (FTranslationTable <> nil) and (ANode <> nil) and GMSameText(ANode.Obj.Name, 'PACKAGE') and
     ANode.Obj.FindSubNodeIntoVar('STRING', nil, stringsNode, 1) then
   begin
    //newEntry.Key := GMBuildResStrKey(GMRemoveQuotes(GMFindXmlSubValue(ANode, 'ORIGINAL', nil, '', 2)));
    //newEntry.Translation := GMRemoveQuotes(GMFindXmlSubValue(ANode, 'TRANSLATION', nil, '', 2));

    if stringsNode.Obj.SubNodes.IsValidIndex(0) then
      begin
       newEntry.Original := GMResolveQuotedStrEscChars(GMRemoveQuotes(GMGetIntfStrValue(stringsNode.Obj.SubNodes[0])), Self);
       newEntry.Key := GMBuildResStrKey(newEntry.Original);
      end;

    if stringsNode.Obj.SubNodes.IsValidIndex(FTranslationSubNodeIdx) then
       newEntry.Translation := GMResolveQuotedStrEscChars(GMRemoveQuotes(GMGetIntfStrValue(stringsNode.Obj.SubNodes[FTranslationSubNodeIdx])), Self);

    if (Length(newEntry.Key) > 0) and (Length(newEntry.Translation) > 0) then FTranslationTable.Add(newEntry);
   end;
end;

procedure TTranslatorFromXml.ReadTranslationsFromXmlTree(const AXml: IGMXmlTree);
const cStrXmlTTable = 'TTABLE'; cStrXmlHead = 'HEAD';
var tblNode: IGMXmlNode;
  function EvalTranslationSubNodeIdx: LongInt;
  var it: IGMIterator; unkNode: IUnknown; headNode, subNode: IGMXmlNode;
  begin
    Result := 0;
    if GMGetXmlNodeByPath(AXml.Obj.RootNode, [cStrXmlTTable, cStrXmlHead], headNode) then
     begin
      it := headNode.Obj.SubNodes.CreateIterator;
      while it.NextEntry(unkNode) do
       if GMQueryInterface(unkNode, IGMXmlNode, subNode) then
        begin
         if GMSameText(subNode.Obj.Name, 'TARGET-LOCALE') and
            GMSameText(GMFirstWord(subNode.Obj.StrValue, cWhiteSpace), FLangShortName) then Exit;

         Inc(Result);
        end;
     end;
    Result := -1; // <- May be skipped by exit before, only reached when LangShortName is NOT fount!
  end;
begin
  if (AXml = nil) or (FTranslationTable = nil) then Exit;

  FTranslationSubNodeIdx := EvalTranslationSubNodeIdx;
  if FTranslationSubNodeIdx < 0 then Exit;

  if GMGetXmlNodeByPath(AXml.Obj.RootNode, [cStrXmlTTable], tblNode) then
     tblNode.Obj.IterateSubNodes(ProcessTranslationNode, nil, 1);
end;
{$ENDIF}


{ ------------------------------ }
{ ---- Translating Routines ---- }
{ ------------------------------ }

{$IFDEF USE_XML_DICTIONARIES}
procedure FillTranslationTableFromXmlFiles(const ALangShortName: TGMString; const ATranslationTable: IGMGenericCollection<RResStrValue>);
const cMask = '*.xml';
var findData: TWin32FindData; hSearch: THandle; path: TGMString; fileStrm: IStream; xml: IGMXmlTree; translator: ITranslatorFromXml;
begin
  if ATranslationTable = nil then Exit;

  translator := TTranslatorFromXml.Create(ALangShortName, ATranslationTable);
  path := GMExtractPath(GMThisModuleFileName);
  hSearch := FindFirstFile(PGMChar(GMAppendPath(path, cMask)), findData);
  if hSearch <> INVALID_HANDLE_VALUE then
   try
    repeat
     fileStrm := TGMFileIStream.CreateRead(GMAppendPath(path, findData.cFileName));
     xml := TGMXmlTree.CreateRead(fileStrm);
     translator.Obj.ReadTranslationsFromXmlTree(xml);
    until not FindNextFile(hSearch, findData);
   finally
    FindClose(hSearch);
   end;
end;
{$ENDIF}


//function EncodePoEntry(const AEntry: RResStrValue): RResStrValue;
//begin
//  Result.Original := GMResolveQuotedStrEscChars(ExtractStrFromLine, ACaller);
//  Result.Key := ;
//end;

procedure ParsePOFile(const AFileStream: IStream; ACharKind: TGMCharKind; const ACallBackFunc: TTellPoFileEntryFunc; const AAppParam: PtrInt; const ACaller: TObject);
type EParseState = (psNone, psMsgId, psMsgStr, psMsgCtxt);
var line, firstWord: TGMString; chPos: PtrInt; poEntry: RResStrValue; parseState: EParseState; hasComments:Boolean;
    byteBuffer: AnsiString; bufByteCount, byteBufChPos: Integer; lineEnd: EGMLineEndKind; // lineNo // poFileName: TGMString;

  {$INCLUDE ReadNextLine.inc}  // <- Local function ReadNextLine

  procedure ParseHeaderInfo(const AHeaderLine: TGMString);
  var headerKind, mediaType, mediaTypeToken, paramPair, paramName, paramVal: TGMString; chPos, chPos2, chPos3: PtrInt;
  begin
    chPos := 1;
    headerKind := GMStrip(GMNextWord(chPos, AHeaderLine, ':')); // #58
    if GMSameText(headerKind, 'Content-Type') then
     begin
      mediaType := GMStrip(GMNextWord(chPos, AHeaderLine, ';'));
      chPos2 := 1;
      mediaTypeToken := GMStrip(GMNextWord(chPos2, mediaType, '/'));
      if GMSameText(mediaTypeToken, 'Text') then
       begin
        //mediaTypeToken := GMStrip(GMNextWord(chPos2, mediaType, ';'));
        mediaTypeToken := GMStrip(Copy(mediaType, chPos2, Length(mediaType) - chPos2 + 1));
        if GMSameText(mediaTypeToken, 'Plain') then
         begin
          paramPair := GMStrip(GMNextWord(chPos, AHeaderLine, ';'));
          chPos3 := 1;
          paramName := GMStrip(GMNextWord(chPos3, paramPair, '='));
          paramVal := GMStrip(Copy(paramPair, chPos3, Length(paramPair) - chPos3 + 1));
          if GMSameText(paramName, 'charset') and GMSameText(paramVal, 'Utf-8') then ACharKind := ckUtf8;
         end;
       end;
     end;
  end;

  function ExtractStrFromLine: TGMString;
  begin
    Result := GMRemoveQuotes(GMStrip(Copy(line, chPos, Length(line) - chPos + 1)));
  end;

  procedure ResetParsedEntry;
  begin
    poEntry.Key := ''; poEntry.Original := ''; poEntry.Translation := ''; poEntry.Context := '';
  end;

  function TellPOEntry: Boolean;
  begin
    Result := True;

    poEntry.Original := GMResolveQuotedStrEscChars(poEntry.Original, ACaller);
    poEntry.Translation := GMResolveQuotedStrEscChars(poEntry.Translation, ACaller);
    poEntry.Context := GMResolveQuotedStrEscChars(poEntry.Context, ACaller);
    poEntry.key := GMBuildResStrKey(poEntry.Original);

    if (Length(poEntry.Original) <= 0) and (Length(poEntry.Translation) > 0) then ParseHeaderInfo(poEntry.Translation);

    if (Length(poEntry.Original) > 0) or (Length(poEntry.Translation) > 0) or (Length(poEntry.Context) > 0) then
     begin
      Result := ACallBackFunc(poEntry, AAppParam);
      ResetParsedEntry;
     end;
  end;

begin
  if (AFileStream = nil) or not Assigned(ACallBackFunc) then Exit;

  SetLength(byteBuffer, cDfltCopyBufferSize);
  bufByteCount := 0; byteBufChPos := 1; line := ''; lineEnd := lekUnknown; // lineNo := 0;

  parseState := psNone;

  hasComments := False;
  while ReadNextLine(AFileStream, ACharKind, line, lineEnd, ACaller) do
   begin
    //line := GMStrip(line);

    chPos := 1;
    firstWord := GMNextWord(chPos, line, #32#9);

    if (Length(firstWord) <= 0) or ((Length(firstWord) > 0) and (firstWord[1] = '#')) then
     begin // Comment Line
      if not TellPOEntry then Exit;
      hasComments := True;
      //
      // Add content of comments here
      //
     end else
    if ((Length(firstWord) > 0) and (firstWord[1] = '"')) then
     begin // Continueation of previous value
      case parseState of
       psMsgId: poEntry.Original += ExtractStrFromLine;
       psMsgStr: poEntry.Translation += ExtractStrFromLine;
       psMsgCtxt: poEntry.Context += ExtractStrFromLine;
      end;
     end else
    if GMSameText(firstWord, 'msgid') then
     begin
      if hasComments then hasComments := False else
         if not TellPOEntry then Exit;

      parseState := psMsgId;
      poEntry.Original := ExtractStrFromLine;
     end else
    if GMSameText(firstWord, 'msgstr') then
     begin
      parseState := psMsgStr;
      poEntry.Translation := ExtractStrFromLine;
     end else
    if GMSameText(firstWord, 'msgctxt') then
     begin
      parseState := psMsgCtxt;
      poEntry.Context := ExtractStrFromLine;
     end;
   end;

  TellPOEntry;
end;

function AddPoEntryToTranslations(const AEntry: RResStrValue; const AAppParam: PtrInt): Boolean;
begin
  if AAppParam <> 0 then IGMGenericCollection<RResStrValue>(AAppParam).Add(AEntry);
  Result := True;
end;

procedure ReadTranslationTableFromPOFile(const AFileName: TGMString; const ATranslationTable: IGMGenericCollection<RResStrValue>; const ACaller: TObject = nil);
var fileStrm: IStream; charKind: TGMCharKind;
begin
  if (Length(AFileName) <= 0) or not GMFileExists(AFileName) then Exit;
  fileStrm := TGMFileIStream.CreateRead(AFileName);
  charKind := GMReadBOMCharKind(fileStrm);
  ParsePOFile(fileStrm, charKind, AddPoEntryToTranslations, PtrInt(ATranslationTable), ACaller);
end;


{ ---------------------------- }
{ ---- Interface Routines ---- }
{ ---------------------------- }

function GMLangShortNameFromLangID(ALangID: Word): TGMString;
const cMajorLangMask = $00FF;
begin
  case ALangID and cMajorLangMask of
   LANG_GERMAN: Result := 'de';
   LANG_FRENCH: Result := 'fr';
   LANG_SPANISH: Result := 'es';
   LANG_CHINESE: Result := 'cn';
   else Result := 'en';
  end;
end;

function GMUserDefaultLangShortName: TGMString;
begin
  Result := GMLangShortNameFromLangID(GetUserDefaultLangID);
end;


type

  PTranslationCustomData = ^RTranslationCustomData;
  RTranslationCustomData = record
    TranslationTable: IGMGenericCollection<RResStrValue>;
    {$IFDEF DEBUG}
    UntranslatedDumpStrm: ISequentialStream;
    {$ENDIF}
  end;

function UnTranslateResString(AName, AValue: TResStrType; AHash: LongInt; ACustomData: pointer): TResStrType;
begin
  //Result := ''; <- returning '' means: don't change current translation!
  Result := AValue;
end;

procedure ResetResourcestringTranslations;
begin
  SetResourceStrings(UnTranslateResString, nil);
end;

function TranslateResString(AName, AValue: TResStrType; AHash: LongInt; ACustomData: pointer): TResStrType;
var translationData: PTranslationCustomData; translated: RResStrValue; valStr: TGMString; // unTrnsStr: UnicodeString;
begin
  if ACustomData = nil then Result := '' else
   begin
    translationData := ACustomData;
    valStr := AValue; // GMInsertQuotedStrEscChars(AValue);

    if translationData.TranslationTable.Find(GMInitResStrValue(GMBuildResStrKey(valStr)), translated) and (Length(translated.Translation) > 0) then
       Result := translated.Translation
    else
     begin
      //Result := ''; <- returning '' means: don't change current translation!
      Result := AValue;
      {$IFDEF DEBUG}
      if translationData.UntranslatedDumpStrm <> nil then
       begin
        WritePOEntry(translationData.UntranslatedDumpStrm, GMInitResStrValue('', AValue), ckUtf8);
        //unTrnsStr := '"' + valStr + '"' + cNewLine;
        //GMSafeIStreamWrite(translationData.UntranslatedDumpStrm, PWideChar(unTrnsStr), Length(unTrnsStr) shl 1);
       end;
      {$ENDIF}
     end;
   end;
end;

procedure TranslateResourceStrings(ALangShortName: TGMString);
var translationData: RTranslationCustomData; {$IFNDEF USE_XML_DICTIONARIES}poFileName: TGMString;{$ENDIF}
begin
  if Length(ALangShortName) <= 0 then ALangShortName := GMUserDefaultLangShortName;

  if GMSameText(ALangShortName, vDefaultResStrLanguage) then ResetResourcestringTranslations else
   begin
    translationData.TranslationTable := TGMGenericArrayCollection<RResStrValue>.Create(False, True, GMCompareResStrKeys);

    {$IFDEF DEBUG}
    translationData.UntranslatedDumpStrm := TGMFileIStream.CreateOverwrite(GMChangeFileExt(GMModuleFileName(System.HInstance), 'Untranslated.po'));
    GMWriteBOM(translationData.UntranslatedDumpStrm, ckUtf8);
    {$ELSE}
    //translationData.UntranslatedDumpStrm := nil;
    {$ENDIF}

    {$IFDEF USE_XML_DICTIONARIES}
     FillTranslationTableFromXmlFiles(ALangShortName, translationData.TranslationTable);
    {$ELSE}
     poFileName := GMChangeFileExt(GMThisModuleFileName, ALangShortName + '.po');
     ReadTranslationTableFromPOFile(poFileName, translationData.TranslationTable);
    {$ENDIF}

    SetResourceStrings(TranslateResString, @translationData);
   end;
end;

procedure GMWriteString(const ADest: ISequentialStream; AStrValue: TGMString; const ACharKind: TGMCharKind; const AAppendNewLine: Boolean);
var aStr: AnsiString; wStr: UnicodeString;
begin
  if ADest = nil then Exit;

  if AAppendNewLine then AStrValue := AStrValue + cNewLine;

  case ACharKind of
   ckAnsi: begin
            aStr := AStrValue;
            GMSafeIStreamWrite(ADest, PAnsiChar(aStr), Length(aStr));
           end;

   ckUtf8: begin
            aStr := GMStringToUtf8(AStrValue);
            GMSafeIStreamWrite(ADest, PAnsiChar(aStr), Length(aStr));
           end;

   ckUtf16LE: begin
               wStr := AStrValue;
               GMSafeIStreamWrite(ADest, PWideChar(wStr), Length(wStr) * SizeOf(WideChar));
              end;
   //ckUtf16BE, ckUnknown
  end;
end;

procedure WritePOEntry(const ADest: ISequentialStream; const AEntry: RResStrValue; const ACharKind: TGMCharKind);
begin
  //GMWriteString(ADest, '#: ' + AName, ACharKind); //  + ' ' + GMFormat('HashCode: %x', [AHash]))
  //GMWriteString(ADest, '#. ' + GMFormat('HashCode: %x', [AHash]), ACharKind);
  GMWriteString(ADest, 'msgid ' + EncodeTranslationStrValue(AEntry.Original), ACharKind);
  GMWriteString(ADest, 'msgstr ' + EncodeTranslationStrValue(AEntry.Translation), ACharKind);
  if Length(AEntry.Context) > 0 then GMWriteString(ADest, 'msgctxt ' + EncodeTranslationStrValue(AEntry.Context), ACharKind);
  GMWriteString(ADest, '', ACharKind);
end;

procedure WritePoFileHeader(const ADest: IStream; const ACharKind: TGMCharKind);
  function CharSetName(const ACharKind: TGMCharKind): TGMString;
  begin
    case ACharKind of
     //ckUnknown, ckUtf16BE
     ckAnsi: Result := 'ANSI';
     ckUtf8: Result := 'UTF-8';
     ckUtf16LE: Result := 'UNICODE'
     else Result := '?';
    end;
  end;
begin
  GMWriteString(ADest, 'msgid ""', ACharKind);
  GMWriteString(ADest, 'msgstr "Content-Type: text/plain; charset='+CharSetName(ACharKind)+'"', ACharKind);
  GMWriteString(ADest, '', ACharKind);
end;

type

  PResStrCustomData = ^RResStrCustomData;
  RResStrCustomData = record
    DestStrm: IStream;
    CharKind: TGMCharKind;
  end;

function InitResStrCustomData(const ADestStrm: IStream; const ACharKind: TGMCharKind): RResStrCustomData;
begin
  Result.DestStrm := ADestStrm;
  Result.CharKind := ACharKind;
end;

function WritePoResString(AName, AValue: TResStrType; AHash: Longint; ACustomData: Pointer): TResStrType;
var destStrm: IStream; charKind: TGMCharKind;
begin
  //Result := AValue;
  Result := '';

  if ACustomData <> nil then
   begin
    destStrm := PResStrCustomData(ACustomData).DestStrm;
    charKind := PResStrCustomData(ACustomData).CharKind;

    GMWriteString(destStrm, '#: ' + AName, charKind); //  + ' ' + GMFormat('HashCode: %x', [AHash]))
    GMWriteString(destStrm, '#. ' + GMFormat('HashCode: %x', [AHash]), charKind);
    GMWriteString(destStrm, 'msgid ' + EncodeTranslationStrValue(AValue), charKind);
    GMWriteString(destStrm, 'msgstr ""', charKind);
    GMWriteString(destStrm, '', charKind);

    //valStr := '"' + GMInsertQuotedStrEscChars(AValue) + '"' + cNewLine;
    //GMSafeIStreamWrite(IStream(ACustomData), PWideChar(valStr), Length(valStr) shl 1);
   end;
end;

procedure DumpResourceStrings(AFileExtension, AOutputFolder: TGMString);
const cCharKind = ckUtf8;
var fileStrm: IStream; fileName: TGMString; customData: RResStrCustomData;
begin
  if Length(AFileExtension) <= 0 then AFileExtension := cPOResStrFileExt;
  fileName := GMChangeFileExt(GMThisModuleFileName, AFileExtension);
  if Length(AOutputFolder) > 0 then fileName := GMAppendPath(AOutputFolder, GMExtractFileName(fileName));
  //WriteLn('Writing resource strings: '+fileName); <- causes "file not open" error in GUI application
  fileStrm := TGMFileIStream.CreateOverwrite(fileName);
  GMWriteBOM(fileStrm, cCharKind);
  WritePoFileHeader(fileStrm, cCharKind);
  customData := InitResStrCustomData(fileStrm, cCharKind);
  SetResourceStrings(WritePoResString, @customData);
end;


end.