uencoding.pas

uEncoding字符串UNICODE处理单元 用于处理unicode国际通用

function TEncoding.GetCharCount(const Bytes: TBytes; ByteIndex, ByteCount: Integer): Integer;
begin
  if (Bytes = nil) and (ByteCount <> 0) then
    raise EEncodingError.CreateRes(@SInvalidSourceArray);
  if ByteIndex < 0 then
    raise EEncodingError.CreateResFmt(@SByteIndexOutOfBounds, [ByteIndex]);
  if ByteCount < 0 then
    raise EEncodingError.CreateResFmt(@SInvalidCharCount, [ByteCount]);
  if (Length(Bytes) - ByteIndex) < ByteCount then
    raise EEncodingError.CreateResFmt(@SInvalidCharCount, [ByteCount]);

  Result := GetCharCount(@Bytes[ByteIndex], ByteCount);
end;

function TEncoding.GetChars(const Bytes: TBytes): TCharArray;
begin
  Result := GetChars(Bytes, 0, Length(Bytes));
end;

function TEncoding.GetChars(const Bytes: TBytes; ByteIndex, ByteCount: Integer): TCharArray;
var
  Len: Integer;
begin
  if (Bytes = nil) and (ByteCount <> 0) then
    raise EEncodingError.CreateRes(@SInvalidSourceArray);
  if ByteIndex < 0 then
    raise EEncodingError.CreateResFmt(@SByteIndexOutOfBounds, [ByteIndex]);
  if ByteCount < 0 then
    raise EEncodingError.CreateResFmt(@SInvalidCharCount, [ByteCount]);
  if (Length(Bytes) - ByteIndex) < ByteCount then
    raise EEncodingError.CreateResFmt(@SInvalidCharCount, [ByteCount]);

  Len := GetCharCount(Bytes, ByteIndex, ByteCount);
  SetLength(Result, Len);
  GetChars(@Bytes[ByteIndex], ByteCount, PChar(Result), Len);
end;

function TEncoding.GetChars(const Bytes: TBytes; ByteIndex, ByteCount: Integer;
  var Chars: TCharArray; CharIndex: Integer): Integer;
var
  LCharCount: Integer;
begin
  if (Bytes = nil) and (ByteCount <> 0) then
    raise EEncodingError.CreateRes(@SInvalidSourceArray);
  if ByteIndex < 0 then
    raise EEncodingError.CreateResFmt(@SByteIndexOutOfBounds, [ByteIndex]);
  if ByteCount < 0 then
    raise EEncodingError.CreateResFmt(@SInvalidCharCount, [ByteCount]);
  if (Length(Bytes) - ByteIndex) < ByteCount then
    raise EEncodingError.CreateResFmt(@SInvalidCharCount, [ByteCount]);

  LCharCount := GetCharCount(Bytes, ByteIndex, ByteCount);
  if (CharIndex < 0) or (CharIndex > Length(Chars)) then
    raise EEncodingError.CreateResFmt(@SInvalidDestinationIndex, [CharIndex]);
  if CharIndex + LCharCount > Length(Chars) then
    raise EEncodingError.CreateRes(@SInvalidDestinationArray);

  Result := GetChars(@Bytes[ByteIndex], ByteCount, @Chars[CharIndex], LCharCount);
end;

class function TEncoding.GetDefault: TEncoding;
var
  LEncoding: TEncoding;
begin
  if FDefaultEncoding = nil then
  begin
    LEncoding := TMBCSEncoding.Create(CP_ACP, 0, 0);
    if InterlockedCompareExchangePointer(Pointer(FDefaultEncoding), LEncoding, nil) <> nil then
      LEncoding.Free;
  end;
  Result := FDefaultEncoding;
end;

class function TEncoding.GetEncoding(CodePage: Integer): TEncoding;
begin
  Result := TMBCSEncoding.Create(CodePage);
end;

function TEncoding.GetString(const Bytes: TBytes): string;
begin
  Result := GetString(Bytes, 0, Length(Bytes));
end;

function TEncoding.GetString(const Bytes: TBytes; ByteIndex, ByteCount: Integer): string;
var
  LChars: TCharArray;
begin
  LChars := GetChars(Bytes, ByteIndex, ByteCount);
  SetString(Result, PChar(LChars), Length(LChars));
end;

class function TEncoding.GetUnicode: TEncoding;
var
  LEncoding: TEncoding;
begin
  if FUnicodeEncoding = nil then
  begin
    LEncoding := TUnicodeEncoding.Create;
    if InterlockedCompareExchangePointer(Pointer(FUnicodeEncoding), LEncoding, nil) <> nil then
      LEncoding.Free;
  end;
  Result := FUnicodeEncoding;
end;

class function TEncoding.GetUTF7: TEncoding;
var
  LEncoding: TEncoding;
begin
  if FUTF7Encoding = nil then
  begin
    LEncoding := TUTF7Encoding.Create;
    if InterlockedCompareExchangePointer(Pointer(FUTF7Encoding), LEncoding, nil) <> nil then
      LEncoding.Free;
  end;
  Result := FUTF7Encoding;
end;

class function TEncoding.GetUTF8: TEncoding;
var
  LEncoding: TEncoding;
begin
  if FUTF8Encoding = nil then
  begin
    LEncoding := TUTF8Encoding.Create;
    if InterlockedCompareExchangePointer(Pointer(FUTF8Encoding), LEncoding, nil) <> nil then
      LEncoding.Free;
  end;
  Result := FUTF8Encoding;
end;

class function TEncoding.IsStandardEncoding(AEncoding: TEncoding): Boolean;
begin
  Result :=
    (AEncoding = FASCIIEncoding) or
    (AEncoding = FBigEndianUnicodeEncoding) or
    (AEncoding = FDefaultEncoding) or
    (AEncoding = FUnicodeEncoding) or
    (AEncoding = FUTF7Encoding) or
    (AEncoding = FUTF8Encoding);
end;


{ TMBCSEncoding }

constructor TMBCSEncoding.Create;
begin
  Create(CP_ACP, 0, 0);
end;

constructor TMBCSEncoding.Create(CodePage: Integer);
begin
  FCodePage := CodePage;
  Create(CodePage, 0, 0);
end;

constructor TMBCSEncoding.Create(CodePage, MBToWCharFlags, WCharToMBFlags: Integer);
var
  LCPInfo: TCPInfo;
begin
  FCodePage := CodePage;
  FMBToWCharFlags := MBToWCharFlags;
  FWCharToMBFlags := WCharToMBFlags;

  if not GetCPInfo(FCodePage, LCPInfo) then
    raise EEncodingError.CreateRes(@SInvalidCodePage);
  FMaxCharSize := LCPInfo.MaxCharSize;
  FIsSingleByte := FMaxCharSize = 1;
end;

function TMBCSEncoding.GetByteCount(Chars: PChar; CharCount: Integer): Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := WideCharToMultiByte(FCodePage, FWCharToMBFlags,
    PChar(Chars), CharCount, nil, 0, nil, nil);
{$ELSE}
  Result := CharCount;
{$IFEND}
end;

function TMBCSEncoding.GetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte;
  ByteCount: Integer): Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := WideCharToMultiByte(FCodePage, FWCharToMBFlags,
    PChar(Chars), CharCount, PAnsiChar(Bytes), ByteCount, nil, nil);
{$ELSE}
  Result := CharCount;
  Move(Chars^, Bytes^, Result);
{$IFEND}
end;

function TMBCSEncoding.GetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := MultiByteToWideChar(FCodePage, FMBToWCharFlags,
    PAnsiChar(Bytes), ByteCount, nil, 0);
{$ELSE}
  Result := ByteCount;
{$IFEND}
end;

function TMBCSEncoding.GetChars(Bytes: PByte; ByteCount: Integer; Chars: PChar;
  CharCount: Integer): Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := MultiByteToWideChar(FCodePage, FMBToWCharFlags,
    PAnsiChar(Bytes), ByteCount, PChar(Chars), CharCount);
{$ELSE}
  Result := CharCount;
  Move(Bytes^, Chars^, CharCount * SizeOf(AnsiChar));
{$IFEND}
end;

function TMBCSEncoding.GetMaxByteCount(CharCount: Integer): Integer;
begin
  Result := (CharCount + 1) * FMaxCharSize;
end;

function TMBCSEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
begin
  Result := ByteCount;
end;

function TMBCSEncoding.GetPreamble: TBytes;
begin
  SetLength(Result, 0);
end;

{ TUTF7Encoding }

constructor TUTF7Encoding.Create;
begin
  inherited Create(CP_UTF7);
end;

function TUTF7Encoding.GetByteCount(Chars: PChar; CharCount: Integer): Integer;
var
 Len:Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := inherited GetByteCount(Chars, CharCount);
{$ELSE}
  Len:=Length(WideString(string(Chars)));
  Result := WideCharToMultiByte(FCodePage, FWCharToMBFlags,
    PWideChar(WideString(string(Chars))), Len, nil, 0, nil, nil);
{  Result := WideCharToMultiByte(FCodePage, FWCharToMBFlags,
    PWideChar(WideString(string(Chars))), CharCount, nil, 0, nil, nil);
}
{$IFEND}
end;

function TUTF7Encoding.GetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte;
  ByteCount: Integer): Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := inherited GetBytes(Chars, CharCount, Bytes, ByteCount);
{$ELSE}
  Result := WideCharToMultiByte(FCodePage, FWCharToMBFlags,
    PWideChar(WideString(string(Chars))), CharCount, PAnsiChar(Bytes),
    ByteCount, nil, nil);
{$IFEND}
end;

function TUTF7Encoding.GetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
var
 W:WideString;
begin
{$IF DEFINED(UNICODE)}
  Result := inherited GetCharCount(Bytes, ByteCount);
{$ELSE}
  Result := MultiByteToWideChar(FCodePage, FWCharToMBFlags,
    PAnsiChar(Bytes), -1, nil, 0);
  SetLength(W,Result);
  MultiByteToWideChar(FCodePage, FWCharToMBFlags, PAnsiChar(Bytes), -1, PWideChar(W), Result);
  Result := WideCharToMultiByte(CP_ACP, 0, PWideChar(W), -1, nil, 0, nil, nil);
 {Result := MultiByteToWideChar(FCodePage, FWCharToMBFlags,
    PAnsiChar(Bytes), ByteCount, nil, 0);}
{$IFEND}
end;

function TUTF7Encoding.GetChars(Bytes: PByte; ByteCount: Integer; Chars: PChar;
  CharCount: Integer): Integer;
{$IF NOT DEFINED(UNICODE)}
var
  AStr: AnsiString;
  UStr: Widestring;
{$IFEND}
begin
{$IF DEFINED(UNICODE)}
  Result := inherited GetChars(Bytes, ByteCount, Chars, CharCount);
{$ELSE}
  Result := MultiByteToWideChar(FCodePage, FWCharToMBFlags,
    PAnsiChar(Bytes),-1, nil, 0);
  SetLength(UStr, Result);
  Result := MultiByteToWideChar(FCodePage, FWCharToMBFlags,
    PAnsiChar(Bytes), ByteCount, PWideChar(UStr), CharCount);
  AStr := AnsiString(UStr);
  Move(AStr[1], Chars^, Length(AStr));
{$IFEND}
end;

function TUTF7Encoding.GetMaxByteCount(CharCount: Integer): Integer;
begin
  Result := (CharCount * 3) + 2;
end;

function TUTF7Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
begin
  Result := ByteCount;
end;

{ TUTF8Encoding }

constructor TUTF8Encoding.Create;
begin
  inherited Create(CP_UTF8);
end;

function TUTF8Encoding.GetMaxByteCount(CharCount: Integer): Integer;
begin
  Result := (CharCount + 1) * 3;
end;

function TUTF8Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
begin
  Result := ByteCount + 1;       
end;

function TUTF8Encoding.GetPreamble: TBytes;
begin
  SetLength(Result, 3);
  Result[0] := $EF;
  Result[1] := $BB;
  Result[2] := $BF;
end;

{ TUnicodeEncoding }

constructor TUnicodeEncoding.Create;
begin
  FIsSingleByte := False;
  FMaxCharSize := 4;
end;

function TUnicodeEncoding.GetByteCount(Chars: PChar; CharCount: Integer): Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := CharCount * SizeOf(Char);
{$ELSE}
  Result := MultiByteToWideChar(CP_ACP, 0, PChar(Chars), CharCount,
    nil, 0) * SizeOf(WideChar);
{$IFEND}
end;

function TUnicodeEncoding.GetBytes(Chars: PChar; CharCount: Integer;
  Bytes: PByte; ByteCount: Integer): Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := CharCount * SizeOf(Char);
  Move(Chars^, Bytes^, Result);
{$ELSE}
  Result := MultiByteToWideChar(CP_ACP, 0, PChar(Chars), CharCount,
    PWideChar(Bytes), ByteCount) * SizeOf(WideChar);
{$IFEND}
end;

function TUnicodeEncoding.GetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := ByteCount div SizeOf(Char);
{$ELSE}
  Result := WideCharToMultiByte(CP_ACP, 0, PWideChar(Bytes), ByteCount, nil, 0,
    nil, nil);
  {  Result := WideCharToMultiByte(CP_ACP, 0, PWideChar(Bytes), ByteCount, nil, 0,
    nil, nil) div SizeOf(WideChar);}
{$IFEND}
end;

function TUnicodeEncoding.GetChars(Bytes: PByte; ByteCount: Integer;
  Chars: PChar; CharCount: Integer): Integer;
begin
{$IF DEFINED(UNICODE)}
  Result := CharCount;
  Move(Bytes^, Chars^, CharCount * SizeOf(Char));
{$ELSE}
  Result := WideCharToMultiByte(CP_ACP, 0, PWideChar(Bytes), CharCount,
    PChar(Chars), ByteCount, nil, nil);
{$IFEND}
end;

function TUnicodeEncoding.GetMaxByteCount(CharCount: Integer): Integer;
begin
  Result := (CharCount + 1) * 2;
end;

function TUnicodeEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
begin
  Result := (ByteCount div 2) + (ByteCount and 1) + 1;
end;

function TUnicodeEncoding.GetPreamble: TBytes;
begin
  SetLength(Result, 2);
  Result[0] := $FF;
  Result[1] := $FE;
end;

{ TBigEndianUnicodeEncoding }

procedure SwapBytes(P1, P2: PByte); inline;
var
  B: Byte;
begin
  B := P1^;
  P1^ := P2^;
  P2^ := B;
end;

function TBigEndianUnicodeEncoding.GetBytes(Chars: PChar; CharCount: Integer;
  Bytes: PByte; ByteCount: Integer): Integer;
var
  I: Integer;
  B: PByte;
begin
{$IF DEFINED(UNICODE)}
  for I := 0 to CharCount - 1 do
  begin
    Bytes^ := Hi(Word(Chars^));
    Inc(Bytes);
    Bytes^ := Lo(Word(Chars^));
    Inc(Bytes);
    Inc(Chars);
  end;
  Result := CharCount * SizeOf(WideChar);
{$ELSE}
  Result := inherited GetBytes(Chars, CharCount, Bytes, ByteCount);
  for I := 1 to Result do
  begin
    B:=Bytes;
    Inc(B);
    SwapBytes(Bytes, B);
    Inc(Bytes, 2);
  end;
{$IFEND}
end;

function TBigEndianUnicodeEncoding.GetChars(Bytes: PByte; ByteCount: Integer;
  Chars: PChar; CharCount: Integer): Integer;
var
  P,B: PByte;
  I: Integer;

begin
{$IF DEFINED(UNICODE)}
  P := Bytes;
  Inc(P);
  for I := 0 to CharCount - 1 do
  begin
    Chars^ := WideChar(MakeWord(P^, Bytes^));
    Inc(Bytes, 2);
    Inc(P, 2);
    Inc(Chars);
  end;
  Result := CharCount;
{$ELSE}
  P := Bytes;
  for I := 1 to CharCount do
  begin
    B:=P;
    Inc(B);
    SwapBytes(P, B);
    Inc(P, 2);
  end;
  Result := inherited GetChars(Bytes, ByteCount, Chars, CharCount);
{$IFEND}
end;

function TBigEndianUnicodeEncoding.GetPreamble: TBytes;
begin
  SetLength(Result, 2);
  Result[0] := $FE;
  Result[1] := $FF;
end;   

{ TStringListEx }

destructor TStringListEx.Destroy;
begin
  FOnChange := nil;
  FOnChanging := nil;
  inherited Destroy;
  if FCount <> 0 then Finalize(FList^[0], FCount);
  FCount := 0;
  SetCapacity(0);
end;

function TStringListEx.Add(const S: string): Integer;
begin
  Result := AddObject(S, nil);
end;

function TStringListEx.AddObject(const S: string; AObject: TObject): Integer;
begin
  if not Sorted then
    Result := FCount
  else
    if Find(S, Result) then
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(@SDuplicateString, 0);
      end;
  InsertItem(Result, S, AObject);
end;

procedure TStringListEx.Changed;
begin
  if (UpdateCount = 0) and Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TStringListEx.Changing;
begin