Files
r-zakarya dd9fd62dcb feat(apk): scanner le QR du poste depuis l'app (ZXing.Delphi, Apache 2.0)
Le scanner du systeme demandait avec quoi ouvrir le lien. L'app ouvre la
camera arriere, decode une image sur quatre et remplit URL + jeton des
qu'un lien pmserver://sync est lu. Rien n'est enregistre avant Save.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2026-09-17 18:38:41 +01:00

230 lines
6.0 KiB
ObjectPascal

unit ZXing.StringUtils;
{
* Copyright 2008 ZXing authors
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
* Implemented by E. Spelt for Delphi
}
interface
uses SysUtils, Generics.Collections, ZXing.DecodeHintType;
type
TStringUtils = class abstract
const
UTF8 = 'UTF-8';
EUC_JP = 'EUC-JP';
ISO88591 = 'ISO-8859-1';
class procedure ClassInit;
class var ASSUME_SHIFT_JIS: boolean;
class var PLATFORM_DEFAULT_ENCODING: string;
public
class var GB2312: string;
class var SHIFT_JIS: string;
class function guessEncoding(bytes: TArray<Byte>;
hints: TDictionary<TDecodeHintType, TObject>): string; static;
end;
implementation
class procedure TStringUtils.ClassInit;
begin
PLATFORM_DEFAULT_ENCODING := 'ISO-8859-1'; // 'ISO 8859-15';
SHIFT_JIS := 'SJIS';
GB2312 := 'GB2312';
ASSUME_SHIFT_JIS := (string.Compare(TStringUtils.SHIFT_JIS,
TStringUtils.PLATFORM_DEFAULT_ENCODING, true) = 0) or
(string.Compare('EUC-JP', TStringUtils.PLATFORM_DEFAULT_ENCODING,
true) = 0);
end;
class function TStringUtils.guessEncoding(bytes: TArray<Byte>;
hints: TDictionary<TDecodeHintType, TObject>): string;
var
characterSet: string;
utf8BytesLeft, utf2BytesChars, utf3BytesChars, utf4BytesChars, sjisBytesLeft,
sjisKatakanaChars, sjisCurKatakanaWordLength, sjisCurDoubleBytesWordLength,
sjisMaxKatakanaWordLength, sjisMaxDoubleBytesWordLength, isoHighOther, len,
i, value: Integer;
utf8bom, canBeISO88591, canBeShiftJIS, canBeUTF8: boolean;
begin
if ((hints <> nil) and hints.ContainsKey(ZXing.DecodeHintType.CHARACTER_SET)) then
begin
characterSet := string(hints[ZXing.DecodeHintType.CHARACTER_SET]);
if (characterSet <> '') then
begin
Result := characterSet;
exit
end
end;
len := length(bytes);
canBeISO88591 := true;
canBeShiftJIS := true;
canBeUTF8 := true;
utf8BytesLeft := 0;
utf2BytesChars := 0;
utf3BytesChars := 0;
utf4BytesChars := 0;
sjisBytesLeft := 0;
sjisKatakanaChars := 0;
sjisCurKatakanaWordLength := 0;
sjisCurDoubleBytesWordLength := 0;
sjisMaxKatakanaWordLength := 0;
sjisMaxDoubleBytesWordLength := 0;
isoHighOther := 0;
utf8bom := ((((length(bytes) > 3) and (bytes[0] = $EF)) and (bytes[1] = $BB))
and (bytes[2] = $BF));
i := 0;
while (((i < len) and ((canBeISO88591 or canBeShiftJIS) or canBeUTF8))) do
begin
value := (bytes[i] and $FF);
if (canBeUTF8) then
if (utf8BytesLeft > 0) then
if ((value and $80) = 0) then
canBeUTF8 := false
else
dec(utf8BytesLeft)
else if ((value and $80) <> 0) then
if ((value and $40) = 0) then
canBeUTF8 := false
else
begin
inc(utf8BytesLeft);
if ((value and $20) = 0) then
inc(utf2BytesChars)
else
begin
inc(utf8BytesLeft);
if ((value and $10) = 0) then
inc(utf3BytesChars)
else
begin
inc(utf8BytesLeft);
if ((value and 8) = 0) then
inc(utf4BytesChars)
else
canBeUTF8 := false
end
end
end;
if (canBeISO88591) then
if ((value > $7F) and (value < 160)) then
canBeISO88591 := false
else if ((value > $9F) and (((value < $C0) or (value = $D7)) or
(value = $F7))) then
inc(isoHighOther);
if (canBeShiftJIS) then
if (sjisBytesLeft > 0) then
if (((value < $40) or (value = $7F)) or (value > $FC)) then
canBeShiftJIS := false
else
dec(sjisBytesLeft)
else if (((value = $80) or (value = 160)) or (value > $EF)) then
canBeShiftJIS := false
else if ((value > 160) and (value < $E0)) then
begin
inc(sjisKatakanaChars);
sjisCurDoubleBytesWordLength := 0;
inc(sjisCurKatakanaWordLength);
if (sjisCurKatakanaWordLength > sjisMaxKatakanaWordLength) then
sjisMaxKatakanaWordLength := sjisCurKatakanaWordLength
end
else if (value > $7F) then
begin
inc(sjisBytesLeft);
sjisCurKatakanaWordLength := 0;
inc(sjisCurDoubleBytesWordLength);
if (sjisCurDoubleBytesWordLength > sjisMaxDoubleBytesWordLength) then
sjisMaxDoubleBytesWordLength := sjisCurDoubleBytesWordLength
end
else
begin
sjisCurKatakanaWordLength := 0;
sjisCurDoubleBytesWordLength := 0
end;
inc(i)
end;
if (canBeUTF8 and (utf8BytesLeft > 0)) then
canBeUTF8 := false;
if (canBeShiftJIS and (sjisBytesLeft > 0)) then
canBeShiftJIS := false;
if (canBeUTF8 and (utf8bom or (((utf2BytesChars + utf3BytesChars) +
utf4BytesChars) > 0))) then
begin
Result := 'UTF-8';
exit
end;
if (canBeShiftJIS and ((TStringUtils.ASSUME_SHIFT_JIS or
(sjisMaxKatakanaWordLength >= 3)) or (sjisMaxDoubleBytesWordLength >= 3)))
then
begin
Result := TStringUtils.SHIFT_JIS;
exit
end;
if (canBeISO88591 and canBeShiftJIS) then
begin
if (((sjisMaxKatakanaWordLength = 2) and (sjisKatakanaChars = 2)) or
((isoHighOther * 10) >= len)) then
Result := TStringUtils.SHIFT_JIS
else
Result := 'ISO-8859-1';
exit
end;
if (canBeISO88591) then
begin
Result := 'ISO-8859-1';
exit
end;
if (canBeShiftJIS) then
begin
Result := TStringUtils.SHIFT_JIS;
exit
end;
if (canBeUTF8) then
begin
Result := 'UTF-8';
exit
end;
Result := TStringUtils.PLATFORM_DEFAULT_ENCODING;
end;
Initialization
TStringUtils.ClassInit;
end.