���� JFIF  XX �� �� �     $.' ",#(7),01444'9=82<.342  2!!22222222222222222222222222222222222222222222222222�� ��" �� 4     ��   �� �,�PG"Z_�4�˷����kjز�Z�,F+��_z�,�© �����zh6�٨�ic�fu��� #ډb���_�N� ?� �wQ���5-�~�I���8��� �TK<5o�Iv-� ����k�_U_����� ~b�M��d��� �Ӝ�U�Hh��?]��E�w��Q���k�{��_}qFW7HTՑ��Y��F� ?_�'ϔ��_�Ջt� �=||I �� 6�έ"�����D���/[�k�9�� �Y�8 ds|\���Ҿp6�Ҵ���]��.����6� z<�v��@]�i% �� $j��~ �g��J>��no����pM[me�i$[�� �� s�o�ᘨ�˸ nɜG-�ĨU�ycP� 3.DB�li�;� �hj���x 7Z^�N�h��� ���N3u{�:j �x�힞��#M &��jL P@ _���� P�� &��o8 ������9 �����@Sz 6�t7#O�ߋ � s}Yf�T� ��lmr����Z)'N��k�۞p ����w\�T ȯ?�8` �O��i{wﭹW�[�r�� ��Q4F�׊�� �3m&L�=��h3� ���z~��#� \�l :�F,j@�� ʱ�wQT����8�"kJO��� 6�֚l���� }��� R�>ډK���]��y����&����p�}b�� ;N�1�m�r$� |��7�>e�@ B�TM*-i H��g�D�)� E�m�|�ؘbҗ�a ��Ҿ���� t4��� o���G��*oCN�rP���Q��@z,|?W[0 �����:�n,j WiE��W� �$~/�hp\��?��{(�0���+�Y8rΟ�+����>S-S�� ��VN;� }�s?.����� w �9��˟<���Mq4�Wv' ��{)0�1mB ��V����W[� ����8�/<� �%���wT^�5���b��)iM� p g�N�&ݝ� �VO~� q���u���9� ����!��J27��� �$ O-���! �: �%H��� ـ ����y�ΠM=t{!S�� oK8������ t<����è :a�� ����[���� �ա�H���~��w��Qz`�p o�^ �� ��Q��n�  �,uu�C� $ ^���,� �����8�#��:�6��e�|~� ��!�3� 3.�\0�� q��o�4`.|� ����y�Q�`~;�d�ׯ,��O�Zw�������`73�v�܋�< ���Ȏ�� ـ4k��5�K�a�u�=9Yd��$>x�A�&�� j0� ���vF��� Y� |�y��� ~�6�@c��1vOp �Ig�� ��4��l�OD� ��L����� R���c���j�_�uX 6��3?nk��Wy�f;^*B� ��@ �~a�`��Eu������ +� �� 6�L��.ü>��}y���}_�O�6�͐�:�Yr G�X��kG�� ���l^w�� �~㒶sy� �Iu�!� W ��X��N�7BV��O��!X�2����wvG�R�f�T#�����t�/?���%8�^�W�aT ��G�cL�M���I��(J����1~�8�?aT ���]����AS�E��(��*E}� 2�� #I/�׍qz��^t�̔��� b�Yz4x ���t�){ OH� �+(E��A&�N�������XT��o��"�XC�� '���)}�J�z�p� ��~5�}�^����+�6����w��c��Q�| Lp�d�H��}�(�.|����k��c4^� "�����Z?ȕ ��a< �L�!0 39C� �Eu� C�F�Ew�ç ;�n?�*o���B�8�bʝ���'#Rqf�� �M}7����]��� �s2tcS{�\icTx;�\��7K���P ���ʇ Z O-��~�� c>"��?�� �����P ��E��O�8��@�8��G��Q�g�a�Վ���󁶠 �䧘��_%#r�>� 1�z�a�� eb��qcP ѵ��n���#L��� =��׀t� L�7�` ��V��� A{�C:�g���e@ �w1 Xp 3�c3�ġ���� p��M"'-�@n4���fG� �B3�DJ�8[Jo�ߐ���gK)ƛ��$���� � ��8�3�����+���� �����6�ʻ���� ���S�kI�*KZlT _`�� �?��K� ���QK�d ����B`�s}�>���` ��*�>��,*@J�d�oF*� ���弝��O}�k��s��]��y�ߘ ��c1G�V���<=�7��7����6 �q�PT��tXԀ�!9*4�4Tހ 3XΛex�46�� �Y��D ����� �BdemDa����\�_l,� �G�/���֌7���Y�](�xTt^%�GE�����4�}bT ���ڹ�����; Y)���B�Q��u��>J/J � ⮶.�XԄ��j�ݳ� +E��d ��r�5�_D �1 �� o�� �B�x�΢�#� ��<��W�����8���R6�@ g�M�.��� dr�D��>(otU��@ x=��~v���2� ӣ�d�oBd ��3�eO�6�㣷�� ���ݜ 6��6Y��Qz`�� S��{���\P �~z m5{J/L��1������<�e�ͅPu� b�]�ϔ ���'�� ����f�b� Zpw��c`"��i���BD@:)ִ�:�]��h v�E� w���T�l ��P� ��"Ju�}��وV J��G6��. J/�Qgl߭�e�����@�z�Zev2u� )]կ��� ��7x�� �s�M�-<ɯ�c��r� v�����@��$�ޮ}lk���a�� �'����>x��O\�Z Fu>��� ��ck#��&:��`�$ �ai�>2Δ����l���oF[h� �lE�ܺ�Π k:)���` �� $[6�����9�����kOw�\|��� 8}������ބ:��񶐕� �I�A1/� =�2[�,�!��.}gN#�u����b ��� ~� �݊��}34q��� �d�E��L c��$ ��"�[q�U�硬g^��%B � z���r�p J�ru%v\h 1Y�ne` ǥ:g�� �pQM~�^� Xi� ��`S�:V2 9.�P���V� ?B�k�� AEvw%�_�9C�Q����wKekP ؠ�\� ;Io d�{ ߞo�c1eP��� �\� `����E=���@K<�Y�� �eڼ�J ���w����{av�F�'�M�@ /J��+9p ���|]���� �Iw &` ��8���& M�hg ��[�{ ��Xj�� %��Ӓ� $��(��� �ʹN��� <>�I���RY� ��K2�NPlL�ɀ )��&e� ���B+ь����( � �JTx ���_?EZ� }@ 6�U���뙢ط�z��dWI� n` D����噥�[��uV��"�G& Ú����2 g�}&m� �?ċ �"����Om#� ������� � ��{� ON��"S�X ��Ne��ysQ���@ Fn��Vg��� dX�~nj� ]J�<�K]: ��FW�� b�������62 �=��5f����JKw� �bf�X� 55��~J �%^� ���:�-�QIE��P��v�nZum� z � ~ə ���� ���ة����;�f��\v��� g�8�1��f2 4;�V���ǔ�)��� �9���1\�� c��v�/'Ƞ�w����� ��$�4�R-��t�� �� e�6�/�ġ �̕Ecy�J���u�B���<�W�ַ~�w[B1L۲�-JS΂�{���΃���� ��A��20�c# �� @    0!1@AP"#2Q`$3V�%45a6�FRUq���   � ���^7ׅ,$n� ������+��F�`��2X'��0vM��p�L=������ 5��8������u�p~���.�`r�����\��� O��,ư�0oS ��_�M�����l���4�kv\JSd���x���SW�<��Ae�IX����������$I���w�:S���y���›R��9�Q[���,�5�;�@]�%���u�@ *ro�lbI �� ��+���%m:�͇ZV�����u�̉����θau<�fc�.����{�4Ա� �Q����*�Sm��8\ujqs]{kN���)qO�y�_*dJ�b�7���yQqI&9�ԌK!�M}�R�;�� ����S�T���1���i[U�ɵz�]��U)V�S6���3$K{� ߊ<�(� E]Զ[ǼENg�����'�\?#)Dkf��J���o��v���'�%ƞ�&K�u� !��b�35LX�Ϸ��63$K�a�;�9>,R��W��3�3� d�JeTYE.Mϧ��-�o�j3+y��y^�c�������VO�9NV\nd�1 ��!͕_)a�v;����թ�M�lWR1��)El��P;��yوÏ�u 3�k�5Pr6<�⒲l�!˞*��u־�n�!�l:����UNW ��%��Chx8vL'��X�@��*��)���̮��ˍ��� � ��D-M�+J�U�kvK����+�x8��cY������?�Ԡ��~3mo��|�u@[XeY�C�\Kp�x8�oC�C�&����N�~3-H���� ��MX�s�u<`���~"WL��$8ξ��3���a�)|:@�m�\���^�`�@ҷ)�5p+��6���p�%i)P M���ngc�����#0Aruz���RL+xSS?���ʮ}()#�t��mˇ!��0}}y����<�e� �-ή�Ԩ��X������ MF���ԙ~l L.3���}�V뽺�v��� ��멬��Nl�)�2����^�Iq��a��M��qG��T�����c3#������3U�Ǎ���}��לS�|qa��ڃ�+���-��2�f����/��bz��ڐ�� �ݼ[2�ç����k�X�2�* �Z�d���J�G����M*9W���s{��w���T��x��y,�in�O�v��]���n����P�$� JB@=4�OTI�n��e�22a\����q�d���%�$��(���:���: /*�K[PR�fr\nڙdN���F�n�$�4� [�� U�zƶ����� �mʋ���,�ao�u 3�z� �x��Kn����\[��VFmbE;�_U��&V�Gg�]L�۪&#n%�$ɯ� dG���D�TI=�%+AB�Ru#��b4�1�»x�cs�YzڙJG��f��Il� �d�eF'T� iA��T���uC�$����Y��H?����[!G`}���ͪ� �纤Hv\������j�Ex�K���!���OiƸ�Yj�+u-<���'q����uN�*�r\��+�]���<�wOZ.fp�ێ��,-*)V?j-kÊ#�`�r��dV����(�ݽBk�����G�ƛk�QmUڗe��Z���f}|����8�8��a���i��3'J�����~G_�^���d�8w������ R�`(�~�.��u���l�s+g�bv���W���lGc}��u���afE~1�Ue������Z�0�8�=e�� f@/�jqEKQQ�J� �oN��J���W5~M>$6�Lt�;$ʳ{���^��6�{����v6���ķܰg�V�cnn �~z�x�«�,2�u�?cE+Ș�H؎�%�Za�)���X>uW�Tz�Nyo����s���FQƤ��$��*�&�LLXL)�1�" L��eO��ɟ�9=���:t��Z���c��Ž���Y?�ӭV�wv�~,Y��r�ۗ�|�y��GaF�����C�����.�+� ���v1���fήJ�����]�S��T��B��n5sW}y�$��~z�'�c ��8 ��� ,! �p��VN�S��N�N�q��y8z˱�A��4��*��'������2n<�s���^ǧ˭P�Jޮɏ�U�G�L�J�*#��<�V��t7�8����TĜ>��i}K%,���)[��z�21z ?�N�i�n1?T�I�R#��m-�����������������1����lA�`��fT5+��ܐ�c�q՝��ʐ��,���3�f2U�եmab��#ŠdQ�y>\��)�SLY����w#��.���ʑ�f��� ,"+�w�~�N�'�c�O�3F�������N<���)j��&��,-� �љ���֊�_�zS���TǦ����w�>��?�������n��U仆�V���e�����0���$�C�d���rP �m�׈e�Xm�Vu� �L��.�bֹ��� �[Դaզ���*��\y�8�Է:�Ez\�0�Kq�C b��̘��cө���Q��=0Y��s�N��S.��� 3.���O�o:���#���v7�[#߫ ��5�܎�L���Er4���9n��COWlG�^��0k�%<���ZB���aB_���������'=��{i�v�l�$�uC���mƎҝ{�c㱼�y]���W�i ��ߧc��m�H� m�"�"�����;Y�ߝ�Z�Ǔ�����:S#��|}�y�,/k�Ld� TA�(�AI$+I3��;Y*���Z��}|��ӧO��d�v��..#:n��f>�>���ȶI�TX��� 8��y����"d�R�|�)0���=���n4��6ⲑ�+��r<�O�܂~zh�z����7ܓ�HH�Ga롏���nCo�>������a ���~]���R���̲c?�6(�q�;5%� |�uj�~z8R =X��I�V=�|{v�Gj\gc��q����z�؋%M�ߍ����1y��#��@f^���^�>N��� ��#x#۹��6�Y~�?�dfPO��{��P�4��V��u1E1J �*|���%�� �JN��`eWu�zk M6���q t[�� ��g�G���v��WIG��u_ft����5�j�"�Y�:T��ɐ���*�;� e5���4����q$C��2d�}���� _S�L#m�Yp��O�.�C�;��c����Hi#֩%+) �Ӎ��ƲV���SYź��g |���tj��3�8���r|���V��1#;.SQ�A[���S������#���`n�+���$��$ I �P\[�@�s��(�ED�z���P��])8�G#��0B��[ى��X�II�q<��9�~[Z멜�Z�⊔IWU&A>�P~�#��dp<�?����7���c��'~���5 ��+$���lx@�M�dm��n<=e�dyX��?{�|Aef ,|n3�<~z�ƃ�uۧ�����P��Y,�ӥQ�*g�#먙R�\���;T��i,��[9Qi歉����c>]9�� ��"�c��P�� �Md?٥��If�ت�u��k��/����F��9�c*9��Ǎ:�ØF���z�n*�@|I�ށ9����N3{'��[�'ͬ�Ҳ4��#}��!�V� Fu��,�,mTIk���v C�7v���B�6k�T9��1�*l� '~��ƞF��lU��'�M ����][ΩũJ_�{�i�I�n��$�� �L�� j��O�dx�����kza۪��#�E��Cl����x˘�o�����V���ɞ�ljr��)�/,�߬h�L��#��^��L�ф�,íMƁe�̩�NB�L�����iL����q�}��(��q��6IçJ$�W�E$��:������=#����(�K�B����zђ <��K(�N�۫K�w��^O{!����) �H���>x�������lx�?>Պ�+�>�W���,Ly!_�D���Ō�l���Q�!�[ �S����J��1��Ɛ�Y}��b,+�Lo�x�ɓ)����=�y�oh�@�꥟/��I��ѭ=��P�y9��� �ۍYӘ�e+�p�Jnϱ?V\SO%�(�t� ���=?MR�[Ș�����d�/ ��n�l��B�7j� ��!�;ӥ�/�[-���A�>� dN�sLj ��,ɪv��=1c�.SQ�O3�U���ƀ�ܽ�E����������̻��9G�ϷD�7(�}��Ävӌ\� y�_0[w ���<΍>����a_��[0+�L��F.�޺��f�>oN�T����q;���y\��bՃ��y�jH�<|q-eɏ�_?_9+P���Hp$�����[ux�K w�Mw��N�ی'$Y2�=��q���KB��P��~�� ����Yul:�[<����F1�2�O���5=d����]Y�sw:���Ϯ���E��j,_Q��X��z`H1,#II ��d�wr��P˂@�ZJV����y$�\y�{}��^~���[:N����ߌ�U�������O��d�����ؾe��${p>G��3c���Ė�lʌ�� ת��[��`ϱ�-W����dg�I��ig2��� ��}s ��ؤ(%#sS@���~���3�X�nRG�~\jc3�v��ӍL��M[JB�T��s3}��j�Nʖ��W����;7� �ç?=X�F=-�=����q�ߚ���#���='�c��7���ڑW�I(O+=:uxq�������������e2�zi+�kuG�R��������0�&e�n���iT^J����~\jy���p'dtG��s����O��3����9* �b#Ɋ�� p������[Bws�T�>d4�ۧs���nv�n���U���_�~,�v����ƜJ1��s�� �QIz�� )�(lv8M���U=�;����56��G���s#�K���MP�=��LvyGd��}�VwWBF�'�à �?MH�U�g2�� ����!�p�7Q��j��ڴ����=��j�u��� Jn�A s���uM������e��Ɔ�Ҕ�!) '��8Ϣ�ٔ� �ޝ(��Vp���צ֖d=�IC�J�Ǡ{q������kԭ�߸���i��@K����u�|�p=..�*+����x�����z[Aqġ#s2a�Ɗ���RR�)*HRsi�~�a &f��M��P����-K�L@��Z��Xy�'x�{}��Zm+���:�)�) IJ�-i�u���� ���ܒH��'� L(7�y�GӜq���� j��� 6ߌg1�g�o���,kر���tY�?W,���p���e���f�OQS��!K�۟cҒA�|ս�j�>��=⬒��˧L[�� �߿2JaB~R��u�:��Q�] �0H~���]�7��Ƽ�I���( }��cq '�ήET���q�?f�ab���ӥvr� �)o��-Q��_'����ᴎo��K������;��V���o��%���~OK ����*��b�f:���-ťIR��`B�5!RB@���ï�� �u �̯e\�_U�_������� g�ES��3������� QT��a�� ��x����U<~�c?�*�#]�MW,[8O�a�x��]�1bC|踤�P��lw5V%�)�{t�<��d��5���0i�XSU��m:��Z�┵�i�"��1�^B�-��P�hJ��&)O��*�D��c�W��vM��)����}���P��ܗ-q����\mmζZ-l@�}��a��E�6��F�@��&Sg@���ݚ�M����� ȹ 4����#p�\H����dYDo�H���"��\��..R�B�H�z_�/5˘����6��KhJR��P�mƶi�m���3� ,#c�co��q�a)*P t����R�m�k�7x�D�E�\Y�閣_X�<���~�)���c[[�BP����6�Yq���S��0����%_����;��Àv�~�| VS؇ ��'O0��F0��\���U�-�d@�����7�SJ*z��3n��y��P����O��������� m�~�P�3|Y��ʉr#�C�<�G~�.,! ���bqx���h~0=��!ǫ�jy����l� O,�[B��~��|9��ٱ����Xly�#�i�B��g%�S��������tˋ���e���ې��\[d�t)��.+u�|1 ������#�~Oj����hS�%��i.�~X���I�H�m��0n���c�1uE�q��cF�RF�o���7� �O�ꮧ� ���ۛ{��ʛi5�rw?׌#Qn�TW��~?y$��m\�\o����%W� ?=>S�N@�� �Ʈ���R����N�)�r"C�:��:����� �����#��qb��Y�. �6[��2K����2u�Ǧ�HYR��Q�MV��� �G�$��Q+.>�����nNH��q�^��� ����q��mM��V��D�+�-�#*�U�̒ ���p욳��u:�������IB���m� ��PV@O���r[b= �� ��1U�E��_Nm�yKbN�O���U�}�the�`�|6֮P>�\2�P�V���I�D�i�P�O;�9�r�mAHG�W�S]��J*�_�G��+kP�2����Ka�Z���H�'K�x�W�MZ%�O�YD�Rc+o��?�q��Ghm��d�S�oh�\�D�|:W������UA�Qc yT�q� �����~^�H��/��#p�CZ���T�I�1�ӏT����4��"�ČZ�����}��`w�#�*,ʹ�� ��0�i��課�Om�*�da��^gJ݅{���l�e9uF#T�ֲ��̲�ٞC"�q���ߍ ոޑ�o#�XZTp����@ o�8��(jd��xw�]�,f���`~� |,s��^����f�1���t��|��m�򸄭/ctr��5s��7�9Q�4�H1꠲BB@ l9@���C�����+�wp�xu�£Yc�9��?`@#�o�mH�s2��)�=��2�.�l����jg�9$�Y�S�%*L������R�Y������7Z���,*=�䷘$�������arm�o�ϰ���UW.|�r�uf����IGw�t����Zwo��~5 ��YյhO+=8fF�)�W�7�L9lM�̘·Y���֘YLf�큹�pRF���99.A �"wz��=E\Z���'a� 2��Ǚ�#;�'}�G���*��l��^"q��+2FQ� hj��kŦ��${���ޮ-�T�٭cf�|�3#~�RJ����t��$b�(R��(����r���dx� >U b�&9,>���%E\� Ά�e�$��'�q't��*�א���ެ�b��-|d���SB�O�O��$�R+�H�)�܎�K��1m`;�J�2�Y~9��O�g8=vqD`K[�F)k�[���1m޼c��n���]s�k�z$@��)!I �x՝"v��9=�ZA=`Ɠi �:�E��)` 7��vI��}d�YI�_ �o�:ob���o ���3Q��&D&�2=�� �Ά��;>�h����y.*ⅥS������Ӭ�+q&����j|UƧ��� �}���J0��WW< ۋS�)jQR�j���Ư��rN)�Gű�4Ѷ(�S)Ǣ�8��i��W52���No˓� ۍ%�5brOn�L�;�n��\G����=�^U�dI���8$�&���h��'���+�(������cȁ߫k�l��S^���cƗjԌE�ꭔ��gF���Ȓ��@���}O���*;e�v�WV���YJ\�]X'5��ղ�k�F��b 6R�o՜m��i N�i���� >J����?��lPm�U��}>_Z&�KK��q�r��I�D�Չ~�q�3fL�:S�e>���E���-G���{L�6p�e,8��������QI��h��a�Xa��U�A'���ʂ���s�+טIjP�-��y�8ۈZ?J$��W�P� ��R�s�]��|�l(�ԓ��sƊi��o(��S0 ��Y� 8�T97.�����WiL��c�~�dxc�E|�2!�X�K�Ƙਫ਼�$((�6�~|d9u+�qd�^3�89��Y�6L�.I�����?���iI�q���9�)O/뚅����O���X��X�V��ZF[�یgQ�L��K1���RҖr@v�#��X�l��F���Нy�S�8�7�kF!A��sM���^rkp�jP�DyS$N���q�� nxҍ!U�f�!eh�i�2�m ���`�Y�I�9r�6� �TF���C}/�y�^���Η���5d�'��9A-��J��>{�_l+�`��A���[�'��յ�ϛ#w:݅�%��X�}�&�PSt�Q�"�-��\縵�/����$Ɨh�Xb�*�y��BS����;W�ջ_mc�����vt?2}1�;qS�d�d~u:2k5�2�R�~�z+|HE!)�Ǟl��7`��0�<�,�2*���Hl-��x�^����'_TV�gZA�'j� ^�2Ϊ��N7t�����?w�� �x1��f��Iz�C-Ȗ��K�^q�;���-W�DvT�7��8�Z�������� hK�(P:��Q- �8�n�Z���܃e貾�<�1�YT<�,�����"�6{ / �?�͟��|1�:�#g��W�>$����d��J��d�B�� =��jf[��%rE^��il:��B���x���Sּ�1հ��,�=��*�7 fcG��#q� �eh?��2�7�����,�!7x��6�n�LC�4x��},Geǝ�tC.��vS �F�43��zz\��;QYC,6����~;RYS/6���|2���5���v��T��i����������mlv��������&� �nRh^ejR�LG�f���? �ۉҬܦƩ��|��Ȱ����>3����!v��i�ʯ�>�v��オ�X3e���_1z�Kȗ\<������!�8���V��]��?b�k41�Re��T�q��mz��TiOʦ�Z��Xq���L������q"+���2ۨ��8}�&N7XU7Ap�d�X��~�׿��&4e�o�F��� �H�� ��O���č�c�� 懴�6���͉��+)��v;j��ݷ�� �UV�� i��� j���Y9GdÒJ1��詞�����V?h��l�� ��l�cGs�ځ�������y�Ac���� �\V3�? �� ܙg�>qH�S,�E�W�[�㺨�uch�⍸�O�}���a��>�q�6�n6� ���N6�q�� ���� N    ! 1AQaq�0@����"2BRb�#Pr���3C`��Scst���$4D���%Td��  ? � ��N����a��3��m���C���w��������xA�m�q�m��� m������$����4n淿t'��C"w��zU=D�\R+w�p+Y�T�&�պ@��ƃ��3ޯ?�Aﶂ��aŘ���@-�����Q�=���9D��ռ�ѻ@��M�V��P��܅�G5�f�Y<�u=,EC)�<�Fy'�"�&�չ�X~f��l�KԆV��?�� �W�N����=(� �;���{�r����ٌ�Y���h{�١������jW����P���Tc�����X�K�r��}���w�R��%��?���E��m�� �Y�q|����\lEE4� ��r���}�lsI�Y������f�$�=�d�yO����p�����yBj8jU�o�/�S��?�U��*������ˍ�0����� �u�q�m [�?f����a�� )Q�>����6#������� ?����0UQ����,IX���(6ڵ[�DI�MNލ�c&���υ�j\��X�R|,4��� j������T�hA�e��^���d���b<����n�� �즇�=!���3�^�`j�h�ȓr��jẕ�c�,ٞX����-����a�ﶔ���#�$��]w�O��Ӫ�1y%��L�Y<�wg#�ǝ�̗`�x�xa�t�w��»1���o7o5��>�m뭛C���Uƃߜ}�C���y1Xνm�F8�jI���]����H���ۺиE@I�i;r�8ӭ���� V�F�Շ| ��&?�3|x�B�MuS�Ge�=Ӕ�#BE5G�� ���Y!z��_e��q�р/W>|-�Ci߇�t�1ޯќd�R3�u��g�=0 5��[?�#͏��q�cf���H��{ ?u�=?�?ǯ���}Z��z���hmΔ�BFTW�����<�q� (v� ��!��z���iW]*�J�V�z��gX֧A�q�&��/w���u�gYӘa���; �i=����g:��?2�dž6�ى�k�4�>�Pxs����}������G�9� �3 ���)gG�R<>r h�$��'nc�h�P��Bj��J�ҧH� -��N1���N��?��~��}-q!=��_2hc�M��l�vY%UE�@|�v����M2�.Y[|y�"Eï��K�ZF,�ɯ?,q�?v�M 80jx�"�;�9vk�����+ ֧�� �ȺU��?�%�vcV��mA�6��Qg^M��� �A}�3�nl� QRN�l8�kkn�'�����(��M�7m9و�q���%ޟ���*h$Zk"��$�9��: �?U8�Sl��,,|ɒ��xH(ѷ����Gn�/Q�4�P��G�%��Ա8�N��!� �&�7�;���eKM7�4��9R/%����l�c>�x;������>��C�:�����t��h?aKX�bhe�ᜋ^�$�Iհ �hr7%F$�E��Fd���t��5���+�(M6�t����Ü�UU|zW�=a�Ts�Tg������dqP�Q����b'�m���1{|Y����X�N��b �P~��F^F:����k6�"�j!�� �I�r�`��1&�-$�Bevk:y���#y w��I0��x��=D�4��tU���P�ZH��ڠ底taP��6����b>�xa� ���Q�#� WeF��ŮNj�p�J* mQ�N��� �*I�-*�ȩ�F�g�3 �5��V�ʊ�ɮ�a��5F���O@{���NX��?����H�]3��1�Ri_u��������ѕ�� ����0��� F��~��:60�p�͈�S��qX#a�5>���`�o&+�<2�D����: �������ڝ�$�nP���*)�N�|y�Ej�F�5ټ�e���ihy�Z �>���k�bH�a�v��h�-#���!�Po=@k̆IEN��@��}Ll?j�O������߭�ʞ���Q|A07x���wt!xf���I2?Z��<ץ�T���cU�j��]�� 陎Ltl �}5�ϓ��$�,��O�mˊ�;�@O��jE��j(�ا,��LX���LO���Ц�90�O �.����a��nA���7������j4 ��W��_ٓ���zW�jcB������y՗+EM�)d���N�g6�y1_x��p�$Lv :��9�"z��p���ʙ$��^��JԼ*�ϭ����o���=x�Lj�6�J��u82�A�H�3$�ٕ@�=Vv�]�'�qEz�;I˼��)��=��ɯ���x �/�W(V���p�����$ �m�������u�����񶤑Oqˎ�T����r��㠚x�sr�GC��byp�G��1ߠ�w e�8�$⿄����/�M{*}��W�]˷.�CK\�ުx���/$�WP w���r� |i���&�}�{�X� �>��$-��l���?-z���g����lΆ���(F���h�vS*���b���߲ڡn,|)mrH[���a�3�ר�[1��3o_�U�3�TC�$��(�=�)0�kgP���� ��u�^=��4 �WYCҸ:��vQ�ר�X�à��tk�m,�t*��^�,�}D*� �"(�I��9R����>`�`��[~Q]�#af��i6l��8���6�:,s�s�N6�j"�A4���IuQ��6E,�GnH��zS�HO�uk�5$�I�4��ؤ�Q9�@��C����wp �BGv[]�u�Ov��� 0I4���\��y�����Q�Ѹ��~>Z��8�T��a��q�ޣ;z��a���/��S��I:�ܫ_�|������>=Z����8:�S��U�I�J��"IY���8%b8���H��:�QO�6�;7�I�S��J��ҌAά3��>c���E+&jf$eC+�z�;��V����� �r���ʺ������my�e���aQ�f&��6�ND ��.:��NT�vm�<- u���ǝ\MvZY�N�NT��-A�>jr!S��n�O 1�3�Ns�%�3D@���`������ܟ 1�^c<���� �a�ɽ�̲�Xë#�w�|y�cW�=�9I*H8�p�^(4���՗�k��arOcW�tO�\�ƍR��8����'�K���I�Q�����?5�>[�}��yU�ײ -h��=��% q�ThG�2�)���"ו3]�!kB��*p�FDl�A���,�eEi�H�f�Ps�����5�H:�Փ~�H�0Dت�D�I����h�F3�������c��2���E��9�H��5�zԑ�ʚ�i�X�=:m�xg�hd(�v����׊�9iS��O��d@0ڽ���:�p�5�h-��t�&���X�q�ӕ,��ie�|���7A�2���O%P��E��htj��Y1��w�Ѓ!����  ���� ࢽ��My�7�\�a�@�ţ�J �4�Ȼ�F�@o�̒?4�wx��)��]�P��~�����u�����5�����7X ��9��^ܩ�U;Iꭆ 5 �������eK2�7(�{|��Y׎ �V��\"���Z�1� Z�����}��(�Ǝ"�1S���_�vE30>���p;� ΝD��%x�W�?W?v����o�^V�i�d��r[��/&>�~`�9Wh��y�;���R�� � ;;ɮT��?����r$�g1�K����A��C��c��K��l:�'��3 c�ﳯ*"t8�~l��)���m��+U,z��`( �>yJ�?����h>��]��v��ЍG*�{`��;y]��I�T� ;c��NU�fo¾h���/$���|NS���1�S�"�H��V���T���4��uhǜ�]�v;���5�͠x��'C\�SBpl���h}�N����� A�Bx���%��ޭ�l��/����T��w�ʽ]D�=����K���ž�r㻠l4�S�O?=�k �M:� ��c�C�a�#ha���)�ѐxc�s���gP�iG�� {+���x���Q���I= �� z��ԫ+ �8"�k�ñ�j=|����c ��y��CF��/ ��*9ж�h{ �?4�o� ��k�m�Q�N�x��;�Y��4膚�a�w?�6�> e]�����Q�r�:����g�,i"�����ԩA� *M�<�G��b�if��l^M��5� �Ҩ�{����6J��ZJ�����P�*�����Y���ݛu�_4�9�I8�7���������,^ToR���m4�H��?�N�S�ѕw��/S��甍�@�9H�S�T��t�ƻ���ʒU��*{Xs�@����f��� ��֒Li�K{H�w^���������Ϥm�tq���s� ���ք��f:��o~s��g�r��ט� �S�ѱC�e]�x���a��) ���(b-$(�j>�7q�B?ӕ�F��hV25r[7 Y� }L�R��}����*sg+��x�r�2�U=�*'WS��ZDW]�WǞ�<��叓���{�$�9Ou4��y�90-�1�'*D`�c�^o?(�9��u���ݐ��'PI&� f�Jݮ�������:wS����jfP1F:X �H�9dԯ�� �˝[�_54 �}*;@�ܨ�� ð�yn�T���?�ןd�#���4rG�ͨ��H�1�|-#���Mr�S3��G�3�����)�.᧏3v�z֑��r����$G"�`j �1t��x0<Ɔ�Wh6�y�6��,œ�Ga��gA����y��b��)� �h�D��ß�_�m��ü �gG;��e�v��ݝ�nQ� ��C����-�*��o���y�a��M��I�>�<���]obD��"�:���G�A��-\%LT�8���c�)��+y76���o�Q�#*{�(F�⽕�y����=���rW�\p���۩�c���A���^e6��K������ʐ�cVf5$�'->���ՉN"���F�"�UQ@�f��Gb~��#�&�M=��8�ט�JNu9��D��[̤�s�o�~��� ��� G��9T�tW^g5y$b��Y'��س�Ǵ�=��U-2 #�MC�t(�i� �lj�@Q 5�̣i�*�O����s�x�K�f��}\��M{E�V�{�υ��Ƈ�����);�H����I��fe�Lȣr�2��>��W� I�Ȃ6������i��k�� �5�YOxȺ����>��Y�f5'��|��H+��98pj�n�.O�y�������jY��~��i�w'������l�;�s�2��Y��:'lg�ꥴ)o#'Sa�a�K��Z� �m��}�`169�n���"���x��I ��*+� }F<��cГ���F�P�������ֹ*�PqX�x۩��,� ��N�� �4<-����%����:��7����W���u�`����� $�?�I��&����o��o��`v�>��P��"��l���4��5'�Z�gE���8���?��[�X�7(��.Q�-��*���ތL@̲����v��.5���[��=�t\+�CNܛ��,g�SQnH����}*F�G16���&:�t��4ُ"A��̣��$�b �|����#rs��a�����T�� ]�<�j��B S�('$�ɻ� �wP;�/�n��?�ݜ��x�F��yUn�~mL*-�������Xf�wd^�a�}��f�,=t�׵i�.2/wpN�Ep8�OР���•��R�FJ� 55TZ��T �ɭ�<��]��/�0�r�@�f��V��V����Nz�G��^���7hZi����k��3�,kN�e|�vg�1{9]_i��X5y7� 8e]�U����'�-2,���e"����]ot�I��Y_��n�(JҼ��1�O ]bXc���Nu�No��pS���Q_���_�?i�~�x h5d'�(qw52] ��'ޤ�q��o1�R!���`ywy�A4u���h<קy���\[~�4�\ X�Wt/� 6�����n�F�a8��f���z �3$�t(���q��q�x��^�XWeN'p<-v�!�{�(>ӽDP7��ո0�y)�e$ٕv�Ih'Q�EA�m*�H��RI��=:��� ���4牢) �%_iN�ݧ�l]� �Nt���G��H�L��� ɱ�g<���1V�,�J~�ٹ�"K��Q�� 9�HS�9�?@��k����r�;we݁�]I�!{ �@�G�[�"��`���J:�n]�{�cA�E����V��ʆ���#��U9�6����j�#Y�m\��q�e4h�B�7��C�������d<�?J����1g:ٳ���=Y���D�p�ц� ׈ǔ��1�]26؜oS�'��9�V�FVu�P�h�9�xc�oq�X��p�o�5��Ա5$�9W�V(�[Ak�aY錎qf;�'�[�|���b�6�Ck��)��#a#a˙��8���=äh�4��2��C��4tm^ �n'c� ��]GQ$[Wҿ��i���vN�{Fu ��1�gx��1┷���N�m��{j-,��x�� Ūm�ЧS�[�s���Gna���䑴�� x�p 8<������97�Q���ϴ�v�aϚG��Rt�Һ׈�f^\r��WH�JU�7Z���y)�vg=����n��4�_)y��D'y�6�]�c�5̪ �\� �PF�k����&�c;��cq�$~T�7j ���nç]�<�g ":�to�t}�159�<�/�8������m�b�K#g'I'.W����� 6��I/��>v��\�MN��g���m�A�yQL�4u�Lj�j9��#44�t��l^�}L����n��R��!��t��±]��r��h6ٍ>�yҏ�N��fU�� ���� Fm@�8}�/u��jb9������he:A�y�ծw��GpΧh�5����l}�3p468��)U��d��c����;Us/�֔�YX�1�O2��uq�s��`hwg�r~�{ R��mhN��؎*q 42�*th��>�#���E����#��Hv�O����q�}����� 6�e��\�,Wk�#���X��b>��p}�դ��3���T5��†��6��[��@ �P�y*n��|'f�֧>�lư΂�̺����SU�'*�q�p�_S�����M�� '��c�6��� ��m�� ySʨ;M��r���Ƌ�m�Kxo,���Gm�P��A�G�:��i��w�9�}M(�^�V��$ǒ�ѽ�9���|���� �a����J�SQ�a���r�B;����}���ٻ֢�2�%U���c�#�g���N�a�ݕ�'�v�[�OY'��3L�3�;,p�]@�S��{ls��X�'���c�jw� k'a�.��}�}&�� �dP�*�bK=ɍ!����;3n�gΊU�ߴmt�'*{,=SzfD� A��ko~�G�aoq�_mi}#�m�������P�Xhύ��� �mxǍ�΂���巿zf��Q���c���|kc�����?���W��Y�$���_Lv����l߶��c���`?����l�j�ݲˏ!V��6����U�Ђ(A���4y)H���p�Z_�x��>���e�� R��$�/�`^'3qˏ�-&Q�=?��CFVR �D�fV�9��{�8g�������n�h�(P"��6�[�D���< E�����~0<@�`�G�6����Hг�cc�� �c�K.5��D��d�B���`?�XQ��2��ٿyqo&+�1^� DW�0�ꊩ���G�#��Q�nL3��c���������/��x ��1�1 [y�x�პCW��C�c�UĨ80�m�e�4.{�m��u���I=��f�����0QRls9���f���������9���~f�����Ǩ��a�"@�8���ȁ�Q����#c�ic������G��$���G���r/$W�(��W���V�"��m�7�[m�A�m����bo��D� j����۳� l���^�k�h׽����� ��#� iXn�v��eT�k�a�^Y�4�BN�� ĕ�� 0    !01@Q"2AaPq3BR������ ? � ��@4�Q�����T3,���㺠�W�[=JK�Ϟ���2�r^7��vc�:�9 �E�ߴ�w�S#d���Ix��u��:��Hp��9E!�� V 2;73|F��9Y���*ʬ�F��D����u&���y؟��^EA��A��(ɩ���^��GV:ݜDy�`��Jr29ܾ�㝉��[���E;Fzx��YG��U�e�Y�C���� ����v-tx����I�sם�Ę�q��Eb�+P\ :>�i�C'�;�����k|z�رn�y]�#ǿb��Q��������w�����(�r|ӹs��[�D��2v-%��@;�8<a���[\o[ϧw��I!��*0�krs)�[�J9^��ʜ��p1)� "��/_>��o��<1����A�E�y^�C��`�x1'ܣn�p��s`l���fQ��):�l����b>�Me�jH^?�kl3(�z:���1ŠK&?Q�~�{�ٺ�h�y���/�[��V�|6��}�KbX����mn[-��7�5q�94�������dm���c^���h� X��5��<�eޘ>G���-�}�دB�ޟ� ��|�rt�M��V+�]�c?�-#ڛ��^ǂ}���Lkr���O��u�>�-D�ry� D?:ޞ�U��ǜ�7�V��?瓮�"�#���r��չģVR;�n���/_� ؉v�ݶe5d�b9��/O��009�G���5n�W����JpA�*�r9�>�1��.[t���s�F���nQ� V 77R�]�ɫ8����_0<՜�IF�u(v��4��F�k�3��E)��N:��yڮe��P�`�1}�$WS��J�SQ�N�j �ٺ��޵�#l���ј(�5=��5�lǏmoW�v-�1����v,W�mn��߀$x�<����v�j(����c]��@#��1������Ǔ���o'��u+����;G�#�޸��v-lη��/(`i⣍Pm^� ��ԯ̾9Z��F��������n��1��� ��]�[��)�'������ :�֪�W��FC����� �B9،!?���]��V��A�Վ�M��b�w��G F>_DȬ0¤�#�QR�[V��kz���m�w�"��9ZG�7'[��=�Q����j8R?�zf�\a�=��O�U����*oB�A�|G���2�54 �p��.w7� �� ��&������ξxGHp� B%��$g�����t�Џ򤵍z���HN�u�Я�-�'4��0�� ;_�� 3     !01"@AQa2Pq#3BR������ ? � �ʩca��en��^��8���<�u#��m*08r��y�N"�<�Ѳ0��@\�p��� �����Kv�D��J8�Fҽ� �f�Y��-m�ybX�NP����}�!*8t(�OqѢ��Q�wW�K��ZD��Δ^e��!� ��B�K��p~�����e*l}z#9ң�k���q#�Ft�o��S�R����-�w�!�S���Ӥß|M�l޶V��!eˈ�8Y���c�ЮM2��tk���� ������J�fS����Ö*i/2�����n]�k�\���|4yX�8��U�P.���Ы[���l��@"�t�<������5�lF���vU�����W��W��;�b�cД^6[#7@vU�xgZv��F�6��Q,K�v��� �+Ъ��n��Ǣ��Ft���8��0��c�@�!�Zq s�v�t�;#](B��-�nῃ~���3g������5�J�%���O������n�kB�ĺ�.r��+���#�N$?�q�/�s�6��p��a����a��J/��M�8��6�ܰ"�*������ɗud"\w���aT(����[��F��U՛����RT�b���n�*��6���O��SJ�.�ij<�v�MT��R\c��5l�sZB>F��<7�;EA��{��E���Ö��1U/�#��d1�a�n.1ě����0�ʾR�h��|�R��Ao�3�m3 ��%�� ���28Q� ��y��φ���H�To�7�lW>����#i`�q���c����a��� �m,B�-j����݋�'mR1Ήt�>��V��p���s�0IbI�C.���1R�ea�����]H�6�������� ��4B>��o��](��$B���m�����a�!=� �?�B� K�Ǿ+�Ծ"�n���K��*��+��[T#�{ E�J�S����Q�����s�5�:�U�\wĐ�f�3����܆&�)��� �I���Ԇw��E T�lrTf6Q|R�h:��[K�� �z��c֧�G�C��%\��_�a �84��HcO�bi��ؖV��7H �)*ģK~Xhչ0��4?�0��� �E<���}3���#���u�?�� ��|g�S�6ꊤ�|�I#Hڛ� �ա��w�X��9��7���Ŀ%�SL��y6č��|�F�a 8���b� �$�sק�h���b9RAu7�˨p�Č�_\*w��묦��F ����4D~�f����|(�"m���NK��i�S�>�$d7SlA��/�²����SL��|6N�}���S�˯���g��]6��; �#�.��<���q'Q�1|KQ$�����񛩶"�$r�b:���N8�w@��8$�� �AjfG|~�9F ���Y��ʺ��Bwؒ������M:I岎�G��`s�YV5����6��A �b:�W���G�q%l�����F��H���7�������Fsv7� �k�� 403WebShell
403Webshell
Server IP : 127.0.0.1  /  Your IP : 10.100.1.254
Web Server : Apache/2.4.58 (Win64) OpenSSL/3.1.3 PHP/8.0.30
System : Windows NT WIZC-EXTRANET 10.0 build 19045 (Windows 10) AMD64
User : SYSTEM ( 0)
PHP Version : 8.0.30
Disable Function : NONE
MySQL : OFF  |  cURL : ON  |  WGET : OFF  |  Perl : OFF  |  Python : OFF  |  Sudo : OFF  |  Pkexec : OFF
Directory :  C:/xampp/src/xampp-control-panel/

Upload File :
current_dir [ Writeable ] document_root [ Writeable ]

 

Command :

[ Back ]     

Current File : C:/xampp/src/xampp-control-panel/gnugettext.pas
{ *------------------------------------------------------------------------------
  GNU gettext translation system for Delphi, Kylix, C++ Builder and others.
  All parts of the translation system are kept in this unit.

  @author Lars B. Dybdahl and others
  @version $LastChangedRevision$
  @see http://dybdahl.dk/dxgettext/
  ------------------------------------------------------------------------------- }
unit gnugettext;
(* ************************************************************ *)
(* *)
(* (C) Copyright by Lars B. Dybdahl and others *)
(* E-mail: Lars@dybdahl.dk, phone +45 70201241 *)
(* *)
(* Contributors: Peter Thornqvist, Troy Wolbrink, *)
(* Frank Andreas de Groot, Igor Siticov, *)
(* Jacques Garcia Vazquez, Igor Gitman *)
(* *)
(* See http://dybdahl.dk/dxgettext/ for more information *)
(* *)
(* ************************************************************ *)

// Information about this file:
// $LastChangedDate$
// $LastChangedRevision$
// $HeadURL$

// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are met:
//
// The names of any contributor may not be used to endorse or promote
// products derived from this software without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
// SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
// CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
// OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

interface

// If the conditional define DXGETTEXTDEBUG is defined, debugging log is activated.
// Use DefaultInstance.DebugLogToFile() to write the log to a file.
{ $define DXGETTEXTDEBUG }

{$IFDEF VER140}
// Delphi 6
{$DEFINE DELPHI2007OROLDER}
{$IFDEF MSWINDOWS}
{$DEFINE DELPHI6OROLDER}
{$ENDIF}
{$ENDIF}
{$IFDEF VER150}
// Delphi 7
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER160}
// Delphi 8
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER170}
// Delphi 2005
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER180}
// Delphi 2006
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER190}
// Delphi 2007
{$DEFINE DELPHI2007OROLDER}
{$ENDIF}
{$IFDEF VER200}
// Delphi 2009 with Unicode
{$ENDIF}

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ELSE}
  Libc,
{$IFDEF FPC}
  CWString,
{$ENDIF}
{$ENDIF}
  Classes, StrUtils, SysUtils, TypInfo;

(* *************************************************************************** *)
(* *)
(* MAIN API *)
(* *)
(* *************************************************************************** *)

type
{$IFNDEF UNICODE}
  UnicodeString = WideString;
  RawUtf8String = AnsiString;
  RawByteString = AnsiString;
{$ELSE}
  RawUtf8String = RawByteString;
{$ENDIF}
  DomainString = string;
  LanguageString = string;
  ComponentNameString = string;
  FilenameString = string;
  MsgIdString = UnicodeString;
  TranslatedUnicodeString = UnicodeString;

  // Main GNU gettext functions. See documentation for instructions on how to use them.
function _(const szMsgId: MsgIdString): TranslatedUnicodeString;
function gettext(const szMsgId: MsgIdString): TranslatedUnicodeString;
function dgettext(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
function dngettext(const szDomain: DomainString; const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
function ngettext(const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
procedure textdomain(const szDomain: DomainString);
function getcurrenttextdomain: DomainString;
procedure bindtextdomain(const szDomain: DomainString; const szDirectory: FilenameString);

// Set language to use
procedure UseLanguage(LanguageCode: LanguageString);
function GetCurrentLanguage: LanguageString;

// Translates a component (form, frame etc.) to the currently selected language.
// Put TranslateComponent(self) in the OnCreate event of all your forms.
// See the manual for documentation on these functions
type
  TTranslator = procedure(obj: TObject) of object;

procedure TP_Ignore(AnObject: TObject; const name: ComponentNameString);
procedure TP_IgnoreClass(IgnClass: TClass);
procedure TP_IgnoreClassProperty(IgnClass: TClass; const propertyname: ComponentNameString);
procedure TP_GlobalIgnoreClass(IgnClass: TClass);
procedure TP_GlobalIgnoreClassProperty(IgnClass: TClass; const propertyname: ComponentNameString);
procedure TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator);
procedure TranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');
procedure RetranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');

// Add more domains that resourcestrings can be extracted from. If a translation
// is not found in the default domain, this domain will be searched, too.
// This is useful for adding mo files for certain runtime libraries and 3rd
// party component libraries
procedure AddDomainForResourceString(const domain: DomainString);
procedure RemoveDomainForResourceString(const domain: DomainString);

// Unicode-enabled way to get resourcestrings, automatically translated
// Use like this: ws:=LoadResStringW(@NameOfResourceString);
function LoadResString(ResStringRec: PResStringRec): WideString;
function LoadResStringW(ResStringRec: PResStringRec): UnicodeString;

// This returns an empty string if not translated or translator name is not specified.
function GetTranslatorNameAndEmail: TranslatedUnicodeString;

(* *************************************************************************** *)
(* *)
(* ADVANCED FUNCTIONALITY *)
(* *)
(* *************************************************************************** *)

const
  DefaultTextDomain = 'default';

var
  ExecutableFilename: FilenameString;
  // This is set to paramstr(0) or the name of the DLL you are creating.

const
  PreferExternal = false;
  // Set to true, to prefer external *.mo over embedded translation

const
  // Subversion source code version control version information
  VCSVersion = '$LastChangedRevision$';

type
  EGnuGettext = class(Exception);
  EGGProgrammingError = class(EGnuGettext);
  EGGComponentError = class(EGnuGettext);
  EGGIOError = class(EGnuGettext);
  EGGAnsi2WideConvError = class(EGnuGettext);

  // This function will turn resourcestring hooks on or off, eventually with BPL file support.
  // Please do not activate BPL file support when the package is in design mode.
const
  AutoCreateHooks = true;
procedure HookIntoResourceStrings(enabled: boolean = true; SupportPackages: boolean = false);

(* *************************************************************************** *)
(* *)
(* CLASS based implementation. *)
(* Use TGnuGettextInstance to have more than one language *)
(* in your application at the same time *)
(* *)
(* *************************************************************************** *)

{$IFDEF MSWINDOWS}
{$IFNDEF DELPHI6OROLDER}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$ENDIF}
{$ENDIF}

type
  TOnDebugLine = Procedure(Sender: TObject; const Line: String; var Discard: boolean) of Object;
  // Set Discard to false if output should still go to ordinary debug log
  TGetPluralForm = function(Number: longint): Integer;
  TDebugLogger = procedure(Line: AnsiString) of object;

  { *------------------------------------------------------------------------------
    Handles .mo files, in separate files or inside the exe file.
    Don't use this class. It's for internal use.
    ------------------------------------------------------------------------------- }
  TMoFile = class
    /// Threadsafe. Only constructor and destructor are writing to memory
  private
    doswap: boolean;
  public
    Users: Integer;
    /// Reference count. If it reaches zero, this object should be destroyed.
    constructor Create(filename: FilenameString; Offset, Size: int64);
    destructor Destroy; override;
    function gettext(const msgid: RawUtf8String; var found: boolean): RawUtf8String; // uses mo file and utf-8
    property isSwappedArchitecture: boolean read doswap;
  private
    N, O, T: Cardinal;
    /// Values defined at http://www.linuxselfhelp.com/gnu/gettext/html_chapter/gettext_6.html
    startindex, startstep: Integer;
{$IFDEF mswindows}
    mo: THandle;
    momapping: THandle;
{$ENDIF}
    momemoryHandle: PAnsiChar;
    momemory: PAnsiChar;
    function autoswap32(i: Cardinal): Cardinal;
    function CardinalInMem(baseptr: PAnsiChar; Offset: Cardinal): Cardinal;
  end;

  { *------------------------------------------------------------------------------
    Handles all issues regarding a specific domain.
    Don't use this class. It's for internal use.
    ------------------------------------------------------------------------------- }
  TDomain = class
  private
    enabled: boolean;
    vDirectory: FilenameString;
    procedure setDirectory(const dir: FilenameString);
  public
    DebugLogger: TDebugLogger;
    domain: DomainString;
    property Directory: FilenameString read vDirectory write setDirectory;
    constructor Create;
    destructor Destroy; override;
    // Set parameters
    procedure SetLanguageCode(const langcode: LanguageString);
    procedure SetFilename(const filename: FilenameString);
    // Bind this domain to a specific file
    // Get information
    procedure GetListOfLanguages(list: TStrings);
    function GetTranslationProperty(propertyname: ComponentNameString): TranslatedUnicodeString;
    function gettext(const msgid: RawUtf8String): RawUtf8String;
    // uses mo file and utf-8
  private
    mofile: TMoFile;
    SpecificFilename: FilenameString;
    curlang: LanguageString;
    OpenHasFailedBefore: boolean;
    procedure OpenMoFile;
    procedure CloseMoFile;
  end;

  { *------------------------------------------------------------------------------
    Helper class for invoking events.
    ------------------------------------------------------------------------------- }
  TExecutable = class
    procedure Execute; virtual; abstract;
  end;

  { *------------------------------------------------------------------------------
    The main translation engine.
    ------------------------------------------------------------------------------- }
  TGnuGettextInstance = class
  private
    fOnDebugLine: TOnDebugLine;
    CreatorThread: Cardinal;
    /// Only this thread can use LoadResString
  public
    enabled: boolean;
    /// Set this to false to disable translations
    DesignTimeCodePage: Integer;
    /// See MultiByteToWideChar() in Win32 API for documentation
    constructor Create;
    destructor Destroy; override;
    procedure UseLanguage(LanguageCode: LanguageString);
    procedure GetListOfLanguages(const domain: DomainString; list: TStrings);
    // Puts list of language codes, for which there are translations in the specified domain, into list
{$IFNDEF UNICODE}
    function gettext(const szMsgId: AnsiString): TranslatedUnicodeString; overload; virtual;
    function ngettext(const singular, plural: AnsiString; Number: longint): TranslatedUnicodeString; overload; virtual;
{$ENDIF}
    function gettext(const szMsgId: MsgIdString): TranslatedUnicodeString; overload; virtual;
    function gettext_NoExtract(const szMsgId: MsgIdString): TranslatedUnicodeString;
    function ngettext(const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString; overload; virtual;
    function ngettext_NoExtract(const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
    function GetCurrentLanguage: LanguageString;
    function GetTranslationProperty(const propertyname: ComponentNameString): TranslatedUnicodeString;
    function GetTranslatorNameAndEmail: TranslatedUnicodeString;

    // Form translation tools, these are not threadsafe. All TP_ procs must be called just before TranslateProperites()
    procedure TP_Ignore(AnObject: TObject; const name: ComponentNameString);
    procedure TP_IgnoreClass(IgnClass: TClass);
    procedure TP_IgnoreClassProperty(IgnClass: TClass; propertyname: ComponentNameString);
    procedure TP_GlobalIgnoreClass(IgnClass: TClass);
    procedure TP_GlobalIgnoreClassProperty(IgnClass: TClass; propertyname: ComponentNameString);
    procedure TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator);
    procedure TranslateProperties(AnObject: TObject; textdomain: DomainString = '');
    procedure TranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');
    procedure RetranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');

    // Multi-domain functions
{$IFNDEF UNICODE}
    function dgettext(const szDomain: DomainString; const szMsgId: AnsiString): TranslatedUnicodeString; overload; virtual;
    function dngettext(const szDomain: DomainString; const singular, plural: AnsiString; Number: longint): TranslatedUnicodeString; overload; virtual;
{$ENDIF}
    function dgettext(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString; overload; virtual;
    function dgettext_NoExtract(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
    function dngettext(const szDomain: DomainString; const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
      overload; virtual;
    function dngettext_NoExtract(const szDomain: DomainString; const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
    procedure textdomain(const szDomain: DomainString);
    function getcurrenttextdomain: DomainString;
    procedure bindtextdomain(const szDomain: DomainString; const szDirectory: FilenameString);
    procedure bindtextdomainToFile(const szDomain: DomainString; const filename: FilenameString);
    // Also works with files embedded in exe file

    // Windows API functions
    function LoadResString(ResStringRec: PResStringRec): UnicodeString;

    // Output all log info to this file. This may only be called once.
    procedure DebugLogToFile(const filename: FilenameString; append: boolean = false);
    procedure DebugLogPause(PauseEnabled: boolean);
    property OnDebugLine: TOnDebugLine read fOnDebugLine write fOnDebugLine;
    // If set, all debug output goes here
{$IFNDEF UNICODE}
    // Conversion according to design-time character set
    function ansi2wideDTCP(const s: AnsiString): MsgIdString;
    // Convert using Design Time Code Page
{$ENDIF}
  protected
    procedure TranslateStrings(sl: TStrings; const textdomain: DomainString);

    // Override these three, if you want to inherited from this class
    // to create a new class that handles other domain and language dependent
    // issues
    procedure WhenNewLanguage(const LanguageID: LanguageString); virtual;
    // Override to know when language changes
    procedure WhenNewDomain(const textdomain: DomainString); virtual;
    // Override to know when text domain changes. Directory is purely informational
    procedure WhenNewDomainDirectory(const textdomain: DomainString; const Directory: FilenameString); virtual;
    // Override to know when any text domain's directory changes. It won't be called if a domain is fixed to a specific file.
  private
    curlang: LanguageString;
    curGetPluralForm: TGetPluralForm;
    curmsgdomain: DomainString;
    savefileCS: TMultiReadExclusiveWriteSynchronizer;
    savefile: TextFile;
    savememory: TStringList;
    DefaultDomainDirectory: FilenameString;
    domainlist: TStringList;
    /// List of domain names. Objects are TDomain.
    TP_IgnoreList: TStringList;
    /// Temporary list, reset each time TranslateProperties is called
    TP_ClassHandling: TList;
    /// Items are TClassMode. If a is derived from b, a comes first
    TP_GlobalClassHandling: TList;
    /// Items are TClassMode. If a is derived from b, a comes first
    TP_Retranslator: TExecutable;
    /// Cast this to TTP_Retranslator
{$IFDEF DXGETTEXTDEBUG}
    DebugLogCS: TMultiReadExclusiveWriteSynchronizer;
    DebugLog: TStream;
    DebugLogOutputPaused: boolean;
{$ENDIF}
    function TP_CreateRetranslator: TExecutable; // Must be freed by caller!
    procedure FreeTP_ClassHandlingItems;
{$IFDEF DXGETTEXTDEBUG}
    procedure DebugWriteln(Line: AnsiString);
{$ENDIF}
    procedure TranslateProperty(AnObject: TObject; PropInfo: PPropInfo; TodoList: TStrings; const textdomain: DomainString);
    function Getdomain(const domain: DomainString; const DefaultDomainDirectory: FilenameString; const curlang: LanguageString): TDomain;
    // Translates a single property of an object
  end;

const
  LOCALE_SISO639LANGNAME = $59; // Used by Lazarus software development tool
  LOCALE_SISO3166CTRYNAME = $5A; // Used by Lazarus software development tool

var
  DefaultInstance: TGnuGettextInstance;
  /// Default instance of the main API for singlethreaded applications.

implementation

{$IFNDEF MSWINDOWS}
{$IFNDEF LINUX}
  'This version of gnugettext.pas is only meant to be compiled with Kylix 3,'
  'Delphi 6, Delphi 7 and later versions. If you use other versions, please' 'get the gnugettext.pas version from the Delphi 5 directory.'
{$ENDIF}
{$ENDIF}
(* ************************************************************************ *)
// Some comments on the implementation:
// This unit should be independent of other units where possible.
// It should have a small footprint in any way.
(* ************************************************************************ *)
// TMultiReadExclusiveWriteSynchronizer is used instead of TCriticalSection
// because it makes this unit independent of the SyncObjs unit
(* ************************************************************************ *)

{$B-,R+,I+,Q+}
  type TTP_RetranslatorItem = class obj: TObject;
Propname:
ComponentNameString;
OldValue:
TranslatedUnicodeString;
end;
TTP_Retranslator = class(TExecutable)textdomain: DomainString;
Instance:
TGnuGettextInstance;

constructor Create;
  destructor Destroy; override;
    procedure Remember(obj: TObject; Propname: ComponentNameString; OldValue: TranslatedUnicodeString);
      procedure Execute; override;
      private
        list: TList;
        end;
        TEmbeddedFileInfo = class Offset, Size: int64;
        end;
        TFileLocator = class
        // This class finds files even when embedded inside executable
          constructor Create;
        destructor Destroy;
        override;
        procedure Analyze; // List files embedded inside executable
        function FileExists(filename: FilenameString): boolean;
        function GetMoFile(filename: FilenameString; DebugLogger: TDebugLogger): TMoFile;
        procedure ReleaseMoFile(mofile: TMoFile);
      private
        basedirectory: FilenameString;
        filelist: TStringList;
        // Objects are TEmbeddedFileInfo. Filenames are relative to .exe file
        MoFilesCS: TMultiReadExclusiveWriteSynchronizer;
        MoFiles: TStringList;
        // Objects are filenames+offset, objects are TMoFile
        function ReadInt64(str: TStream): int64;
        end;
        TGnuGettextComponentMarker = class(TComponent)public LastLanguage: LanguageString;
        Retranslator: TExecutable;
        destructor Destroy;
        override;
        end;
        TClassMode = class HClass: TClass;
        SpecialHandler: TTranslator;
        PropertiesToIgnore: TStringList; // This is ignored if Handler is set
        constructor Create;
        destructor Destroy;
        override;
        end;
        TRStrinfo = record strlength, stroffset: Cardinal;
        end;
        TStrInfoArr = array [0 .. 10000000] of TRStrinfo;
        PStrInfoArr = ^TStrInfoArr;
        TCharArray5 = array [0 .. 4] of ansichar;
        THook = // Replaces a runtime library procedure with a custom procedure
          class public constructor Create(OldProcedure, NewProcedure: pointer; FollowJump: boolean = false);
        destructor Destroy;
        override; // Restores unhooked state
        procedure Reset(FollowJump: boolean = false);
        // Disables and picks up patch points again
        procedure Disable;
        procedure Enable;
      private
        oldproc, newproc: pointer;
        Patch: TCharArray5;
        Original: TCharArray5;
        PatchPosition: PAnsiChar;
        procedure Shutdown;
        // Same as destroy, except that object is not destroyed
        end;

      var
        // System information
        Win32PlatformIsUnicode: boolean = false;

        // Information about files embedded inside .exe file
        FileLocator: TFileLocator;

        // Hooks into runtime library functions
        ResourceStringDomainListCS: TMultiReadExclusiveWriteSynchronizer;
        ResourceStringDomainList: TStringList;
        HookLoadResString: THook;
        HookLoadStr: THook;
        HookFmtLoadStr: THook;

        function GGGetEnvironmentVariable(const name: WideString): WideString;
        var
          Len: Integer;
          W: WideString;
        begin
          Result := '';
          SetLength(W, 1);
          Len := Windows.GetEnvironmentVariableW(PWideChar(Name), PWideChar(W), 1);
          if Len > 0 then
          begin
            SetLength(Result, Len - 1);
            Windows.GetEnvironmentVariableW(PWideChar(Name), PWideChar(Result), Len);
          end;
        end;

        function StripCRRawMsgId(s: RawUtf8String): RawUtf8String;
        var
          i: Integer;
        begin
          i := 1;
          while i <= length(s) do
          begin
            if s[i] = #13 then
              delete(s, i, 1)
            else
              inc(i);
          end;
          Result := s;
        end;

        function EnsureLineBreakInTranslatedString(s: RawUtf8String): RawUtf8String;
{$IFDEF MSWINDOWS}
        var
          i: Integer;
{$ENDIF}
        begin
{$IFDEF MSWINDOWS}
          Assert(sLinebreak = AnsiString(#13#10));
          i := 1;
          while i <= length(s) do
          begin
            if (s[i] = #10) and (MidStr(s, i - 1, 1) <> #13) then
            begin
              insert(#13, s, i);
              inc(i, 2);
            end
            else
              inc(i);
          end;
{$ENDIF}
          Result := s;
        end;

        function IsWriteProp(Info: PPropInfo): boolean;
        begin
          Result := Assigned(Info) and (Info^.SetProc <> nil);
        end;

        function ResourceStringGettext(msgid: MsgIdString): TranslatedUnicodeString;
        var
          i: Integer;
        begin
          if (msgid = '') or (ResourceStringDomainListCS = nil) then
          begin
            // This only happens during very complicated program startups that fail,
            // or when Msgid=''
            Result := msgid;
            exit;
          end;
          ResourceStringDomainListCS.BeginRead;
          try
            for i := 0 to ResourceStringDomainList.Count - 1 do
            begin
              Result := dgettext(ResourceStringDomainList.Strings[i], msgid);
              if Result <> msgid then
                break;
            end;
          finally
            ResourceStringDomainListCS.EndRead;
          end;
        end;

        function gettext(const szMsgId: MsgIdString): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.gettext(szMsgId);
        end;

      { *------------------------------------------------------------------------------
        This is the main translation procedure used in programs. It takes a parameter,
        looks it up in the translation dictionary, and returns the translation.
        If no translation is found, the parameter is returned.

        @param szMsgId The text, that should be displayed if no translation is found.
        ------------------------------------------------------------------------------- }
        function _(const szMsgId: MsgIdString): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.gettext(szMsgId);
        end;

      { *------------------------------------------------------------------------------
        Translates a text, using a specified translation domain.
        If no translation is found, the parameter is returned.

        @param szDomain Which translation domain that should be searched for a translation.
        @param szMsgId The text, that should be displayed if no translation is found.
        ------------------------------------------------------------------------------- }
        function dgettext(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.dgettext(szDomain, szMsgId);
        end;

        function dngettext(const szDomain: DomainString; const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.dngettext(szDomain, singular, plural, Number);
        end;

        function ngettext(const singular, plural: MsgIdString; Number: longint): TranslatedUnicodeString;
        begin
          Result := DefaultInstance.ngettext(singular, plural, Number);
        end;

        procedure textdomain(const szDomain: DomainString);
        begin
          DefaultInstance.textdomain(szDomain);
        end;

        procedure SetGettextEnabled(enabled: boolean);
        begin
          DefaultInstance.enabled := enabled;
        end;

        function getcurrenttextdomain: DomainString;
        begin
          Result := DefaultInstance.getcurrenttextdomain;
        end;

        procedure bindtextdomain(const szDomain: DomainString; const szDirectory: FilenameString);
        begin
          DefaultInstance.bindtextdomain(szDomain, szDirectory);
        end;

        procedure TP_Ignore(AnObject: TObject; const name: FilenameString);
        begin
          DefaultInstance.TP_Ignore(AnObject, name);
        end;

        procedure TP_GlobalIgnoreClass(IgnClass: TClass);
        begin
          DefaultInstance.TP_GlobalIgnoreClass(IgnClass);
        end;

        procedure TP_IgnoreClass(IgnClass: TClass);
        begin
          DefaultInstance.TP_IgnoreClass(IgnClass);
        end;

        procedure TP_IgnoreClassProperty(IgnClass: TClass; const propertyname: ComponentNameString);
        begin
          DefaultInstance.TP_IgnoreClassProperty(IgnClass, propertyname);
        end;

        procedure TP_GlobalIgnoreClassProperty(IgnClass: TClass; const propertyname: ComponentNameString);
        begin
          DefaultInstance.TP_GlobalIgnoreClassProperty(IgnClass, propertyname);
        end;

        procedure TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator);
        begin
          DefaultInstance.TP_GlobalHandleClass(HClass, Handler);
        end;

        procedure TranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');
        begin
          DefaultInstance.TranslateComponent(AnObject, textdomain);
        end;

        procedure RetranslateComponent(AnObject: TComponent; const textdomain: DomainString = '');
        begin
          DefaultInstance.RetranslateComponent(AnObject, textdomain);
        end;

{$IFDEF MSWINDOWS}

      // These constants are only used in Windows 95
      // Thanks to Frank Andreas de Groot for this table
      const
        IDAfrikaans = $0436;
        IDAlbanian = $041C;
        IDArabicAlgeria = $1401;
        IDArabicBahrain = $3C01;
        IDArabicEgypt = $0C01;
        IDArabicIraq = $0801;
        IDArabicJordan = $2C01;
        IDArabicKuwait = $3401;
        IDArabicLebanon = $3001;
        IDArabicLibya = $1001;
        IDArabicMorocco = $1801;
        IDArabicOman = $2001;
        IDArabicQatar = $4001;
        IDArabic = $0401;
        IDArabicSyria = $2801;
        IDArabicTunisia = $1C01;
        IDArabicUAE = $3801;
        IDArabicYemen = $2401;
        IDArmenian = $042B;
        IDAssamese = $044D;
        IDAzeriCyrillic = $082C;
        IDAzeriLatin = $042C;
        IDBasque = $042D;
        IDByelorussian = $0423;
        IDBengali = $0445;
        IDBulgarian = $0402;
        IDBurmese = $0455;
        IDCatalan = $0403;
        IDChineseHongKong = $0C04;
        IDChineseMacao = $1404;
        IDSimplifiedChinese = $0804;
        IDChineseSingapore = $1004;
        IDTraditionalChinese = $0404;
        IDCroatian = $041A;
        IDCzech = $0405;
        IDDanish = $0406;
        IDBelgianDutch = $0813;
        IDDutch = $0413;
        IDEnglishAUS = $0C09;
        IDEnglishBelize = $2809;
        IDEnglishCanadian = $1009;
        IDEnglishCaribbean = $2409;
        IDEnglishIreland = $1809;
        IDEnglishJamaica = $2009;
        IDEnglishNewZealand = $1409;
        IDEnglishPhilippines = $3409;
        IDEnglishSouthAfrica = $1C09;
        IDEnglishTrinidad = $2C09;
        IDEnglishUK = $0809;
        IDEnglishUS = $0409;
        IDEnglishZimbabwe = $3009;
        IDEstonian = $0425;
        IDFaeroese = $0438;
        IDFarsi = $0429;
        IDFinnish = $040B;
        IDBelgianFrench = $080C;
        IDFrenchCameroon = $2C0C;
        IDFrenchCanadian = $0C0C;
        IDFrenchCotedIvoire = $300C;
        IDFrench = $040C;
        IDFrenchLuxembourg = $140C;
        IDFrenchMali = $340C;
        IDFrenchMonaco = $180C;
        IDFrenchReunion = $200C;
        IDFrenchSenegal = $280C;
        IDSwissFrench = $100C;
        IDFrenchWestIndies = $1C0C;
        IDFrenchZaire = $240C;
        IDFrisianNetherlands = $0462;
        IDGaelicIreland = $083C;
        IDGaelicScotland = $043C;
        IDGalician = $0456;
        IDGeorgian = $0437;
        IDGermanAustria = $0C07;
        IDGerman = $0407;
        IDGermanLiechtenstein = $1407;
        IDGermanLuxembourg = $1007;
        IDSwissGerman = $0807;
        IDGreek = $0408;
        IDGujarati = $0447;
        IDHebrew = $040D;
        IDHindi = $0439;
        IDHungarian = $040E;
        IDIcelandic = $040F;
        IDIndonesian = $0421;
        IDItalian = $0410;
        IDSwissItalian = $0810;
        IDJapanese = $0411;
        IDKannada = $044B;
        IDKashmiri = $0460;
        IDKazakh = $043F;
        IDKhmer = $0453;
        IDKirghiz = $0440;
        IDKonkani = $0457;
        IDKorean = $0412;
        IDLao = $0454;
        IDLatvian = $0426;
        IDLithuanian = $0427;
        IDMacedonian = $042F;
        IDMalaysian = $043E;
        IDMalayBruneiDarussalam = $083E;
        IDMalayalam = $044C;
        IDMaltese = $043A;
        IDManipuri = $0458;
        IDMarathi = $044E;
        IDMongolian = $0450;
        IDNepali = $0461;
        IDNorwegianBokmol = $0414;
        IDNorwegianNynorsk = $0814;
        IDOriya = $0448;
        IDPolish = $0415;
        IDBrazilianPortuguese = $0416;
        IDPortuguese = $0816;
        IDPunjabi = $0446;
        IDRhaetoRomanic = $0417;
        IDRomanianMoldova = $0818;
        IDRomanian = $0418;
        IDRussianMoldova = $0819;
        IDRussian = $0419;
        IDSamiLappish = $043B;
        IDSanskrit = $044F;
        IDSerbianCyrillic = $0C1A;
        IDSerbianLatin = $081A;
        IDSesotho = $0430;
        IDSindhi = $0459;
        IDSlovak = $041B;
        IDSlovenian = $0424;
        IDSorbian = $042E;
        IDSpanishArgentina = $2C0A;
        IDSpanishBolivia = $400A;
        IDSpanishChile = $340A;
        IDSpanishColombia = $240A;
        IDSpanishCostaRica = $140A;
        IDSpanishDominicanRepublic = $1C0A;
        IDSpanishEcuador = $300A;
        IDSpanishElSalvador = $440A;
        IDSpanishGuatemala = $100A;
        IDSpanishHonduras = $480A;
        IDMexicanSpanish = $080A;
        IDSpanishNicaragua = $4C0A;
        IDSpanishPanama = $180A;
        IDSpanishParaguay = $3C0A;
        IDSpanishPeru = $280A;
        IDSpanishPuertoRico = $500A;
        IDSpanishModernSort = $0C0A;
        IDSpanish = $040A;
        IDSpanishUruguay = $380A;
        IDSpanishVenezuela = $200A;
        IDSutu = $0430;
        IDSwahili = $0441;
        IDSwedishFinland = $081D;
        IDSwedish = $041D;
        IDTajik = $0428;
        IDTamil = $0449;
        IDTatar = $0444;
        IDTelugu = $044A;
        IDThai = $041E;
        IDTibetan = $0451;
        IDTsonga = $0431;
        IDTswana = $0432;
        IDTurkish = $041F;
        IDTurkmen = $0442;
        IDUkrainian = $0422;
        IDUrdu = $0420;
        IDUzbekCyrillic = $0843;
        IDUzbekLatin = $0443;
        IDVenda = $0433;
        IDVietnamese = $042A;
        IDWelsh = $0452;
        IDXhosa = $0434;
        IDZulu = $0435;

        function GetWindowsLanguage: WideString;
        var
          langid: Cardinal;
          langcode: WideString;
          CountryName: array [0 .. 4] of widechar;
          LanguageName: array [0 .. 4] of widechar;
          works: boolean;
        begin
          // The return value of GetLocaleInfo is compared with 3 = 2 characters and a zero
          works := 3 = GetLocaleInfoW(LOCALE_USER_DEFAULT, LOCALE_SISO639LANGNAME, LanguageName, SizeOf(LanguageName));
          works := works and (3 = GetLocaleInfoW(LOCALE_USER_DEFAULT, LOCALE_SISO3166CTRYNAME, CountryName, SizeOf(CountryName)));
          if works then
          begin
            // Windows 98, Me, NT4, 2000, XP and newer
            langcode := PWideChar(@(LanguageName[0]));
            if lowercase(langcode) = 'no' then
              langcode := 'nb';
            langcode := langcode + '_' + PWideChar(@CountryName[0]);
          end
          else
          begin
            // This part should only happen on Windows 95.
            langid := GetThreadLocale;
            case langid of
              IDBelgianDutch:
                langcode := 'nl_BE';
              IDBelgianFrench:
                langcode := 'fr_BE';
              IDBrazilianPortuguese:
                langcode := 'pt_BR';
              IDDanish:
                langcode := 'da_DK';
              IDDutch:
                langcode := 'nl_NL';
              IDEnglishUK:
                langcode := 'en_GB';
              IDEnglishUS:
                langcode := 'en_US';
              IDFinnish:
                langcode := 'fi_FI';
              IDFrench:
                langcode := 'fr_FR';
              IDFrenchCanadian:
                langcode := 'fr_CA';
              IDGerman:
                langcode := 'de_DE';
              IDGermanLuxembourg:
                langcode := 'de_LU';
              IDGreek:
                langcode := 'el_GR';
              IDIcelandic:
                langcode := 'is_IS';
              IDItalian:
                langcode := 'it_IT';
              IDKorean:
                langcode := 'ko_KO';
              IDNorwegianBokmol:
                langcode := 'nb_NO';
              IDNorwegianNynorsk:
                langcode := 'nn_NO';
              IDPolish:
                langcode := 'pl_PL';
              IDPortuguese:
                langcode := 'pt_PT';
              IDRussian:
                langcode := 'ru_RU';
              IDSpanish, IDSpanishModernSort:
                langcode := 'es_ES';
              IDSwedish:
                langcode := 'sv_SE';
              IDSwedishFinland:
                langcode := 'sv_FI';
            else
              langcode := 'C';
            end;
          end;
          Result := langcode;
        end;
{$ENDIF}
{$IFNDEF UNICODE}
        function LoadResStringA(ResStringRec: PResStringRec): AnsiString;
        begin
          Result := DefaultInstance.LoadResString(ResStringRec);
        end;
{$ENDIF}
        function GetTranslatorNameAndEmail: TranslatedUnicodeString;
        begin
          Result := DefaultInstance.GetTranslatorNameAndEmail;
        end;

        procedure UseLanguage(LanguageCode: LanguageString);
        begin
          DefaultInstance.UseLanguage(LanguageCode);
        end;

      type
        PStrData = ^TStrData;

        TStrData = record
          Ident: Integer;
          str: String;
        end;

        function SysUtilsEnumStringModules(Instance: NativeInt; Data: pointer): boolean;
{$IFDEF MSWINDOWS}
        var
          Buffer: array [0 .. 1023] of Char;
          // WideChar in Delphi 2008, AnsiChar before that
        begin
          with PStrData(Data)^ do
          begin
            SetString(str, Buffer, LoadString(HInstance, Ident, @Buffer[0], SizeOf(Buffer)));
            Result := str = '';
          end;
        end;
{$ENDIF}
{$IFDEF LINUX}

      var
        rs: TResStringRec;
        Module: HModule;
      begin
        Module := Instance;
        rs.Module := @Module;
        with PStrData(Data)^ do
        begin
          rs.Identifier := Ident;
          str := System.LoadResString(@rs);
          Result := str = '';
        end;
      end;
{$ENDIF}
      function SysUtilsFindStringResource(Ident: Integer): string;
      var
        StrData: TStrData;
      begin
        StrData.Ident := Ident;
        StrData.str := '';
        EnumResourceModules(SysUtilsEnumStringModules, @StrData);
        Result := StrData.str;
      end;

      function SysUtilsLoadStr(Ident: Integer): string;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DefaultInstance.DebugWriteln('Sysutils.LoadRes(' + IntToStr(Ident) + ') called');
{$ENDIF}
        Result := ResourceStringGettext(SysUtilsFindStringResource(Ident));
      end;

      function SysUtilsFmtLoadStr(Ident: Integer; const Args: array of const): string;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DefaultInstance.DebugWriteln('Sysutils.FmtLoadRes(' + IntToStr(Ident) + ',Args) called');
{$ENDIF}
        FmtStr(Result, ResourceStringGettext(SysUtilsFindStringResource(Ident)), Args);
      end;

      function LoadResString(ResStringRec: PResStringRec): WideString;
      begin
        Result := DefaultInstance.LoadResString(ResStringRec);
      end;

      function LoadResStringW(ResStringRec: PResStringRec): UnicodeString;
      begin
        Result := DefaultInstance.LoadResString(ResStringRec);
      end;

      function GetCurrentLanguage: LanguageString;
      begin
        Result := DefaultInstance.GetCurrentLanguage;
      end;

    { TDomain }

      procedure TDomain.CloseMoFile;
      begin
        if mofile <> nil then
        begin
          FileLocator.ReleaseMoFile(mofile);
          mofile := nil;
        end;
        OpenHasFailedBefore := false;
      end;

      destructor TDomain.Destroy;
      begin
        CloseMoFile;
        inherited;
      end;

{$IFDEF mswindows}
      function GetLastWinError: WideString;
      var
        errcode: Cardinal;
      begin
        SetLength(Result, 2000);
        errcode := GetLastError();
        Windows.FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM, nil, errcode, 0, PWideChar(Result), 2000, nil);
        Result := PWideChar(Result);
      end;
{$ENDIF}
      procedure TDomain.OpenMoFile;
      var
        filename: FilenameString;
      begin
        // Check if it is already open
        if mofile <> nil then
          exit;

        // Check if it has been attempted to open the file before
        if OpenHasFailedBefore then
          exit;

        if SpecificFilename <> '' then
        begin
          filename := SpecificFilename;
{$IFDEF DXGETTEXTDEBUG}
          DebugLogger('Domain ' + domain + ' is bound to specific file ' + filename);
{$ENDIF}
        end
        else
        begin
          filename := Directory + curlang + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
          if (not FileLocator.FileExists(filename)) and (not FileExists(filename)) then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugLogger('Domain ' + domain + ': File does not exist, neither embedded or in file system: ' + filename);
{$ENDIF}
            filename := Directory + MidStr(curlang, 1, 2) + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
{$IFDEF DXGETTEXTDEBUG}
            DebugLogger('Domain ' + domain + ' will attempt to use this file: ' + filename);
{$ENDIF}
          end
          else
          begin
{$IFDEF DXGETTEXTDEBUG}
            if FileLocator.FileExists(filename) then
              DebugLogger('Domain ' + domain + ' will attempt to use this embedded file: ' + filename)
            else
              DebugLogger('Domain ' + domain + ' will attempt to use this file that was found on the file system: ' + filename);
{$ENDIF}
          end;
        end;
        if (not FileLocator.FileExists(filename)) and (not FileExists(filename)) then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugLogger('Domain ' + domain + ' failed to locate the file: ' + filename);
{$ENDIF}
          OpenHasFailedBefore := true;
          exit;
        end;
{$IFDEF DXGETTEXTDEBUG}
        DebugLogger('Domain ' + domain + ' now accesses the file.');
{$ENDIF}
        mofile := FileLocator.GetMoFile(filename, DebugLogger);

{$IFDEF DXGETTEXTDEBUG}
        if mofile.isSwappedArchitecture then
          DebugLogger('.mo file is swapped (comes from another CPU architecture)');
{$ENDIF}
        // Check, that the contents of the file is utf-8
        if pos('CHARSET=UTF-8', uppercase(GetTranslationProperty('Content-Type'))) = 0 then
        begin
          CloseMoFile;
{$IFDEF DXGETTEXTDEBUG}
          DebugLogger('The translation for the language code ' + curlang + ' (in ' + filename +
            ') does not have charset=utf-8 in its Content-Type. Translations are turned off.');
{$ENDIF}
{$IFDEF MSWINDOWS}
          MessageBoxW(0, PWideChar(WideString('The translation for the language code ' + curlang + ' (in ' + filename +
            ') does not have charset=utf-8 in its Content-Type. Translations are turned off.')), 'Localization problem', MB_OK);
{$ELSE}
          writeln(stderr, 'The translation for the language code ' + curlang + ' (in ' + filename +
            ') does not have charset=utf-8 in its Content-Type. Translations are turned off.');
{$ENDIF}
          enabled := false;
        end;
      end;

{$IFDEF UNICODE}
      function utf8decode(s: RawByteString): UnicodeString; inline;
      begin
        Result := UTF8ToWideString(s);
      end;
{$ENDIF}
      function TDomain.GetTranslationProperty(propertyname: ComponentNameString): TranslatedUnicodeString;
      var
        sl: TStringList;
        i: Integer;
        s: string;
      begin
        propertyname := uppercase(propertyname) + ': ';
        sl := TStringList.Create;
        try
          sl.Text := utf8decode(gettext(''));
          for i := 0 to sl.Count - 1 do
          begin
            s := sl.Strings[i];
            if uppercase(MidStr(s, 1, length(propertyname))) = propertyname then
            begin
              Result := trim(MidStr(s, length(propertyname) + 1, maxint));

{$IFDEF DXGETTEXTDEBUG}
              DebugLogger('GetTranslationProperty(' + propertyname + ') returns ''' + Result + '''.');
{$ENDIF}
              exit;
            end;
          end;
        finally
          FreeAndNil(sl);
        end;
        Result := '';
{$IFDEF DXGETTEXTDEBUG}
        DebugLogger('GetTranslationProperty(' + propertyname + ') did not find any value. An empty string is returned.');
{$ENDIF}
      end;

      procedure TDomain.setDirectory(const dir: FilenameString);
      begin
        vDirectory := IncludeTrailingPathDelimiter(dir);
        SpecificFilename := '';
        CloseMoFile;
      end;

      procedure AddDomainForResourceString(const domain: DomainString);
      begin
{$IFDEF DXGETTEXTDEBUG}
        DefaultInstance.DebugWriteln('Extra domain for resourcestring: ' + domain);
{$ENDIF}
        ResourceStringDomainListCS.BeginWrite;
        try
          if ResourceStringDomainList.IndexOf(domain) = -1 then
            ResourceStringDomainList.Add(domain);
        finally
          ResourceStringDomainListCS.EndWrite;
        end;
      end;

      procedure RemoveDomainForResourceString(const domain: DomainString);
      var
        i: Integer;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DefaultInstance.DebugWriteln('Remove domain for resourcestring: ' + domain);
{$ENDIF}
        ResourceStringDomainListCS.BeginWrite;
        try
          i := ResourceStringDomainList.IndexOf(domain);
          if i <> -1 then
            ResourceStringDomainList.delete(i);
        finally
          ResourceStringDomainListCS.EndWrite;
        end;
      end;

      procedure TDomain.SetLanguageCode(const langcode: LanguageString);
      begin
        CloseMoFile;
        curlang := langcode;
      end;

      function GetPluralForm2EN(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if Number = 1 then
          Result := 0
        else
          Result := 1;
      end;

      function GetPluralForm1(Number: Integer): Integer;
      begin
        Result := 0;
      end;

      function GetPluralForm2FR(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if (Number = 1) or (Number = 0) then
          Result := 0
        else
          Result := 1;
      end;

      function GetPluralForm3LV(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if (Number mod 10 = 1) and (Number mod 100 <> 11) then
          Result := 0
        else if Number <> 0 then
          Result := 1
        else
          Result := 2;
      end;

      function GetPluralForm3GA(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if Number = 1 then
          Result := 0
        else if Number = 2 then
          Result := 1
        else
          Result := 2;
      end;

      function GetPluralForm3LT(Number: Integer): Integer;
      var
        n1, n2: byte;
      begin
        Number := abs(Number);
        n1 := Number mod 10;
        n2 := Number mod 100;
        if (n1 = 1) and (n2 <> 11) then
          Result := 0
        else if (n1 >= 2) and ((n2 < 10) or (n2 >= 20)) then
          Result := 1
        else
          Result := 2;
      end;

      function GetPluralForm3PL(Number: Integer): Integer;
      var
        n1, n2: byte;
      begin
        Number := abs(Number);
        n1 := Number mod 10;
        n2 := Number mod 100;

        if Number = 1 then
          Result := 0
        else if (n1 >= 2) and (n1 <= 4) and ((n2 < 10) or (n2 >= 20)) then
          Result := 1
        else
          Result := 2;
      end;

      function GetPluralForm3RU(Number: Integer): Integer;
      var
        n1, n2: byte;
      begin
        Number := abs(Number);
        n1 := Number mod 10;
        n2 := Number mod 100;
        if (n1 = 1) and (n2 <> 11) then
          Result := 0
        else if (n1 >= 2) and (n1 <= 4) and ((n2 < 10) or (n2 >= 20)) then
          Result := 1
        else
          Result := 2;
      end;

      function GetPluralForm3SK(Number: Integer): Integer;
      begin
        Number := abs(Number);
        if Number = 1 then
          Result := 0
        else if (Number < 5) and (Number <> 0) then
          Result := 1
        else
          Result := 2;
      end;

      function GetPluralForm4SL(Number: Integer): Integer;
      var
        n2: byte;
      begin
        Number := abs(Number);
        n2 := Number mod 100;
        if n2 = 1 then
          Result := 0
        else if n2 = 2 then
          Result := 1
        else if (n2 = 3) or (n2 = 4) then
          Result := 2
        else
          Result := 3;
      end;

      procedure TDomain.GetListOfLanguages(list: TStrings);
      var
        sr: TSearchRec;
        more: boolean;
        filename, path: FilenameString;
        langcode: LanguageString;
        i, j: Integer;
      begin
        list.Clear;

        // Iterate through filesystem
        more := FindFirst(Directory + '*', faAnyFile, sr) = 0;
        try
          while more do
          begin
            if (sr.Attr and faDirectory <> 0) and (sr.name <> '.') and (sr.name <> '..') then
            begin
              filename := Directory + sr.name + PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
              if FileExists(filename) then
              begin
                langcode := lowercase(sr.name);
                if list.IndexOf(langcode) = -1 then
                  list.Add(langcode);
              end;
            end;
            more := FindNext(sr) = 0;
          end;
        finally
          FindClose(sr);
        end;

        // Iterate through embedded files
        for i := 0 to FileLocator.filelist.Count - 1 do
        begin
          filename := FileLocator.basedirectory + FileLocator.filelist.Strings[i];
          path := Directory;
{$IFDEF MSWINDOWS}
          path := uppercase(path);
          filename := uppercase(filename);
{$ENDIF}
          j := length(path);
          if MidStr(filename, 1, j) = path then
          begin
            path := PathDelim + 'LC_MESSAGES' + PathDelim + domain + '.mo';
{$IFDEF MSWINDOWS}
            path := uppercase(path);
{$ENDIF}
            if MidStr(filename, length(filename) - length(path) + 1, length(path)) = path then
            begin
              langcode := lowercase(MidStr(filename, j + 1, length(filename) - length(path) - j));
              langcode := LeftStr(langcode, 3) + uppercase(MidStr(langcode, 4, maxint));
              if list.IndexOf(langcode) = -1 then
                list.Add(langcode);
            end;
          end;
        end;
      end;

      procedure TDomain.SetFilename(const filename: FilenameString);
      begin
        CloseMoFile;
        vDirectory := '';
        SpecificFilename := filename;
      end;

      function TDomain.gettext(const msgid: RawUtf8String): RawUtf8String;
      var
        found: boolean;
      begin
        if not enabled then
        begin
          Result := msgid;
          exit;
        end;
        if (mofile = nil) and (not OpenHasFailedBefore) then
          OpenMoFile;
        if mofile = nil then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugLogger('.mo file is not open. Not translating "' + msgid + '"');
{$ENDIF}
          Result := msgid;
        end
        else
        begin
          Result := mofile.gettext(msgid, found);
{$IFDEF DXGETTEXTDEBUG}
          if found then
            DebugLogger('Found in .mo (' + domain + '): "' + utf8encode(msgid) + '"->"' + utf8encode(Result) + '"')
          else
            DebugLogger('Translation not found in .mo file (' + domain + ') : "' + utf8encode(msgid) + '"');
{$ENDIF}
        end;
      end;

      constructor TDomain.Create;
      begin
        inherited Create;
        enabled := true;
      end;

    { TGnuGettextInstance }

      procedure TGnuGettextInstance.bindtextdomain(const szDomain: DomainString; const szDirectory: FilenameString);
      var
        dir: FilenameString;
      begin
        dir := IncludeTrailingPathDelimiter(szDirectory);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Text domain "' + szDomain + '" is now located at "' + dir + '"');
{$ENDIF}
        Getdomain(szDomain, DefaultDomainDirectory, curlang).Directory := dir;
        WhenNewDomainDirectory(szDomain, szDirectory);
      end;

      constructor TGnuGettextInstance.Create;
      begin
        CreatorThread := GetCurrentThreadId;
{$IFDEF MSWindows}
        DesignTimeCodePage := CP_ACP;
{$ENDIF}
{$IFDEF DXGETTEXTDEBUG}
        DebugLogCS := TMultiReadExclusiveWriteSynchronizer.Create;
        DebugLog := TMemoryStream.Create;
        DebugWriteln('Debug log started ' + DateTimeToStr(Now));
        DebugWriteln('GNU gettext module version: ' + VCSVersion);
        DebugWriteln('');
{$ENDIF}
        curGetPluralForm := GetPluralForm2EN;
        enabled := true;
        curmsgdomain := DefaultTextDomain;
        savefileCS := TMultiReadExclusiveWriteSynchronizer.Create;
        domainlist := TStringList.Create;
        TP_IgnoreList := TStringList.Create;
        TP_IgnoreList.Sorted := true;
        TP_GlobalClassHandling := TList.Create;
        TP_ClassHandling := TList.Create;

        // Set some settings
        DefaultDomainDirectory := IncludeTrailingPathDelimiter(extractfilepath(ExecutableFilename)) + 'locale';

        UseLanguage('');

        bindtextdomain(DefaultTextDomain, DefaultDomainDirectory);
        textdomain(DefaultTextDomain);

        // Add default properties to ignore
        TP_GlobalIgnoreClassProperty(TComponent, 'Name');
        TP_GlobalIgnoreClassProperty(TCollection, 'PropName');
      end;

      destructor TGnuGettextInstance.Destroy;
      begin
        if savememory <> nil then
        begin
          savefileCS.BeginWrite;
          try
            CloseFile(savefile);
          finally
            savefileCS.EndWrite;
          end;
          FreeAndNil(savememory);
        end;
        FreeAndNil(savefileCS);
        FreeAndNil(TP_IgnoreList);
        while TP_GlobalClassHandling.Count <> 0 do
        begin
          TObject(TP_GlobalClassHandling.Items[0]).Free;
          TP_GlobalClassHandling.delete(0);
        end;
        FreeAndNil(TP_GlobalClassHandling);
        FreeTP_ClassHandlingItems;
        FreeAndNil(TP_ClassHandling);
        while domainlist.Count <> 0 do
        begin
          domainlist.Objects[0].Free;
          domainlist.delete(0);
        end;
        FreeAndNil(domainlist);
{$IFDEF DXGETTEXTDEBUG}
        FreeAndNil(DebugLog);
        FreeAndNil(DebugLogCS);
{$ENDIF}
        inherited;
      end;

{$IFNDEF UNICODE}
      function TGnuGettextInstance.dgettext(const szDomain: DomainString; const szMsgId: AnsiString): TranslatedUnicodeString;
      begin
        Result := dgettext(szDomain, ansi2wideDTCP(szMsgId));
      end;
{$ENDIF}
      function TGnuGettextInstance.dgettext(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
      begin
        if not enabled then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Translation has been disabled. Text is not being translated: ' + szMsgId);
{$ENDIF}
          Result := szMsgId;
        end
        else
        begin
          Result := utf8decode(EnsureLineBreakInTranslatedString(Getdomain(szDomain, DefaultDomainDirectory, curlang)
            .gettext(StripCRRawMsgId(utf8encode(szMsgId)))));

{$IFDEF DXGETTEXTDEBUG}
          if (szMsgId <> '') and (Result = '') then
            DebugWriteln(Format('Error: Translation of %s was an empty string. This may never occur.', [szMsgId]));
{$ENDIF}
        end;
      end;

      function TGnuGettextInstance.dgettext_NoExtract(const szDomain: DomainString; const szMsgId: MsgIdString): TranslatedUnicodeString;
      begin
        // This one is very useful for translating text in variables.
        // This can sometimes be necessary, and by using this function,
        // the source code scanner will not trigger warnings.
        Result := dgettext(szDomain, szMsgId);
      end;

      function TGnuGettextInstance.GetCurrentLanguage: LanguageString;
      begin
        Result := curlang;
      end;

      function TGnuGettextInstance.getcurrenttextdomain: DomainString;
      begin
        Result := curmsgdomain;
      end;

{$IFNDEF UNICODE}
      function TGnuGettextInstance.gettext(const szMsgId: AnsiString): TranslatedUnicodeString;
      begin
        Result := dgettext(curmsgdomain, szMsgId);
      end;
{$ENDIF}
      function TGnuGettextInstance.gettext(const szMsgId: MsgIdString): TranslatedUnicodeString;
      begin
        Result := dgettext(curmsgdomain, szMsgId);
      end;

      function TGnuGettextInstance.gettext_NoExtract(const szMsgId: MsgIdString): TranslatedUnicodeString;
      begin
        // This one is very useful for translating text in variables.
        // This can sometimes be necessary, and by using this function,
        // the source code scanner will not trigger warnings.
        Result := gettext(szMsgId);
      end;

      procedure TGnuGettextInstance.textdomain(const szDomain: DomainString);
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Changed text domain to "' + szDomain + '"');
{$ENDIF}
        curmsgdomain := szDomain;
        WhenNewDomain(szDomain);
      end;

      function TGnuGettextInstance.TP_CreateRetranslator: TExecutable;
      var
        ttpr: TTP_Retranslator;
      begin
        ttpr := TTP_Retranslator.Create;
        ttpr.Instance := self;
        TP_Retranslator := ttpr;
        Result := ttpr;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('A retranslator was created.');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.TP_GlobalHandleClass(HClass: TClass; Handler: TTranslator);
      var
        cm: TClassMode;
        i: Integer;
      begin
        for i := 0 to TP_GlobalClassHandling.Count - 1 do
        begin
          cm := TObject(TP_GlobalClassHandling.Items[i]) as TClassMode;
          if cm.HClass = HClass then
            raise EGGProgrammingError.Create('You cannot set a handler for a class that has already been assigned otherwise.');
          if HClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := HClass;
            cm.SpecialHandler := Handler;
            TP_GlobalClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('A handler was set for class ' + HClass.ClassName + '.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := HClass;
        cm.SpecialHandler := Handler;
        TP_GlobalClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('A handler was set for class ' + HClass.ClassName + '.');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.TP_GlobalIgnoreClass(IgnClass: TClass);
      var
        cm: TClassMode;
        i: Integer;
      begin
        for i := 0 to TP_GlobalClassHandling.Count - 1 do
        begin
          cm := TObject(TP_GlobalClassHandling.Items[i]) as TClassMode;
          if cm.HClass = IgnClass then
            raise EGGProgrammingError.Create('You cannot add a class to the ignore list that is already on that list: ' + IgnClass.ClassName +
              '. You should keep all TP_Global functions in one place in your source code.');
          if IgnClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := IgnClass;
            TP_GlobalClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Globally, class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := IgnClass;
        TP_GlobalClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Globally, class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.TP_GlobalIgnoreClassProperty(IgnClass: TClass; propertyname: ComponentNameString);
      var
        cm: TClassMode;
        i, idx: Integer;
      begin
        propertyname := uppercase(propertyname);
        for i := 0 to TP_GlobalClassHandling.Count - 1 do
        begin
          cm := TObject(TP_GlobalClassHandling.Items[i]) as TClassMode;
          if cm.HClass = IgnClass then
          begin
            if Assigned(cm.SpecialHandler) then
              raise EGGProgrammingError.Create('You cannot ignore a class property for a class that has a handler set.');
            if not cm.PropertiesToIgnore.Find(propertyname, idx) then
              cm.PropertiesToIgnore.Add(propertyname);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Globally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
          if IgnClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := IgnClass;
            cm.PropertiesToIgnore.Add(propertyname);
            TP_GlobalClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Globally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := IgnClass;
        cm.PropertiesToIgnore.Add(propertyname);
        TP_GlobalClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Globally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.TP_Ignore(AnObject: TObject; const name: ComponentNameString);
      begin
        TP_IgnoreList.Add(uppercase(name));
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('On object with class name ' + AnObject.ClassName + ', ignore is set on ' + name);
{$ENDIF}
      end;

      procedure TGnuGettextInstance.TranslateComponent(AnObject: TComponent; const textdomain: DomainString);
      var
        comp: TGnuGettextComponentMarker;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('======================================================================');
        DebugWriteln('TranslateComponent() was called for a component with name ' + AnObject.name + '.');
{$ENDIF}
        comp := AnObject.FindComponent('GNUgettextMarker') as TGnuGettextComponentMarker;
        if comp = nil then
        begin
          comp := TGnuGettextComponentMarker.Create(nil);
          comp.name := 'GNUgettextMarker';
          comp.Retranslator := TP_CreateRetranslator;
          TranslateProperties(AnObject, textdomain);
          AnObject.InsertComponent(comp);
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln
            ('This is the first time, that this component has been translated. A retranslator component has been created for this component.');
{$ENDIF}
        end
        else
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('This is not the first time, that this component has been translated.');
{$ENDIF}
          if comp.LastLanguage <> curlang then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln
              ('ERROR: TranslateComponent() was called twice with different languages. This indicates an attempt to switch language at runtime, but by using TranslateComponent every time. This API has changed - please use RetranslateComponent() instead.');
{$ENDIF}
{$IFDEF mswindows}
            MessageBox(0,
              'This application tried to switch the language, but in an incorrect way. The programmer needs to replace a call to TranslateComponent with a call to RetranslateComponent(). The programmer should see the changelog of gnugettext.pas for more information.',
              'Error', MB_OK);
{$ELSE}
            writeln(stderr,
              'This application tried to switch the language, but in an incorrect way. The programmer needs to replace a call to TranslateComponent with a call to RetranslateComponent(). The programmer should see the changelog of gnugettext.pas for more information.');
{$ENDIF}
          end
          else
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln
              ('ERROR: TranslateComponent has been called twice, but with the same language chosen. This is a mistake, but in order to prevent that the application breaks, no exception is raised.');
{$ENDIF}
          end;
        end;
        comp.LastLanguage := curlang;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('======================================================================');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.TranslateProperty(AnObject: TObject; PropInfo: PPropInfo; TodoList: TStrings; const textdomain: DomainString);
      var
        ppi: PPropInfo;
        ws: TranslatedUnicodeString;
        old: TranslatedUnicodeString;
        compmarker: TComponent;
        obj: TObject;
        Propname: ComponentNameString;
      begin
        Propname := string(PropInfo^.name);
        try
          // Translate certain types of properties
          case PropInfo^.PropType^.Kind of
{$IFDEF UNICODE}
            // All dfm files returning tkUString
            tkString, tkLString, tkWString, tkUString:
{$ELSE}
            tkString, tkLString, tkWString:
{$ENDIF}
              begin
{$IFDEF DXGETTEXTDEBUG}
                DebugWriteln('Translating ' + AnObject.ClassName + '.' + Propname);
{$ENDIF}
                case PropInfo^.PropType^.Kind of
                  tkString, tkLString:
                    old := GetStrProp(AnObject, Propname);
                  tkWString:
                    old := GetWideStrProp(AnObject, Propname);
{$IFDEF UNICODE}
                  tkUString:
                    old := GetUnicodeStrProp(AnObject, Propname);
{$ENDIF}
                else
                  raise Exception.Create
                    ('Internal error: Illegal property type. This problem needs to be solved by a programmer, try to find a workaround.');
                end;
{$IFDEF DXGETTEXTDEBUG}
                if old = '' then
                  DebugWriteln('(Empty, not translated)')
                else
                  DebugWriteln('Old value: "' + old + '"');
{$ENDIF}
                if (old <> '') and (IsWriteProp(PropInfo)) then
                begin
                  if TP_Retranslator <> nil then
                    (TP_Retranslator as TTP_Retranslator).Remember(AnObject, Propname, old);
                  ws := dgettext(textdomain, old);
                  if ws <> old then
                  begin
                    ppi := GetPropInfo(AnObject, Propname);
                    if ppi <> nil then
                    begin
                      SetWideStrProp(AnObject, ppi, ws);
                    end
                    else
                    begin
{$IFDEF DXGETTEXTDEBUG}
                      DebugWriteln('ERROR: Property disappeared: ' + Propname + ' for object of type ' + AnObject.ClassName);
{$ENDIF}
                    end;
                  end;
                end;
              end { case item };
            tkClass:
              begin
                obj := GetObjectProp(AnObject, Propname);
                if obj <> nil then
                begin
                  if obj is TComponent then
                  begin
                    compmarker := TComponent(obj).FindComponent('GNUgettextMarker');
                    if Assigned(compmarker) then
                      exit;
                  end;
                  TodoList.AddObject('', obj);
                end;
              end { case item };
          end { case };
        except
          on E: Exception do
            raise EGGComponentError.Create('Property cannot be translated.' + sLinebreak + 'Add TP_GlobalIgnoreClassProperty(' + AnObject.ClassName +
              ',''' + Propname + ''') to your source code or use' + sLinebreak + 'TP_Ignore (self,''.' + Propname + ''') to prevent this message.' +
              sLinebreak + 'Reason: ' + E.Message);
        end;
      end;

      procedure TGnuGettextInstance.TranslateProperties(AnObject: TObject; textdomain: DomainString = '');
      var
        TodoList: TStringList; // List of Name/TObject's that is to be processed
        DoneList: TStringList;
        // List of hex codes representing pointers to objects that have been done
        i, j, Count: Integer;
        PropList: PPropList;
        UPropName: ComponentNameString;
        PropInfo: PPropInfo;
        compmarker, comp: TComponent;
        cm, currentcm: TClassMode;
        // currentcm is nil or contains special information about how to handle the current object
        ObjectPropertyIgnoreList: TStringList;
        objid: string;
        name: ComponentNameString;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('----------------------------------------------------------------------');
        DebugWriteln('TranslateProperties() was called for an object of class ' + AnObject.ClassName + ' with domain "' + textdomain + '".');
{$ENDIF}
        if textdomain = '' then
          textdomain := curmsgdomain;
        if TP_Retranslator <> nil then
          (TP_Retranslator as TTP_Retranslator).textdomain := textdomain;
{$IFDEF FPC}
        DoneList := TCSStringList.Create;
        TodoList := TCSStringList.Create;
        ObjectPropertyIgnoreList := TCSStringList.Create;
{$ELSE}
        DoneList := TStringList.Create;
        TodoList := TStringList.Create;
        ObjectPropertyIgnoreList := TStringList.Create;
{$ENDIF}
        try
          TodoList.AddObject('', AnObject);
          DoneList.Sorted := true;
          ObjectPropertyIgnoreList.Sorted := true;
          ObjectPropertyIgnoreList.Duplicates := dupIgnore;
          ObjectPropertyIgnoreList.CaseSensitive := false;
          DoneList.Duplicates := dupError;
          DoneList.CaseSensitive := true;

          while TodoList.Count <> 0 do
          begin
            AnObject := TodoList.Objects[0];
            Name := TodoList.Strings[0];
            TodoList.delete(0);
            if (AnObject <> nil) and (AnObject is TPersistent) then
            begin
              // Make sure each object is only translated once
              Assert(SizeOf(Integer) = SizeOf(TObject));
              objid := IntToHex(Integer(AnObject), 8);
              if DoneList.Find(objid, i) then
              begin
                continue;
              end
              else
              begin
                DoneList.Add(objid);
              end;

              ObjectPropertyIgnoreList.Clear;

              // Find out if there is special handling of this object
              currentcm := nil;
              // First check the local handling instructions
              for j := 0 to TP_ClassHandling.Count - 1 do
              begin
                cm := TObject(TP_ClassHandling.Items[j]) as TClassMode;
                if AnObject.InheritsFrom(cm.HClass) then
                begin
                  if cm.PropertiesToIgnore.Count <> 0 then
                  begin
                    ObjectPropertyIgnoreList.AddStrings(cm.PropertiesToIgnore);
                  end
                  else
                  begin
                    // Ignore the entire class
                    currentcm := cm;
                    break;
                  end;
                end;
              end;
              // Then check the global handling instructions
              if currentcm = nil then
                for j := 0 to TP_GlobalClassHandling.Count - 1 do
                begin
                  cm := TObject(TP_GlobalClassHandling.Items[j]) as TClassMode;
                  if AnObject.InheritsFrom(cm.HClass) then
                  begin
                    if cm.PropertiesToIgnore.Count <> 0 then
                    begin
                      ObjectPropertyIgnoreList.AddStrings(cm.PropertiesToIgnore);
                    end
                    else
                    begin
                      // Ignore the entire class
                      currentcm := cm;
                      break;
                    end;
                  end;
                end;
              if currentcm <> nil then
              begin
                ObjectPropertyIgnoreList.Clear;
                // Ignore or use special handler
                if Assigned(currentcm.SpecialHandler) then
                begin
                  currentcm.SpecialHandler(AnObject);
{$IFDEF DXGETTEXTDEBUG}
                  DebugWriteln('Special handler activated for ' + AnObject.ClassName);
{$ENDIF}
                end
                else
                begin
{$IFDEF DXGETTEXTDEBUG}
                  DebugWriteln('Ignoring object ' + AnObject.ClassName);
{$ENDIF}
                end;
                continue;
              end;

              Count := GetPropList(AnObject, PropList);
              try
                for j := 0 to Count - 1 do
                begin
                  PropInfo := PropList[j];
{$IFDEF UNICODE}
                  if not(PropInfo^.PropType^.Kind in [tkString, tkLString, tkWString, tkClass, tkUString]) then
{$ELSE}
                  if not(PropInfo^.PropType^.Kind in [tkString, tkLString, tkWString, tkClass]) then
{$ENDIF}
                    continue;
                  UPropName := uppercase(string(PropInfo^.name));
                  // Ignore properties that are meant to be ignored
                  if ((currentcm = nil) or (not currentcm.PropertiesToIgnore.Find(UPropName, i))) and
                    (not TP_IgnoreList.Find(Name + '.' + UPropName, i)) and (not ObjectPropertyIgnoreList.Find(UPropName, i)) then
                  begin
                    TranslateProperty(AnObject, PropInfo, TodoList, textdomain);
                  end; // if
                end; // for
              finally
                if Count <> 0 then
                  FreeMem(PropList);
              end;
              if AnObject is TStrings then
              begin
                if ((AnObject as TStrings).Text <> '') and (TP_Retranslator <> nil) then
                  (TP_Retranslator as TTP_Retranslator).Remember(AnObject, 'Text', (AnObject as TStrings).Text);
                TranslateStrings(AnObject as TStrings, textdomain);
              end;
              // Check for TCollection
              if AnObject is TCollection then
              begin
                for i := 0 to (AnObject as TCollection).Count - 1 do
                begin
                  // Only add the object if it's not totally ignored already
                  if not Assigned(currentcm) or not AnObject.InheritsFrom(currentcm.HClass) then
                    TodoList.AddObject('', (AnObject as TCollection).Items[i]);
                end;
              end;
              if AnObject is TComponent then
              begin
                for i := 0 to TComponent(AnObject).ComponentCount - 1 do
                begin
                  comp := TComponent(AnObject).Components[i];
                  if (not TP_IgnoreList.Find(uppercase(comp.name), j)) then
                  begin
                    // Only add the object if it's not totally ignored or translated already
                    if not Assigned(currentcm) or not AnObject.InheritsFrom(currentcm.HClass) then
                    begin
                      compmarker := comp.FindComponent('GNUgettextMarker');
                      if not Assigned(compmarker) then
                        TodoList.AddObject(uppercase(comp.name), comp);
                    end;
                  end;
                end;
              end;
            end { if AnObject<>nil };
          end { while todolist.count<>0 };
        finally
          FreeAndNil(TodoList);
          FreeAndNil(ObjectPropertyIgnoreList);
          FreeAndNil(DoneList);
        end;
        FreeTP_ClassHandlingItems;
        TP_IgnoreList.Clear;
        TP_Retranslator := nil;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('----------------------------------------------------------------------');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.UseLanguage(LanguageCode: LanguageString);
      var
        i, p: Integer;
        dom: TDomain;
        l2: string;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('UseLanguage(''' + LanguageCode + '''); called');
{$ENDIF}
        if LanguageCode = '' then
        begin
          LanguageCode := GGGetEnvironmentVariable('LANG');
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('LANG env variable is ''' + LanguageCode + '''.');
{$ENDIF}
{$IFDEF MSWINDOWS}
          if LanguageCode = '' then
          begin
            LanguageCode := GetWindowsLanguage;
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Found Windows language code to be ''' + LanguageCode + '''.');
{$ENDIF}
          end;
{$ENDIF}
          p := pos('.', LanguageCode);
          if p <> 0 then
            LanguageCode := LeftStr(LanguageCode, p - 1);
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Language code that will be set is ''' + LanguageCode + '''.');
{$ENDIF}
        end;

        curlang := LanguageCode;
        for i := 0 to domainlist.Count - 1 do
        begin
          dom := domainlist.Objects[i] as TDomain;
          dom.SetLanguageCode(curlang);
        end;

        l2 := lowercase(LeftStr(curlang, 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 = 'uk') or (l2 = 'hr') then
          curGetPluralForm := GetPluralForm3RU
        else if (l2 = 'cs') or (l2 = 'sk') then
          curGetPluralForm := GetPluralForm3SK
        else if (l2 = 'pl') then
          curGetPluralForm := GetPluralForm3PL
        else if (l2 = 'sl') then
          curGetPluralForm := GetPluralForm4SL
        else
        begin
          curGetPluralForm := GetPluralForm2EN;
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Plural form for the language was not found. English plurality system assumed.');
{$ENDIF}
        end;

        WhenNewLanguage(curlang);

{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.TranslateStrings(sl: TStrings; const textdomain: DomainString);
      var
        Line: string;
        i: Integer;
        s: TStringList;
      begin
        if sl.Count > 0 then
        begin
          sl.BeginUpdate;
          try
            s := TStringList.Create;
            try
              s.Assign(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.Assign(s);
            finally
              FreeAndNil(s);
            end;
          finally
            sl.EndUpdate;
          end;
        end;
      end;

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

      function TGnuGettextInstance.GetTranslationProperty(const propertyname: ComponentNameString): TranslatedUnicodeString;
      begin
        Result := Getdomain(curmsgdomain, DefaultDomainDirectory, curlang).GetTranslationProperty(propertyname);
      end;

      function TGnuGettextInstance.dngettext(const szDomain: DomainString; const singular, plural: MsgIdString; Number: Integer)
        : TranslatedUnicodeString;
      var
        org: MsgIdString;
        trans: TranslatedUnicodeString;
        idx: Integer;
        p: Integer;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('dngettext translation (domain ' + szDomain + ', number is ' + IntToStr(Number) + ') of ' + singular + '/' + plural);
{$ENDIF}
        org := singular + #0 + plural;
        trans := dgettext(szDomain, org);
        if org = trans then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Translation was equal to english version. English plural forms assumed.');
{$ENDIF}
          idx := GetPluralForm2EN(Number)
        end
        else
          idx := curGetPluralForm(Number);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Index ' + IntToStr(idx) + ' will be used');
{$ENDIF}
        while true do
        begin
          p := pos(#0, trans);
          if p = 0 then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Last translation used: ' + utf8encode(trans));
{$ENDIF}
            Result := trans;
            exit;
          end;
          if idx = 0 then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Translation found: ' + utf8encode(trans));
{$ENDIF}
            Result := LeftStr(trans, p - 1);
            exit;
          end;
          delete(trans, 1, p);
          dec(idx);
        end;
      end;

      function TGnuGettextInstance.dngettext_NoExtract(const szDomain: DomainString; const singular, plural: MsgIdString; Number: Integer)
        : TranslatedUnicodeString;
      begin
        // This one is very useful for translating text in variables.
        // This can sometimes be necessary, and by using this function,
        // the source code scanner will not trigger warnings.
        Result := dngettext(szDomain, singular, plural, Number);
      end;

{$IFNDEF UNICODE}
      function TGnuGettextInstance.ngettext(const singular, plural: AnsiString; Number: Integer): TranslatedUnicodeString;
      begin
        Result := dngettext(curmsgdomain, singular, plural, Number);
      end;
{$ENDIF}
      function TGnuGettextInstance.ngettext(const singular, plural: MsgIdString; Number: Integer): TranslatedUnicodeString;
      begin
        Result := dngettext(curmsgdomain, singular, plural, Number);
      end;

      function TGnuGettextInstance.ngettext_NoExtract(const singular, plural: MsgIdString; Number: Integer): TranslatedUnicodeString;
      begin
        // This one is very useful for translating text in variables.
        // This can sometimes be necessary, and by using this function,
        // the source code scanner will not trigger warnings.
        Result := ngettext(singular, plural, Number);
      end;

      procedure TGnuGettextInstance.WhenNewDomain(const textdomain: DomainString);
      begin
        // This is meant to be empty.
      end;

      procedure TGnuGettextInstance.WhenNewLanguage(const LanguageID: LanguageString);
      begin
        // This is meant to be empty.
      end;

      procedure TGnuGettextInstance.WhenNewDomainDirectory(const textdomain: DomainString; const Directory: FilenameString);
      begin
        // This is meant to be empty.
      end;

      procedure TGnuGettextInstance.GetListOfLanguages(const domain: DomainString; list: TStrings);
      begin
        Getdomain(domain, DefaultDomainDirectory, curlang).GetListOfLanguages(list);
      end;

      procedure TGnuGettextInstance.bindtextdomainToFile(const szDomain: DomainString; const filename: FilenameString);
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Text domain "' + szDomain + '" is now bound to file named "' + filename + '"');
{$ENDIF}
        Getdomain(szDomain, DefaultDomainDirectory, curlang).SetFilename(filename);
      end;

      procedure TGnuGettextInstance.DebugLogPause(PauseEnabled: boolean);
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugLogOutputPaused := PauseEnabled;
{$ENDIF}
      end;

      procedure TGnuGettextInstance.DebugLogToFile(const filename: FilenameString; append: boolean = false);
{$IFDEF DXGETTEXTDEBUG}
      var
        fs: TFileStream;
        marker: AnsiString;
{$ENDIF}
      begin
{$IFDEF DXGETTEXTDEBUG}
        // Create the file if needed
        if (not FileExists(filename)) or (not append) then
          fileclose(filecreate(filename));

        // Open file
        fs := TFileStream.Create(filename, fmOpenWrite or fmShareDenyWrite);
        if append then
          fs.Seek(0, soFromEnd);

        // Write header if appending
        if fs.Position <> 0 then
        begin
          marker := sLinebreak + '===========================================================================' + sLinebreak;
          fs.WriteBuffer(marker[1], length(marker));
        end;

        // Copy the memorystream contents to the file
        DebugLog.Seek(0, soFromBeginning);
        fs.CopyFrom(DebugLog, 0);

        // Make DebugLog point to the filestream
        FreeAndNil(DebugLog);
        DebugLog := fs;
{$ENDIF}
      end;

{$IFDEF DXGETTEXTDEBUG}
      procedure TGnuGettextInstance.DebugWriteln(Line: AnsiString);
      Var
        Discard: boolean;
      begin
        Assert(DebugLogCS <> nil);
        Assert(DebugLog <> nil);

        DebugLogCS.BeginWrite;
        try
          if DebugLogOutputPaused then
            exit;

          if Assigned(fOnDebugLine) then
          begin
            Discard := true;
            fOnDebugLine(self, Line, Discard);
            If Discard then
              exit;
          end;

          Line := Line + sLinebreak;

          // Ensure that memory usage doesn't get too big.
          if (DebugLog is TMemoryStream) and (DebugLog.Position > 1000000) then
          begin
            Line := sLinebreak + sLinebreak + sLinebreak + sLinebreak + sLinebreak + 'Debug log halted because memory usage grew too much.' +
              sLinebreak + 'Specify a filename to store the debug log in or disable debug loggin in gnugettext.pas.' + sLinebreak + sLinebreak +
              sLinebreak + sLinebreak + sLinebreak;
            DebugLogOutputPaused := true;
          end;
          DebugLog.WriteBuffer(Line[1], length(Line));
        finally
          DebugLogCS.EndWrite;
        end;
      end;
{$ENDIF}
      function TGnuGettextInstance.Getdomain(const domain: DomainString; const DefaultDomainDirectory: FilenameString;
        const curlang: LanguageString): TDomain;
      // Retrieves the TDomain object for the specified domain.
      // Creates one, if none there, yet.
      var
        idx: Integer;
      begin
        idx := domainlist.IndexOf(domain);
        if idx = -1 then
        begin
          Result := TDomain.Create;
{$IFDEF DXGETTEXTDEBUG}
          Result.DebugLogger := DebugWriteln;
{$ENDIF}
          Result.domain := domain;
          Result.Directory := DefaultDomainDirectory;
          Result.SetLanguageCode(curlang);
          domainlist.AddObject(domain, Result);
        end
        else
        begin
          Result := domainlist.Objects[idx] as TDomain;
        end;
      end;

      function TGnuGettextInstance.LoadResString(ResStringRec: PResStringRec): UnicodeString;
{$IFDEF MSWINDOWS}
      var
        Len: Integer;
{$IFDEF UNICODE}
        Buffer: array [0 .. 1023] of widechar;
{$ELSE}
        Buffer: array [0 .. 1023] of ansichar;
{$ENDIF}
{$ENDIF}
{$IFDEF LINUX }
      const
        ResStringTableLen = 16;
      type
        ResStringTable = array [0 .. ResStringTableLen - 1] of LongWord;
      var
        Handle: TResourceHandle;
        Tab: ^ResStringTable;
        ResMod: HModule;
{$ENDIF }
      begin
        if ResStringRec = nil then
          exit;
        if ResStringRec.Identifier >= 64 * 1024 then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('LoadResString was given an invalid ResStringRec.Identifier');
{$ENDIF}
          Result := 'ERROR';
          exit;
        end
        else
        begin
{$IFDEF LINUX}
          // This works with Unicode if the Linux has utf-8 character set
          // Result:=System.LoadResString(ResStringRec);
          ResMod := FindResourceHInstance(ResStringRec^.Module^);
          Handle := FindResource(ResMod, PAnsiChar(ResStringRec^.Identifier div ResStringTableLen), PAnsiChar(6)); // RT_STRING
          Tab := pointer(LoadResource(ResMod, Handle));
          if Tab = nil then
            Result := ''
          else
            Result := PWideChar(PAnsiChar(Tab) + Tab[ResStringRec^.Identifier mod ResStringTableLen]);
{$ENDIF}
{$IFDEF MSWINDOWS}
          if not Win32PlatformIsUnicode then
          begin
            SetString(Result, Buffer, LoadString(FindResourceHInstance(ResStringRec.Module^), ResStringRec.Identifier, Buffer, SizeOf(Buffer)))
          end
          else
          begin
            Result := '';
            Len := 0;
            While length(Result) <= Len + 1 do
            begin
              if length(Result) = 0 then
                SetLength(Result, 1024)
              else
                SetLength(Result, length(Result) * 2);
              Len := LoadStringW(FindResourceHInstance(ResStringRec.Module^), ResStringRec.Identifier, PWideChar(Result), length(Result));
            end;
            SetLength(Result, Len);
          end;
{$ENDIF}
        end;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Loaded resourcestring: ' + utf8encode(Result));
{$ENDIF}
        if CreatorThread <> GetCurrentThreadId then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('LoadResString was called from an invalid thread. Resourcestring was not translated.');
{$ENDIF}
        end
        else
          Result := ResourceStringGettext(Result);
      end;

      procedure TGnuGettextInstance.RetranslateComponent(AnObject: TComponent; const textdomain: DomainString);
      var
        comp: TGnuGettextComponentMarker;
      begin
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('======================================================================');
        DebugWriteln('RetranslateComponent() was called for a component with name ' + AnObject.name + '.');
{$ENDIF}
        comp := AnObject.FindComponent('GNUgettextMarker') as TGnuGettextComponentMarker;
        if comp = nil then
        begin
{$IFDEF DXGETTEXTDEBUG}
          DebugWriteln('Retranslate was called on an object that has not been translated before. An Exception is being raised.');
{$ENDIF}
          raise EGGProgrammingError.Create
            ('Retranslate was called on an object that has not been translated before. Please use TranslateComponent() before RetranslateComponent().');
        end
        else
        begin
          if comp.LastLanguage <> curlang then
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('The retranslator is being executed.');
{$ENDIF}
            comp.Retranslator.Execute;
          end
          else
          begin
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('The language has not changed. The retranslator is not executed.');
{$ENDIF}
          end;
        end;
        comp.LastLanguage := curlang;
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('======================================================================');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.TP_IgnoreClass(IgnClass: TClass);
      var
        cm: TClassMode;
        i: Integer;
      begin
        for i := 0 to TP_ClassHandling.Count - 1 do
        begin
          cm := TObject(TP_ClassHandling.Items[i]) as TClassMode;
          if cm.HClass = IgnClass then
            raise EGGProgrammingError.Create('You cannot add a class to the ignore list that is already on that list: ' + IgnClass.ClassName + '.');
          if IgnClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := IgnClass;
            TP_ClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Locally, class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := IgnClass;
        TP_ClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Locally, class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.TP_IgnoreClassProperty(IgnClass: TClass; propertyname: ComponentNameString);
      var
        cm: TClassMode;
        i: Integer;
      begin
        propertyname := uppercase(propertyname);
        for i := 0 to TP_ClassHandling.Count - 1 do
        begin
          cm := TObject(TP_ClassHandling.Items[i]) as TClassMode;
          if cm.HClass = IgnClass then
          begin
            if Assigned(cm.SpecialHandler) then
              raise EGGProgrammingError.Create('You cannot ignore a class property for a class that has a handler set.');
            cm.PropertiesToIgnore.Add(propertyname);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Globally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
          if IgnClass.InheritsFrom(cm.HClass) then
          begin
            // This is the place to insert this class
            cm := TClassMode.Create;
            cm.HClass := IgnClass;
            cm.PropertiesToIgnore.Add(propertyname);
            TP_ClassHandling.insert(i, cm);
{$IFDEF DXGETTEXTDEBUG}
            DebugWriteln('Locally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
            exit;
          end;
        end;
        cm := TClassMode.Create;
        cm.HClass := IgnClass;
        cm.PropertiesToIgnore.Add(propertyname);
        TP_GlobalClassHandling.Add(cm);
{$IFDEF DXGETTEXTDEBUG}
        DebugWriteln('Locally, the ' + propertyname + ' property of class ' + IgnClass.ClassName + ' is being ignored.');
{$ENDIF}
      end;

      procedure TGnuGettextInstance.FreeTP_ClassHandlingItems;
      begin
        while TP_ClassHandling.Count <> 0 do
        begin
          TObject(TP_ClassHandling.Items[0]).Free;
          TP_ClassHandling.delete(0);
        end;
      end;

{$IFNDEF UNICODE}
      function TGnuGettextInstance.ansi2wideDTCP(const s: AnsiString): MsgIdString;
{$IFDEF MSWindows}
      var
        Len: Integer;
{$ENDIF}
      begin
{$IFDEF MSWindows}
        if DesignTimeCodePage = CP_ACP then
        begin
          // No design-time codepage specified. Using runtime codepage instead.
{$ENDIF}
          Result := s;
{$IFDEF MSWindows}
        end
        else
        begin
          Len := length(s);
          if Len = 0 then
            Result := ''
          else
          begin
            SetLength(Result, Len);
            Len := MultiByteToWideChar(DesignTimeCodePage, 0, PAnsiChar(s), Len, PWideChar(Result), Len);
            if Len = 0 then
              raise EGGAnsi2WideConvError.Create('Cannot convert string to widestring:' + sLinebreak + s);
            SetLength(Result, Len);
          end;
        end;
{$ENDIF}
      end;
{$ENDIF}
{$IFNDEF UNICODE}
      function TGnuGettextInstance.dngettext(const szDomain: DomainString; const singular, plural: AnsiString; Number: Integer)
        : TranslatedUnicodeString;
      begin
        Result := dngettext(szDomain, ansi2wideDTCP(singular), ansi2wideDTCP(plural), Number);
      end;
{$ENDIF}
    { TClassMode }

      constructor TClassMode.Create;
      begin
        PropertiesToIgnore := TStringList.Create;
        PropertiesToIgnore.Sorted := true;
        PropertiesToIgnore.Duplicates := dupError;
        PropertiesToIgnore.CaseSensitive := false;
      end;

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

    { TFileLocator }

      procedure TFileLocator.Analyze;
      var
        s: RawByteString;
        i: Integer;
        Offset: int64;
        fs: TFileStream;
        fi: TEmbeddedFileInfo;
        filename: FilenameString;
        filename8bit: RawByteString;
      const
        arrch: array [0 .. 43] of ansichar = '6637DB2E-62E1-4A60-AC19-C23867046A89'#0#0#0#0#0#0#0#0;
      begin
        // Copy byte by byte, compatible with Delphi 2009 and older
        SetLength(s, high(arrch) - low(arrch) + 1);
        for i := 0 to 43 do
          s[i + 1] := arrch[i];

        s := MidStr(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 := TEmbeddedFileInfo.Create;
              try
                fi.Offset := ReadInt64(fs);
                fi.Size := ReadInt64(fs);
                SetLength(filename8bit, Offset - fs.Position);
                fs.ReadBuffer(filename8bit[1], Offset - fs.Position);
                filename := trim(utf8decode(filename8bit));
                if PreferExternal and SysUtils.FileExists(basedirectory + filename) then
                begin
                  // Disregard the internal version and use the external version instead
                  FreeAndNil(fi);
                end
                else
                  filelist.AddObject(filename, fi);
              except
                FreeAndNil(fi);
                raise;
              end;
            end;
          finally
            FreeAndNil(fs);
          end;
        except
{$IFDEF DXGETTEXTDEBUG}
          raise;
{$ENDIF}
        end;
      end;

      constructor TFileLocator.Create;
      begin
        MoFilesCS := TMultiReadExclusiveWriteSynchronizer.Create;
        MoFiles := TStringList.Create;
        filelist := TStringList.Create;
{$IFDEF LINUX}
        filelist.Duplicates := dupError;
        filelist.CaseSensitive := true;
{$ENDIF}
        MoFiles.Sorted := true;
        MoFiles.Duplicates := dupError;
        MoFiles.CaseSensitive := false;
{$IFDEF MSWINDOWS}
        filelist.Duplicates := dupError;
        filelist.CaseSensitive := false;
{$ENDIF}
        filelist.Sorted := true;
      end;

      destructor TFileLocator.Destroy;
      begin
        while filelist.Count <> 0 do
        begin
          filelist.Objects[0].Free;
          filelist.delete(0);
        end;
        FreeAndNil(filelist);
        FreeAndNil(MoFiles);
        FreeAndNil(MoFilesCS);
        inherited;
      end;

      function TFileLocator.FileExists(filename: FilenameString): boolean;
      var
        idx: Integer;
      begin
        if LeftStr(filename, length(basedirectory)) = basedirectory then
        begin
          // Cut off basedirectory if the file is located beneath that base directory
          filename := MidStr(filename, length(basedirectory) + 1, maxint);
        end;
        Result := filelist.Find(filename, idx);
      end;

      function TFileLocator.GetMoFile(filename: FilenameString; DebugLogger: TDebugLogger): TMoFile;
      var
        fi: TEmbeddedFileInfo;
        idx: Integer;
        idxname: FilenameString;
        Offset, Size: int64;
        realfilename: FilenameString;
      begin
        // Find real filename
        Offset := 0;
        Size := 0;
        realfilename := filename;
        if LeftStr(filename, length(basedirectory)) = basedirectory then
        begin
          filename := MidStr(filename, length(basedirectory) + 1, maxint);
          idx := filelist.IndexOf(filename);
          if idx <> -1 then
          begin
            fi := filelist.Objects[idx] as TEmbeddedFileInfo;
            realfilename := ExecutableFilename;
            Offset := fi.Offset;
            Size := fi.Size;
{$IFDEF DXGETTEXTDEBUG}
            DebugLogger('Instead of ' + filename + ', using ' + realfilename + ' from offset ' + IntToStr(Offset) + ', size ' + IntToStr(Size));
{$ENDIF}
          end;
        end;

{$IFDEF DXGETTEXTDEBUG}
        DebugLogger('Reading .mo data from file ''' + filename + '''');
{$ENDIF}
        // Find TMoFile object
        MoFilesCS.BeginWrite;
        try
          idxname := realfilename + ' //\\ ' + IntToStr(Offset);
          if MoFiles.Find(idxname, idx) then
          begin
            Result := MoFiles.Objects[idx] as TMoFile;
          end
          else
          begin
            Result := TMoFile.Create(realfilename, Offset, Size);
            MoFiles.AddObject(idxname, Result);
          end;
          inc(Result.Users);
        finally
          MoFilesCS.EndWrite;
        end;
      end;

      function TFileLocator.ReadInt64(str: TStream): int64;
      begin
        Assert(SizeOf(Result) = 8);
        str.ReadBuffer(Result, 8);
      end;

      procedure TFileLocator.ReleaseMoFile(mofile: TMoFile);
      var
        i: Integer;
      begin
        Assert(mofile <> nil);

        MoFilesCS.BeginWrite;
        try
          dec(mofile.Users);
          if mofile.Users <= 0 then
          begin
            i := MoFiles.Count - 1;
            while i >= 0 do
            begin
              if MoFiles.Objects[i] = mofile then
              begin
                MoFiles.delete(i);
                FreeAndNil(mofile);
                break;
              end;
              dec(i);
            end;
          end;
        finally
          MoFilesCS.EndWrite;
        end;
      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: TranslatedUnicodeString;
        comp: TGnuGettextComponentMarker;
        ppi: PPropInfo;
      begin
        for i := 0 to list.Count - 1 do
        begin
          item := TObject(list.Items[i]) as TTP_RetranslatorItem;
          if item.obj is TComponent then
          begin
            comp := TComponent(item.obj).FindComponent('GNUgettextMarker') as TGnuGettextComponentMarker;
            if Assigned(comp) and (self <> comp.Retranslator) then
            begin
              comp.Retranslator.Execute;
              continue;
            end;
          end;
          if item.obj is TStrings then
          begin
            // Since we don't know the order of items in sl, and don't have
            // the original .Objects[] anywhere, we cannot anticipate anything
            // about the current sl.Strings[] and sl.Objects[] values. We therefore
            // have to discard both values. We can, however, set the original .Strings[]
            // value into the list and retranslate that.
            sl := TStringList.Create;
            try
              sl.Text := item.OldValue;
              Instance.TranslateStrings(sl, textdomain);
              (item.obj as TStrings).BeginUpdate;
              try
                (item.obj as TStrings).Text := sl.Text;
              finally
                (item.obj as TStrings).EndUpdate;
              end;
            finally
              FreeAndNil(sl);
            end;
          end
          else
          begin
            newvalue := Instance.dgettext(textdomain, item.OldValue);
            ppi := GetPropInfo(item.obj, item.Propname);
            if ppi <> nil then
            begin
              SetWideStrProp(item.obj, ppi, newvalue);
            end
            else
            begin
{$IFDEF DXGETTEXTDEBUG}
              Instance.DebugWriteln('ERROR: On retranslation, property disappeared: ' + item.Propname + ' for object of type ' + item.obj.ClassName);
{$ENDIF}
            end;
          end;
        end;
      end;

      procedure TTP_Retranslator.Remember(obj: TObject; Propname: ComponentNameString; OldValue: TranslatedUnicodeString);
      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 }

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

        Reset(FollowJump);
      end;

      destructor THook.Destroy;
      begin
        Shutdown;
        inherited;
      end;

      procedure THook.Disable;
      begin
        Assert(PatchPosition <> nil, 'Patch position in THook was nil when Disable was called');
        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
        Assert(PatchPosition <> nil, 'Patch position in THook was nil when Enable was called');
        PatchPosition[0] := Patch[0];
        PatchPosition[1] := Patch[1];
        PatchPosition[2] := Patch[2];
        PatchPosition[3] := Patch[3];
        PatchPosition[4] := Patch[4];
      end;

      procedure THook.Reset(FollowJump: boolean);
      var
        Offset: Integer;
{$IFDEF LINUX}
        p: pointer;
        pagesize: Integer;
{$ENDIF}
{$IFDEF MSWindows}
        ov: Cardinal;
{$ENDIF}
      begin
        if PatchPosition <> nil then
          Shutdown;

        PatchPosition := oldproc;
        if FollowJump and (Word(oldproc^) = $25FF) then
        begin
          // This finds the correct procedure if a virtual jump has been inserted
          // at the procedure address
          inc(Integer(PatchPosition), 2); // skip the jump
          PatchPosition := PAnsiChar(pointer(pointer(PatchPosition)^)^);
        end;
        Offset := Integer(newproc) - Integer(pointer(PatchPosition)) - 5;

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

{$IFDEF MSWINDOWS}
        if not VirtualProtect(pointer(PatchPosition), 5, PAGE_EXECUTE_READWRITE, @ov) then
          RaiseLastOSError;
{$ENDIF}
{$IFDEF LINUX}
        pagesize := sysconf(_SC_PAGE_SIZE);
        p := pointer(PatchPosition);
        p := pointer((Integer(p) + pagesize - 1) and not(pagesize - 1) - pagesize);
        if mprotect(p, pagesize, PROT_READ + PROT_WRITE + PROT_EXEC) <> 0 then
          RaiseLastOSError;
{$ENDIF}
      end;

      procedure THook.Shutdown;
      begin
        Disable;
        PatchPosition := nil;
      end;

      procedure HookIntoResourceStrings(enabled: boolean = true; SupportPackages: boolean = false);
      begin
        HookLoadResString.Reset(SupportPackages);
        HookLoadStr.Reset(SupportPackages);
        HookFmtLoadStr.Reset(SupportPackages);
        if enabled then
        begin
          HookLoadResString.Enable;
          HookLoadStr.Enable;
          HookFmtLoadStr.Enable;
        end;
      end;

    { TMoFile }

      function TMoFile.autoswap32(i: Cardinal): Cardinal;
      var
        cnv1, cnv2: record case Integer of 0: (arr: array [0 .. 3] of byte);
        1: (int: Cardinal);
      end;

  begin
    if doswap then
    begin
      cnv1.int := i;
      cnv2.arr[0] := cnv1.arr[3];
      cnv2.arr[1] := cnv1.arr[2];
      cnv2.arr[2] := cnv1.arr[1];
      cnv2.arr[3] := cnv1.arr[0];
      Result := cnv2.int;
    end
    else
      Result := i;
  end;

  function TMoFile.CardinalInMem(baseptr: PAnsiChar; Offset: Cardinal): Cardinal;
  var
    pc: ^Cardinal;
  begin
    inc(baseptr, Offset);
    pc := pointer(baseptr);
    Result := pc^;
    if doswap then
      autoswap32(Result);
  end;

  constructor TMoFile.Create(filename: FilenameString; Offset, Size: int64);
  var
    i: Cardinal;
    nn: Integer;
{$IFDEF linux}
    mofile: TFileStream;
{$ENDIF}
  begin
    if SizeOf(i) <> 4 then
      raise EGGProgrammingError.Create('TDomain in gnugettext is written for an architecture that has 32 bit integers.');

{$IFDEF mswindows}
    // Map the mo file into memory and let the operating system decide how to cache
    mo := createfile(PChar(filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
    if mo = INVALID_HANDLE_VALUE then
      raise EGGIOError.Create('Cannot open file ' + filename);
    momapping := CreateFileMapping(mo, nil, PAGE_READONLY, 0, 0, nil);
    if momapping = 0 then
      raise EGGIOError.Create('Cannot create memory map on file ' + filename);
    momemoryHandle := MapViewOfFile(momapping, FILE_MAP_READ, 0, 0, 0);
    if momemoryHandle = nil then
    begin
      raise EGGIOError.Create('Cannot map file ' + filename + ' into memory. Reason: ' + GetLastWinError);
    end;
    momemory := momemoryHandle + Offset;
{$ENDIF}
{$IFDEF linux}
    // Read the whole file into memory
    mofile := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone);
    try
      if Size = 0 then
        Size := mofile.Size;
      Getmem(momemoryHandle, Size);
      momemory := momemoryHandle;
      mofile.Seek(Offset, soFromBeginning);
      mofile.ReadBuffer(momemory^, Size);
    finally
      FreeAndNil(mofile);
    end;
{$ENDIF}
    // Check the magic number
    doswap := false;
    i := CardinalInMem(momemory, 0);
    if (i <> $950412DE) and (i <> $DE120495) then
      raise EGGIOError.Create('This file is not a valid GNU gettext mo file: ' + filename);
    doswap := (i = $DE120495);

    // Find the positions in the file according to the file format spec
    CardinalInMem(momemory, 4);
    // Read the version number, but don't use it for anything.
    N := CardinalInMem(momemory, 8); // Get string count
    O := CardinalInMem(momemory, 12); // Get offset of original strings
    T := CardinalInMem(momemory, 16); // Get offset of translated strings

    // Calculate start conditions for a binary search
    nn := N;
    startindex := 1;
    while nn <> 0 do
    begin
      nn := nn shr 1;
      startindex := startindex shl 1;
    end;
    startindex := startindex shr 1;
    startstep := startindex shr 1;
  end;

  destructor TMoFile.Destroy;
  begin
{$IFDEF mswindows}
    UnMapViewOfFile(momemoryHandle);
    CloseHandle(momapping);
    CloseHandle(mo);
{$ENDIF}
{$IFDEF linux}
    FreeMem(momemoryHandle);
{$ENDIF}
    inherited;
  end;

  function TMoFile.gettext(const msgid: RawUtf8String; var found: boolean): RawUtf8String;
  var
    i, step: Cardinal;
    Offset, pos: Cardinal;
    CompareResult: Integer;
    msgidptr, a, b: PAnsiChar;
    abidx: Integer;
    Size, msgidsize: Integer;
  begin
    found := false;
    msgidptr := PAnsiChar(msgid);
    msgidsize := length(msgid);

    // Do binary search
    i := startindex;
    step := startstep;
    while true do
    begin
      // Get string for index i
      pos := O + 8 * (i - 1);
      Offset := CardinalInMem(momemory, pos + 4);
      Size := CardinalInMem(momemory, pos);
      a := msgidptr;
      b := momemory + Offset;
      abidx := Size;
      if msgidsize < abidx then
        abidx := msgidsize;
      CompareResult := 0;
      while abidx <> 0 do
      begin
        CompareResult := Integer(byte(a^)) - Integer(byte(b^));
        if CompareResult <> 0 then
          break;
        dec(abidx);
        inc(a);
        inc(b);
      end;
      if CompareResult = 0 then
        CompareResult := msgidsize - Size;
      if CompareResult = 0 then
      begin // msgid=s
        // Found the msgid
        pos := T + 8 * (i - 1);
        Offset := CardinalInMem(momemory, pos + 4);
        Size := CardinalInMem(momemory, pos);
        SetString(Result, momemory + Offset, Size);
        found := true;
        break;
      end;
      if step = 0 then
      begin
        // Not found
        Result := msgid;
        break;
      end;
      if CompareResult < 0 then
      begin // msgid<s
        if i < 1 + step then
          i := 1
        else
          i := i - step;
        step := step shr 1;
      end
      else
      begin // msgid>s
        i := i + step;
        if i > N then
          i := N;
        step := step shr 1;
      end;
    end;
  end;

var
  param0: string;

initialization

{$IFDEF DXGETTEXTDEBUG}
{$IFDEF MSWINDOWS}
  MessageBox(0, 'gnugettext.pas debugging is enabled. Turn it off before releasing this piece of software.', 'Information', MB_OK);
{$ENDIF}
{$IFDEF LINUX}
writeln(stderr, 'gnugettext.pas debugging is enabled. Turn it off before releasing this piece of software.');
{$ENDIF}
{$ENDIF}
{$IFDEF FPC}
{$IFDEF LINUX}
SetLocale(LC_ALL, '');
SetCWidestringManager;
{$ENDIF LINUX}
{$ENDIF FPC}
if IsLibrary then
begin
  // Get DLL/shared object filename
  SetLength(ExecutableFilename, 300);
{$IFDEF MSWINDOWS}
  SetLength(ExecutableFilename, GetModuleFileName(FindClassHInstance(TGnuGettextInstance), PChar(ExecutableFilename), length(ExecutableFilename)));
{$ELSE}
  SetLength(ExecutableFilename, GetModuleFileName(0, PAnsiChar(ExecutableFilename), length(ExecutableFilename)));
{$ENDIF}
end
else
  ExecutableFilename := Paramstr(0);
FileLocator := TFileLocator.Create;
FileLocator.Analyze;
ResourceStringDomainList := TStringList.Create;
ResourceStringDomainList.Add(DefaultTextDomain);
ResourceStringDomainListCS := TMultiReadExclusiveWriteSynchronizer.Create;
DefaultInstance := TGnuGettextInstance.Create;
{$IFDEF MSWINDOWS}
Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT);
{$ENDIF}
// replace Borlands LoadResString with gettext enabled version:
{$IFDEF UNICODE}
HookLoadResString := THook.Create(@System.LoadResString, @LoadResStringW);
{$ELSE}
HookLoadResString := THook.Create(@System.LoadResString, @LoadResStringA);
{$ENDIF}
HookLoadStr := THook.Create(@SysUtils.LoadStr, @SysUtilsLoadStr);
HookFmtLoadStr := THook.Create(@SysUtils.FmtLoadStr, @SysUtilsFmtLoadStr);
param0 := lowercase(extractfilename(Paramstr(0)));
if (param0 <> 'delphi32.exe') and (param0 <> 'kylix') and (param0 <> 'bds.exe') then
  HookIntoResourceStrings(AutoCreateHooks, false);
param0 := '';

finalization

FreeAndNil(DefaultInstance);
FreeAndNil(ResourceStringDomainListCS);
FreeAndNil(ResourceStringDomainList);
FreeAndNil(HookFmtLoadStr);
FreeAndNil(HookLoadStr);
FreeAndNil(HookLoadResString);
FreeAndNil(FileLocator);

end.

Youez - 2016 - github.com/yon3zu
LinuXploit