cwstraix.inc 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2012 by Jonas Maebe
  4. Helper routines for cwstring AIX
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. function Ansi2AnsiMove(source:pchar; fromcp:TSystemCodePage; const tocp: pchar; out dest:rawbytestring; len:SizeInt): boolean;
  12. var
  13. outlength,
  14. outoffset,
  15. outleft : size_t;
  16. use_iconv: iconv_t;
  17. srcpos,
  18. destpos: pchar;
  19. mynil : pchar;
  20. my0 : size_t;
  21. err: cint;
  22. begin
  23. use_iconv:=open_iconv_for_cps(fromcp,tocp,true);
  24. { unsupported encoding -> default move }
  25. if use_iconv=iconv_t(-1) then
  26. exit(false);
  27. mynil:=nil;
  28. my0:=0;
  29. // extra space
  30. outlength:=len;
  31. setlength(dest,outlength);
  32. srcpos:=source;
  33. destpos:=pchar(dest);
  34. outleft:=outlength;
  35. while iconv(use_iconv,@srcpos,psize(@len),@destpos,@outleft)=size_t(-1) do
  36. begin
  37. err:=fpgetCerrno;
  38. case err of
  39. ESysEINVAL,
  40. ESysEILSEQ:
  41. begin
  42. { skip and set to '?' }
  43. inc(srcpos);
  44. dec(len);
  45. pchar(destpos)^:='?';
  46. inc(destpos,2);
  47. dec(outleft,2);
  48. { reset }
  49. iconv(use_iconv,@mynil,@my0,@mynil,@my0);
  50. if err=ESysEINVAL then
  51. break;
  52. end;
  53. ESysE2BIG:
  54. begin
  55. outoffset:=destpos-pchar(dest);
  56. { extend }
  57. setlength(dest,outlength+len);
  58. inc(outleft,len);
  59. inc(outlength,len);
  60. { string could have been moved }
  61. destpos:=pchar(dest)+outoffset;
  62. end;
  63. else
  64. runerror(231);
  65. end;
  66. end;
  67. // truncate string
  68. setlength(dest,length(dest)-outleft);
  69. iconv_close(use_iconv);
  70. result:=true;
  71. end;
  72. function handle_aix_intermediate(source: pchar; sourcecp: TSystemCodePage; out newcp: TSystemCodePage; out str: rawbytestring; len: SizeInt): boolean;
  73. begin
  74. result:=false;
  75. { for some reason, IBM's iconv only supports converting cp866 to/from
  76. ISO8859-5. This conversion is lossy, but it's better than completely
  77. failing. At least it keeps the cyrillic characters intact }
  78. case sourcecp of
  79. 866:
  80. begin
  81. handle_aix_intermediate:=Ansi2AnsiMove(source,sourcecp,'ISO8859-5',str, len);
  82. if handle_aix_intermediate then
  83. begin
  84. newcp:=28595;
  85. setcodepage(str,newcp,false);
  86. end;
  87. end;
  88. 28595:
  89. begin
  90. handle_aix_intermediate:=Ansi2AnsiMove(source,sourcecp,'IBM-866',str, len);
  91. if handle_aix_intermediate then
  92. begin
  93. newcp:=866;
  94. setcodepage(str,newcp,false);
  95. end;
  96. end;
  97. end;
  98. end;