sysencoding.inc 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837
  1. {
  2. *********************************************************************
  3. Copyright (C) 2012 Paul Ishenin,
  4. member of the Free Pascal Development Team
  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. }
  12. {$ifndef VER2_4}
  13. { TEncoding }
  14. class function TEncoding.GetANSI: TEncoding;
  15. begin
  16. {$ifdef FPC_HAS_FEATURE_THREADING}
  17. EnterCriticalSection(FLock);
  18. try
  19. {$endif}
  20. if not Assigned(FStandardEncodings[seAnsi]) then
  21. begin
  22. if Assigned(widestringmanager.GetStandardCodePageProc) then
  23. FStandardEncodings[seAnsi] := TMBCSEncoding.Create(widestringmanager.GetStandardCodePageProc(scpAnsi))
  24. else
  25. FStandardEncodings[seAnsi] := TMBCSEncoding.Create(DefaultSystemCodePage);
  26. end;
  27. {$ifdef FPC_HAS_FEATURE_THREADING}
  28. finally
  29. LeaveCriticalSection(FLock);
  30. end;
  31. {$endif}
  32. Result := FStandardEncodings[seAnsi];
  33. end;
  34. function TEncoding.GetAnsiBytes(const S: string): TBytes;
  35. begin
  36. Result := GetAnsiBytes(S, 1, Length(S));
  37. end;
  38. function TEncoding.GetAnsiBytes(const S: string; CharIndex, CharCount: Integer
  39. ): TBytes;
  40. begin
  41. Result := GetAnsiBytes(Pointer(@S[CharIndex]), CharCount);
  42. end;
  43. function TEncoding.GetAnsiString(const Bytes: TBytes): string;
  44. begin
  45. Result := GetAnsiString(Bytes, 0, Length(Bytes));
  46. end;
  47. function TEncoding.GetAnsiString(const Bytes: TBytes; ByteIndex,
  48. ByteCount: Integer): string;
  49. begin
  50. Result := GetAnsiString(Pointer(@Bytes[ByteIndex]), ByteCount);
  51. SetCodePage(RawByteString(Result), DefaultSystemCodePage, False);
  52. end;
  53. class function TEncoding.GetASCII: TEncoding;
  54. begin
  55. {$ifdef FPC_HAS_FEATURE_THREADING}
  56. EnterCriticalSection(FLock);
  57. try
  58. {$endif}
  59. if not Assigned(FStandardEncodings[seAscii]) then
  60. FStandardEncodings[seAscii] := TMBCSEncoding.Create(CP_ASCII);
  61. {$ifdef FPC_HAS_FEATURE_THREADING}
  62. finally
  63. LeaveCriticalSection(FLock);
  64. end;
  65. {$endif}
  66. Result := FStandardEncodings[seAscii];
  67. end;
  68. class function TEncoding.GetBigEndianUnicode: TEncoding;
  69. begin
  70. {$ifdef FPC_HAS_FEATURE_THREADING}
  71. EnterCriticalSection(FLock);
  72. try
  73. {$endif}
  74. if not Assigned(FStandardEncodings[seBigEndianUnicode]) then
  75. FStandardEncodings[seBigEndianUnicode] := TBigEndianUnicodeEncoding.Create;
  76. {$ifdef FPC_HAS_FEATURE_THREADING}
  77. finally
  78. LeaveCriticalSection(FLock);
  79. end;
  80. {$endif}
  81. Result := FStandardEncodings[seBigEndianUnicode];
  82. end;
  83. class function TEncoding.GetDefault: TEncoding;
  84. begin
  85. Result := GetSystemEncoding;
  86. end;
  87. class function TEncoding.GetSystemEncoding: TEncoding;
  88. var
  89. I: Integer;
  90. begin
  91. {$ifdef FPC_HAS_FEATURE_THREADING}
  92. EnterCriticalSection(FLock);
  93. try
  94. {$endif}
  95. for I := Low(FSystemEncodings) to High(FSystemEncodings) do
  96. begin
  97. if FSystemEncodings[I].CodePage=DefaultSystemCodePage then
  98. begin
  99. Result := FSystemEncodings[I];
  100. if I<>Low(FSystemEncodings) then // exchange with first position to find it faster the next time
  101. begin
  102. FSystemEncodings[I] := FSystemEncodings[Low(FSystemEncodings)];
  103. FSystemEncodings[Low(FSystemEncodings)] := Result;
  104. end;
  105. Exit;
  106. end;
  107. end;
  108. // not found - create new encoding at first position
  109. Result := TMBCSEncoding.Create(DefaultSystemCodePage);
  110. SetLength(FSystemEncodings, Length(FSystemEncodings)+1);
  111. if High(FSystemEncodings)<>Low(FSystemEncodings) then
  112. FSystemEncodings[High(FSystemEncodings)] := FSystemEncodings[Low(FSystemEncodings)];
  113. FSystemEncodings[Low(FSystemEncodings)] := Result;
  114. {$ifdef FPC_HAS_FEATURE_THREADING}
  115. finally
  116. LeaveCriticalSection(FLock);
  117. end;
  118. {$endif}
  119. end;
  120. class function TEncoding.GetUnicode: TEncoding;
  121. begin
  122. {$ifdef FPC_HAS_FEATURE_THREADING}
  123. EnterCriticalSection(FLock);
  124. try
  125. {$endif}
  126. if not Assigned(FStandardEncodings[seUnicode]) then
  127. FStandardEncodings[seUnicode] := TUnicodeEncoding.Create;
  128. {$ifdef FPC_HAS_FEATURE_THREADING}
  129. finally
  130. LeaveCriticalSection(FLock);
  131. end;
  132. {$endif}
  133. Result := FStandardEncodings[seUnicode];
  134. end;
  135. class function TEncoding.GetUTF7: TEncoding;
  136. begin
  137. {$ifdef FPC_HAS_FEATURE_THREADING}
  138. EnterCriticalSection(FLock);
  139. try
  140. {$endif}
  141. if not Assigned(FStandardEncodings[seUTF7]) then
  142. FStandardEncodings[seUTF7] := TUTF7Encoding.Create;
  143. {$ifdef FPC_HAS_FEATURE_THREADING}
  144. finally
  145. LeaveCriticalSection(FLock);
  146. end;
  147. {$endif}
  148. Result := FStandardEncodings[seUTF7];
  149. end;
  150. class function TEncoding.GetUTF8: TEncoding;
  151. begin
  152. {$ifdef FPC_HAS_FEATURE_THREADING}
  153. EnterCriticalSection(FLock);
  154. try
  155. {$endif}
  156. if not Assigned(FStandardEncodings[seUTF8]) then
  157. FStandardEncodings[seUTF8] := TUTF8Encoding.Create;
  158. {$ifdef FPC_HAS_FEATURE_THREADING}
  159. finally
  160. LeaveCriticalSection(FLock);
  161. end;
  162. {$endif}
  163. Result := FStandardEncodings[seUTF8];
  164. end;
  165. class procedure TEncoding.FreeEncodings;
  166. var
  167. E: TStandardEncoding;
  168. I: Integer;
  169. begin
  170. {$ifdef FPC_HAS_FEATURE_THREADING}
  171. EnterCriticalSection(FLock);
  172. try
  173. {$endif}
  174. for E := Low(FStandardEncodings) to High(FStandardEncodings) do
  175. FreeAndNil(FStandardEncodings[E]);
  176. for I := Low(FSystemEncodings) to High(FSystemEncodings) do
  177. FSystemEncodings[I].Free;
  178. SetLength(FSystemEncodings, 0);
  179. {$ifdef FPC_HAS_FEATURE_THREADING}
  180. finally
  181. LeaveCriticalSection(FLock);
  182. end;
  183. {$endif}
  184. end;
  185. class constructor TEncoding.Create;
  186. var
  187. E: TStandardEncoding;
  188. begin
  189. for E := Low(FStandardEncodings) to High(FStandardEncodings) do
  190. FStandardEncodings[E] := nil;
  191. {$ifdef FPC_HAS_FEATURE_THREADING}
  192. InitCriticalSection(FLock);
  193. {$endif}
  194. end;
  195. class destructor TEncoding.Destroy;
  196. begin
  197. FreeEncodings;
  198. {$ifdef FPC_HAS_FEATURE_THREADING}
  199. DoneCriticalSection(FLock);
  200. {$endif}
  201. end;
  202. function TEncoding.Clone: TEncoding;
  203. begin
  204. Result := nil;
  205. end;
  206. class function TEncoding.Convert(Source, Destination: TEncoding;
  207. const Bytes: TBytes): TBytes;
  208. begin
  209. Result := Destination.GetBytes(Source.GetChars(Bytes));
  210. end;
  211. class function TEncoding.Convert(Source, Destination: TEncoding;
  212. const Bytes: TBytes; StartIndex, Count: Integer): TBytes;
  213. begin
  214. Result := Destination.GetBytes(Source.GetChars(Bytes, StartIndex, Count));
  215. end;
  216. class function TEncoding.IsStandardEncoding(AEncoding: TEncoding): Boolean;
  217. var
  218. Encoding: TEncoding;
  219. begin
  220. if Assigned(AEncoding) then
  221. begin
  222. for Encoding in FStandardEncodings do
  223. if Encoding = AEncoding then
  224. Exit(True);
  225. for Encoding in FSystemEncodings do
  226. if Encoding = AEncoding then
  227. Exit(True);
  228. end;
  229. Result := False;
  230. end;
  231. class function TEncoding.GetBufferEncoding(const Buffer: TBytes; var AEncoding: TEncoding): Integer;
  232. begin
  233. Result := GetBufferEncoding(Buffer, AEncoding, Default);
  234. end;
  235. class function TEncoding.GetBufferEncoding(const Buffer: TBytes;
  236. var AEncoding: TEncoding; ADefaultEncoding: TEncoding): Integer;
  237. function CheckEncoding(AEncoding: TEncoding; out ByteCount: Integer): Boolean;
  238. var
  239. Preamble: TBytes;
  240. begin
  241. Preamble := AEncoding.GetPreamble;
  242. ByteCount := Length(Preamble);
  243. Result := (Length(Buffer) >= ByteCount) and (ByteCount > 0);
  244. if Result then
  245. Result := CompareMem(@Preamble[0], @Buffer[0], ByteCount);
  246. end;
  247. begin
  248. if Assigned(AEncoding) then
  249. begin
  250. if not CheckEncoding(AEncoding, Result) then
  251. Result := 0;
  252. end
  253. else
  254. if CheckEncoding(Unicode, Result) then
  255. AEncoding := Unicode
  256. else
  257. if CheckEncoding(BigEndianUnicode, Result) then
  258. AEncoding := BigEndianUnicode
  259. else
  260. if CheckEncoding(UTF8, Result) then
  261. AEncoding := UTF8
  262. else
  263. begin
  264. AEncoding := ADefaultEncoding;
  265. Result := 0;
  266. end;
  267. end;
  268. function TEncoding.GetByteCount(const Chars: TUnicodeCharArray): Integer;
  269. begin
  270. Result := GetByteCount(Chars, 0, Length(Chars));
  271. end;
  272. function TEncoding.GetByteCount(const Chars: TUnicodeCharArray; CharIndex,
  273. CharCount: Integer): Integer;
  274. begin
  275. if (CharCount < 0) or (Length(Chars) < CharCount + CharIndex) then
  276. raise EEncodingError.CreateFmt(SInvalidCount, [CharCount]);
  277. if (CharIndex < 0) then
  278. raise EEncodingError.CreateFmt(SCharacterIndexOutOfBounds, [CharIndex]);
  279. Result := GetByteCount(@Chars[CharIndex], CharCount);
  280. end;
  281. function TEncoding.GetByteCount(const S: UnicodeString): Integer;
  282. begin
  283. Result := GetByteCount(PUnicodeChar(S), Length(S));
  284. end;
  285. function TEncoding.GetByteCount(const S: UnicodeString; CharIndex, CharCount: Integer): Integer;
  286. begin
  287. if (CharCount < 0) or (Length(S) < CharCount + CharIndex) then
  288. raise EEncodingError.CreateFmt(SInvalidCount, [CharCount]);
  289. if (CharIndex < 1) then
  290. raise EEncodingError.CreateFmt(SCharacterIndexOutOfBounds, [CharIndex]);
  291. Result := GetByteCount(@S[CharIndex], CharCount);
  292. end;
  293. function TEncoding.GetBytes(const Chars: TUnicodeCharArray): TBytes;
  294. begin
  295. SetLength(Result, GetByteCount(Chars));
  296. GetBytes(@Chars[0], Length(Chars), @Result[0], Length(Result));
  297. end;
  298. function TEncoding.GetBytes(const Chars: TUnicodeCharArray; CharIndex,
  299. CharCount: Integer): TBytes;
  300. begin
  301. if (CharCount < 0) or (Length(Chars) < CharCount + CharIndex) then
  302. raise EEncodingError.CreateFmt(SInvalidCount, [CharCount]);
  303. if (CharIndex < 0) then
  304. raise EEncodingError.CreateFmt(SCharacterIndexOutOfBounds, [CharIndex]);
  305. SetLength(Result, GetByteCount(Chars, CharIndex, CharCount));
  306. GetBytes(@Chars[CharIndex], CharCount, @Result[0], Length(Result));
  307. end;
  308. function TEncoding.GetBytes(const Chars: TUnicodeCharArray; CharIndex,
  309. CharCount: Integer; const Bytes: TBytes; ByteIndex: Integer): Integer;
  310. var
  311. ByteLen: Integer;
  312. begin
  313. ByteLen := Length(Bytes);
  314. if (ByteLen = 0) and (CharCount > 0) then
  315. raise EEncodingError.Create(SInvalidDestinationArray);
  316. if (ByteIndex < 0) or (ByteLen < ByteIndex) then
  317. raise EEncodingError.CreateFmt(SInvalidDestinationIndex, [ByteIndex]);
  318. if (CharCount < 0) or (Length(Chars) < CharCount + CharIndex) then
  319. raise EEncodingError.CreateFmt(SInvalidCount, [CharCount]);
  320. if (CharIndex < 0) then
  321. raise EEncodingError.CreateFmt(SCharacterIndexOutOfBounds, [CharIndex]);
  322. Result := GetBytes(@Chars[CharIndex], CharCount, @Bytes[ByteIndex], ByteLen - ByteIndex);
  323. end;
  324. function TEncoding.GetBytes(const S: UnicodeString): TBytes;
  325. begin
  326. SetLength(Result, GetByteCount(S));
  327. GetBytes(@S[1], Length(S), @Result[0], Length(Result));
  328. end;
  329. function TEncoding.GetBytes(const S: UnicodeString; CharIndex, CharCount: Integer;
  330. const Bytes: TBytes; ByteIndex: Integer): Integer;
  331. var
  332. ByteLen: Integer;
  333. begin
  334. ByteLen := Length(Bytes);
  335. if (ByteLen = 0) and (CharCount > 0) then
  336. raise EEncodingError.Create(SInvalidDestinationArray);
  337. if (ByteIndex < 0) or (ByteLen < ByteIndex) then
  338. raise EEncodingError.CreateFmt(SInvalidDestinationIndex, [ByteIndex]);
  339. if (CharCount < 0) or (Length(S) < CharCount + CharIndex) then
  340. raise EEncodingError.CreateFmt(SInvalidCount, [CharCount]);
  341. if (CharIndex < 1) then
  342. raise EEncodingError.CreateFmt(SCharacterIndexOutOfBounds, [CharIndex]);
  343. Result := GetBytes(@S[CharIndex], CharCount, @Bytes[ByteIndex], ByteLen - ByteIndex);
  344. end;
  345. function TEncoding.GetCharCount(const Bytes: TBytes): Integer;
  346. begin
  347. Result := GetCharCount(@Bytes[0], Length(Bytes));
  348. end;
  349. function TEncoding.GetCharCount(const Bytes: TBytes; ByteIndex,
  350. ByteCount: Integer): Integer;
  351. begin
  352. if (ByteIndex < 0) or (Length(Bytes) < ByteIndex) then
  353. raise EEncodingError.CreateFmt(SInvalidDestinationIndex, [ByteIndex]);
  354. Result := GetCharCount(@Bytes[ByteIndex], ByteCount);
  355. end;
  356. function TEncoding.GetChars(const Bytes: TBytes): TUnicodeCharArray;
  357. begin
  358. SetLength(Result, GetCharCount(Bytes));
  359. GetChars(@Bytes[0], Length(Bytes), @Result[0], Length(Result));
  360. end;
  361. function TEncoding.GetChars(const Bytes: TBytes; ByteIndex, ByteCount: Integer): TUnicodeCharArray;
  362. begin
  363. if (ByteIndex < 0) or (Length(Bytes) < ByteIndex) then
  364. raise EEncodingError.CreateFmt(SInvalidDestinationIndex, [ByteIndex]);
  365. SetLength(Result, GetCharCount(Bytes, ByteIndex, ByteCount));
  366. GetChars(@Bytes[ByteIndex], ByteCount, @Result[0], Length(Result));
  367. end;
  368. function TEncoding.GetChars(const Bytes: TBytes; ByteIndex, ByteCount: Integer;
  369. const Chars: TUnicodeCharArray; CharIndex: Integer): Integer;
  370. var
  371. CharLen: Integer;
  372. begin
  373. if (ByteIndex < 0) or (Length(Bytes) <= ByteIndex) then
  374. raise EEncodingError.CreateFmt(SInvalidDestinationIndex, [ByteIndex]);
  375. CharLen := Length(Chars);
  376. if (CharIndex < 0) or (CharLen <= CharIndex) then
  377. raise EEncodingError.CreateFmt(SCharacterIndexOutOfBounds, [CharIndex]);
  378. Result := GetChars(@Bytes[ByteIndex], ByteCount, @Chars[CharIndex], CharLen - CharIndex);
  379. end;
  380. class function TEncoding.GetEncoding(CodePage: Integer): TEncoding;
  381. begin
  382. case CodePage of
  383. CP_UTF16: Result := TUnicodeEncoding.Create;
  384. CP_UTF16BE: Result := TBigEndianUnicodeEncoding.Create;
  385. CP_UTF7: Result := TUTF7Encoding.Create;
  386. CP_UTF8: Result := TUTF8Encoding.Create;
  387. else
  388. Result := TMBCSEncoding.Create(CodePage);
  389. end;
  390. end;
  391. class function TEncoding.GetEncoding(const EncodingName: UnicodeString): TEncoding;
  392. var
  393. ACodePage: TSystemCodePage;
  394. begin
  395. ACodePage := CodePageNameToCodePage(AnsiString(EncodingName));
  396. if ACodePage = $FFFF then
  397. raise EEncodingError.CreateFmt(SNotValidCodePageName, [EncodingName]);
  398. Result := TMBCSEncoding.Create(ACodePage);
  399. end;
  400. function TEncoding.GetString(const Bytes: TBytes): UnicodeString;
  401. var
  402. Chars: TUnicodeCharArray;
  403. begin
  404. Chars := GetChars(Bytes);
  405. SetString(Result, PUnicodeChar(Chars), Length(Chars));
  406. end;
  407. function TEncoding.GetString(const Bytes: TBytes; ByteIndex, ByteCount: Integer): UnicodeString;
  408. var
  409. Chars: TUnicodeCharArray;
  410. begin
  411. Chars := GetChars(Bytes, ByteIndex, ByteCount);
  412. SetString(Result, PUnicodeChar(Chars), Length(Chars));
  413. end;
  414. { TMBCSEncoding }
  415. function TMBCSEncoding.GetByteCount(Chars: PUnicodeChar; CharCount: Integer): Integer;
  416. var
  417. S: RawByteString;
  418. begin
  419. widestringmanager.Unicode2AnsiMoveProc(Chars, S, CodePage, CharCount);
  420. Result := Length(S);
  421. end;
  422. function TMBCSEncoding.GetBytes(Chars: PUnicodeChar; CharCount: Integer; Bytes: PByte;
  423. ByteCount: Integer): Integer;
  424. var
  425. S: RawByteString;
  426. begin
  427. widestringmanager.Unicode2AnsiMoveProc(Chars, S, CodePage, CharCount);
  428. Result := Length(S);
  429. if ByteCount < Result then
  430. Result := ByteCount;
  431. if Result > 0 then
  432. Move(S[1], Bytes[0], Result);
  433. end;
  434. function TMBCSEncoding.GetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
  435. var
  436. U: UnicodeString;
  437. begin
  438. widestringmanager.Ansi2UnicodeMoveProc(PChar(Bytes), CodePage, U, ByteCount);
  439. Result := Length(U);
  440. end;
  441. function TMBCSEncoding.GetChars(Bytes: PByte; ByteCount: Integer; Chars: PUnicodeChar;
  442. CharCount: Integer): Integer;
  443. var
  444. U: UnicodeString;
  445. begin
  446. widestringmanager.Ansi2UnicodeMoveProc(PChar(Bytes), CodePage, U, ByteCount);
  447. Result := Length(U);
  448. if CharCount < Result then
  449. Result := CharCount;
  450. if Result > 0 then
  451. Move(U[1], Chars[0], Result * SizeOf(UnicodeChar));
  452. end;
  453. function TMBCSEncoding.GetCodePage: Cardinal;
  454. begin
  455. Result := FCodePage;
  456. end;
  457. function TMBCSEncoding.GetEncodingName: UnicodeString;
  458. begin
  459. Result := UnicodeString(CodePageToCodePageName(CodePage));
  460. end;
  461. constructor TMBCSEncoding.Create;
  462. begin
  463. Create(DefaultSystemCodePage, 0, 0);
  464. end;
  465. constructor TMBCSEncoding.Create(ACodePage: Integer);
  466. begin
  467. Create(ACodePage, 0, 0);
  468. end;
  469. constructor TMBCSEncoding.Create(ACodePage, MBToWCharFlags,
  470. WCharToMBFlags: Integer);
  471. begin
  472. FCodePage := ACodePage;
  473. FMBToWCharFlags := MBToWCharFlags;
  474. FWCharToMBFlags := WCharToMBFlags;
  475. case ACodePage of
  476. CP_UTF7, CP_UTF8, CP_UTF16, CP_UTF16BE: FIsSingleByte := False;
  477. else
  478. FIsSingleByte := True;
  479. end;
  480. end;
  481. function TMBCSEncoding.Clone: TEncoding;
  482. begin
  483. Result := TMBCSEncoding.Create(FCodePage, FMBToWCharFlags, FWCharToMBFlags);
  484. end;
  485. function TMBCSEncoding.GetAnsiBytes(Chars: PChar; CharCount: Integer): TBytes;
  486. var
  487. S: RawByteString;
  488. begin
  489. SetString(S, Chars, CharCount);
  490. SetCodePage(S, DefaultSystemCodePage, False);
  491. SetCodePage(S, GetCodePage, True);
  492. SetLength(Result, Length(S));
  493. if Length(S)>0 then
  494. Move(S[1], Result[0], Length(S));
  495. end;
  496. function TMBCSEncoding.GetAnsiString(Bytes: PByte; ByteCount: Integer): string;
  497. begin
  498. SetString(Result, Pointer(Bytes), ByteCount);
  499. SetCodePage(RawByteString(Result), GetCodePage, False);
  500. SetCodePage(RawByteString(Result), DefaultSystemCodePage, True);
  501. end;
  502. function TMBCSEncoding.GetMaxByteCount(CharCount: Integer): Integer;
  503. begin
  504. Result := CharCount;
  505. end;
  506. function TMBCSEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
  507. begin
  508. Result := ByteCount;
  509. end;
  510. function TMBCSEncoding.GetPreamble: TBytes;
  511. begin
  512. case CodePage of
  513. CP_UTF8:
  514. begin
  515. SetLength(Result, 3);
  516. Result[0] := $EF;
  517. Result[1] := $BB;
  518. Result[2] := $BF;
  519. end;
  520. CP_UTF16:
  521. begin
  522. SetLength(Result, 2);
  523. Result[0] := $FF;
  524. Result[1] := $FE;
  525. end;
  526. CP_UTF16BE:
  527. begin
  528. SetLength(Result, 2);
  529. Result[0] := $FE;
  530. Result[1] := $FF;
  531. end;
  532. else
  533. Result := nil;
  534. end;
  535. end;
  536. { TUTF7Encoding }
  537. constructor TUTF7Encoding.Create;
  538. begin
  539. inherited Create(CP_UTF7);
  540. FIsSingleByte := False;
  541. end;
  542. function TUTF7Encoding.Clone: TEncoding;
  543. begin
  544. Result := TUTF7Encoding.Create;
  545. end;
  546. function TUTF7Encoding.GetMaxByteCount(CharCount: Integer): Integer;
  547. begin
  548. Result := CharCount * 3 + 2;
  549. end;
  550. function TUTF7Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
  551. begin
  552. Result := ByteCount;
  553. end;
  554. { TUTF8Encoding }
  555. constructor TUTF8Encoding.Create;
  556. begin
  557. inherited Create(CP_UTF8);
  558. FIsSingleByte := False;
  559. end;
  560. function TUTF8Encoding.Clone: TEncoding;
  561. begin
  562. Result := TUTF8Encoding.Create;
  563. end;
  564. function TUTF8Encoding.GetMaxByteCount(CharCount: Integer): Integer;
  565. begin
  566. Result := CharCount * 3;
  567. end;
  568. function TUTF8Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
  569. begin
  570. Result := ByteCount;
  571. end;
  572. function TUTF8Encoding.GetPreamble: TBytes;
  573. begin
  574. SetLength(Result, 3);
  575. Result[0] := $EF;
  576. Result[1] := $BB;
  577. Result[2] := $BF;
  578. end;
  579. { TUnicodeEncoding }
  580. function TUnicodeEncoding.GetByteCount(Chars: PUnicodeChar; CharCount: Integer): Integer;
  581. begin
  582. Result := CharCount * SizeOf(UnicodeChar);
  583. end;
  584. function TUnicodeEncoding.GetBytes(Chars: PUnicodeChar; CharCount: Integer;
  585. Bytes: PByte; ByteCount: Integer): Integer;
  586. begin
  587. Result := CharCount * SizeOf(UnicodeChar);
  588. if ByteCount < Result then
  589. Result := ByteCount;
  590. if Result > 0 then
  591. Move(Chars[0], Bytes[0], Result);
  592. end;
  593. function TUnicodeEncoding.GetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
  594. begin
  595. Result := ByteCount div SizeOf(UnicodeChar);
  596. end;
  597. function TUnicodeEncoding.GetChars(Bytes: PByte; ByteCount: Integer;
  598. Chars: PUnicodeChar; CharCount: Integer): Integer;
  599. begin
  600. Result := ByteCount div 2;
  601. if CharCount < Result then
  602. Result := CharCount;
  603. Move(Bytes[0], Chars[0], Result * SizeOf(UnicodeChar));
  604. end;
  605. function TUnicodeEncoding.GetCodePage: Cardinal;
  606. begin
  607. Result := CP_UTF16;
  608. end;
  609. function TUnicodeEncoding.GetEncodingName: UnicodeString;
  610. begin
  611. Result := UnicodeString(CodePageToCodePageName(CodePage));
  612. end;
  613. constructor TUnicodeEncoding.Create;
  614. begin
  615. inherited Create;
  616. FIsSingleByte := False;
  617. FMaxCharSize := SizeOf(UnicodeChar);
  618. end;
  619. function TUnicodeEncoding.Clone: TEncoding;
  620. begin
  621. Result := TUnicodeEncoding.Create;
  622. end;
  623. function TUnicodeEncoding.GetAnsiBytes(Chars: PChar; CharCount: Integer
  624. ): TBytes;
  625. var
  626. U: UnicodeString;
  627. begin
  628. widestringmanager.Ansi2UnicodeMoveProc(Chars, DefaultSystemCodePage, U, CharCount);
  629. SetLength(Result, Length(U)*SizeOf(UnicodeChar));
  630. if Length(Result)>0 then
  631. Move(U[1], Result[0], Length(Result));
  632. end;
  633. function TUnicodeEncoding.GetAnsiString(Bytes: PByte; ByteCount: Integer
  634. ): string;
  635. begin
  636. widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Bytes), RawByteString(Result), DefaultSystemCodePage, ByteCount div SizeOf(UnicodeChar));
  637. end;
  638. function TUnicodeEncoding.GetMaxByteCount(CharCount: Integer): Integer;
  639. begin
  640. Result := CharCount * SizeOf(UnicodeChar);
  641. end;
  642. function TUnicodeEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
  643. begin
  644. Result := ByteCount div SizeOf(UnicodeChar);
  645. end;
  646. function TUnicodeEncoding.GetPreamble: TBytes;
  647. begin
  648. SetLength(Result, 2);
  649. Result[0] := $FF;
  650. Result[1] := $FE;
  651. end;
  652. { TBigEndianUnicodeEncoding }
  653. function TBigEndianUnicodeEncoding.GetBytes(Chars: PUnicodeChar; CharCount: Integer;
  654. Bytes: PByte; ByteCount: Integer): Integer;
  655. var
  656. LastByte: PByte;
  657. begin
  658. Result := CharCount * SizeOf(UnicodeChar);
  659. if ByteCount < Result then
  660. Result := ByteCount;
  661. LastByte := @Bytes[Result];
  662. while Bytes < LastByte do
  663. begin
  664. Bytes^ := Hi(Word(Chars^));
  665. inc(Bytes);
  666. if Bytes < LastByte then
  667. Bytes^ := Lo(Word(Chars^));
  668. inc(Bytes);
  669. inc(Chars);
  670. end;
  671. end;
  672. function TBigEndianUnicodeEncoding.GetChars(Bytes: PByte; ByteCount: Integer;
  673. Chars: PUnicodeChar; CharCount: Integer): Integer;
  674. var
  675. LastChar: PUnicodeChar;
  676. begin
  677. Result := ByteCount div SizeOf(UnicodeChar);
  678. if CharCount < Result then
  679. Result := CharCount;
  680. LastChar := @Chars[Result];
  681. while Chars < LastChar do
  682. begin
  683. Chars^ := UnicodeChar(Bytes[1] + Bytes[0] shl 8);
  684. inc(Bytes, SizeOf(UnicodeChar));
  685. inc(Chars);
  686. end;
  687. end;
  688. function TBigEndianUnicodeEncoding.GetCodePage: Cardinal;
  689. begin
  690. Result := CP_UTF16BE;
  691. end;
  692. function TBigEndianUnicodeEncoding.GetEncodingName: UnicodeString;
  693. begin
  694. Result := UnicodeString(CodePageToCodePageName(CodePage));
  695. end;
  696. function TBigEndianUnicodeEncoding.Clone: TEncoding;
  697. begin
  698. Result := TBigEndianUnicodeEncoding.Create;
  699. end;
  700. function TBigEndianUnicodeEncoding.GetAnsiBytes(Chars: PChar; CharCount: Integer
  701. ): TBytes;
  702. begin
  703. Result := TEncoding.Unicode.GetAnsiBytes(Chars, CharCount);
  704. Swap(Result);
  705. end;
  706. function TBigEndianUnicodeEncoding.GetAnsiString(Bytes: PByte;
  707. ByteCount: Integer): string;
  708. var
  709. B: TBytes;
  710. begin
  711. if ByteCount=0 then
  712. Exit('');
  713. SetLength(B, ByteCount);
  714. Move(Bytes^, B[0], ByteCount);
  715. Swap(B);
  716. Result := TEncoding.Unicode.GetAnsiString(PByte(@B[0]), ByteCount);
  717. end;
  718. function TBigEndianUnicodeEncoding.GetPreamble: TBytes;
  719. begin
  720. SetLength(Result, 2);
  721. Result[0] := $FE;
  722. Result[1] := $FF;
  723. end;
  724. procedure TBigEndianUnicodeEncoding.Swap(var B: TBytes);
  725. var
  726. LastB, I: Integer;
  727. C: Byte;
  728. begin
  729. LastB := Length(B)-1;
  730. I := 0;
  731. while I < LastB do
  732. begin
  733. C := B[I];
  734. B[I] := B[I+1];
  735. B[I+1] := C;
  736. Inc(I, 2);
  737. end;
  738. end;
  739. {$endif VER2_4}