uencoding.pas

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

  if (UpdateCount = 0) and Assigned(FOnChanging) then
    FOnChanging(Self);
end;

procedure TStringListEx.Clear;
begin
  if FCount <> 0 then
  begin
    Changing;
    Finalize(FList^[0], FCount);
    FCount := 0;
    SetCapacity(0);
    Changed;
  end;
end;

procedure TStringListEx.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
  Changing;
  Finalize(FList^[Index]);
  Dec(FCount);
  if Index < FCount then
    System.Move(FList^[Index + 1], FList^[Index],
      (FCount - Index) * SizeOf(TStringItem));
  Changed;
end;

procedure TStringListEx.Exchange(Index1, Index2: Integer);
begin
  if (Index1 < 0) or (Index1 >= FCount) then Error(@SListIndexError, Index1);
  if (Index2 < 0) or (Index2 >= FCount) then Error(@SListIndexError, Index2);
  Changing;
  ExchangeItems(Index1, Index2);
  Changed;
end;

procedure TStringListEx.ExchangeItems(Index1, Index2: Integer);
var
  Temp: Integer;
  Item1, Item2: PStringItem;
begin
  Item1 := @FList^[Index1];
  Item2 := @FList^[Index2];
  Temp := Integer(Item1^.FString);
  Integer(Item1^.FString) := Integer(Item2^.FString);
  Integer(Item2^.FString) := Temp;
  Temp := Integer(Item1^.FObject);
  Integer(Item1^.FObject) := Integer(Item2^.FObject);
  Integer(Item2^.FObject) := Temp;
end;

function TStringListEx.Find(const S: string; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := FCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := CompareStrings(FList^[I].FString, S);
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        if Duplicates <> dupAccept then L := I;
      end;
    end;
  end;
  Index := L;
end;

function TStringListEx.Get(Index: Integer): string;
begin
  if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
  Result := FList^[Index].FString;
end;

function TStringListEx.GetCapacity: Integer;
begin
  Result := FCapacity;
end;

function TStringListEx.GetCount: Integer;
begin
  Result := FCount;
end;

function TStringListEx.GetObject(Index: Integer): TObject;
begin
  if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
  Result := FList^[Index].FObject;
end;

procedure TStringListEx.Grow;
var
  Delta: Integer;
begin
  if FCapacity > 64 then Delta := FCapacity div 4 else
    if FCapacity > 8 then Delta := 16 else
      Delta := 4;
  SetCapacity(FCapacity + Delta);
end;

function TStringListEx.IndexOf(const S: string): Integer;
begin
  if not Sorted then Result := inherited IndexOf(S) else
    if not Find(S, Result) then Result := -1;
end;

procedure TStringListEx.Insert(Index: Integer; const S: string);
begin
  InsertObject(Index, S, nil);
end;

procedure TStringListEx.InsertObject(Index: Integer; const S: string;
  AObject: TObject);
begin
  if Sorted then Error(@SSortedListError, 0);
  if (Index < 0) or (Index > FCount) then Error(@SListIndexError, Index);
  InsertItem(Index, S, AObject);
end;

procedure TStringListEx.InsertItem(Index: Integer; const S: string; AObject: TObject);
begin
  Changing;
  if FCount = FCapacity then Grow;
  if Index < FCount then
    System.Move(FList^[Index], FList^[Index + 1],
      (FCount - Index) * SizeOf(TStringItem));
  with FList^[Index] do
  begin
    Pointer(FString) := nil;
    FObject := AObject;
    FString := S;
  end;
  Inc(FCount);
  Changed;
end;

procedure TStringListEx.Put(Index: Integer; const S: string);
begin
  if Sorted then Error(@SSortedListError, 0);
  if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
  Changing;
  FList^[Index].FString := S;
  Changed;
end;

procedure TStringListEx.PutObject(Index: Integer; AObject: TObject);
begin
  if (Index < 0) or (Index >= FCount) then Error(@SListIndexError, Index);
  Changing;
  FList^[Index].FObject := AObject;
  Changed;
end;

procedure TStringListEx.QuickSort(L, R: Integer; SCompare: TStringListExSortCompare);
var
  I, J, P: Integer;
begin
  repeat
    I := L;
    J := R;
    P := (L + R) shr 1;
    repeat
      while SCompare(Self, I, P) < 0 do Inc(I);
      while SCompare(Self, J, P) > 0 do Dec(J);
      if I <= J then
      begin
        ExchangeItems(I, J);
        if P = I then
          P := J
        else if P = J then
          P := I;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then QuickSort(L, J, SCompare);
    L := I;
  until I >= R;
end;

procedure TStringListEx.SetCapacity(NewCapacity: Integer);
begin
  ReallocMem(FList, NewCapacity * SizeOf(TStringItem));
  FCapacity := NewCapacity;
end;

procedure TStringListEx.SetSorted(Value: Boolean);
begin
  if FSorted <> Value then
  begin
    if Value then Sort;
    FSorted := Value;
  end;
end;

procedure TStringListEx.SetUpdateState(Updating: Boolean);
begin
  if Updating then Changing else Changed;
end;

function StringListCompareStrings(List: TStringListEx; Index1, Index2: Integer): Integer;
begin
  Result := List.CompareStrings(List.FList^[Index1].FString,
                                List.FList^[Index2].FString);
end;

procedure TStringListEx.Sort;
begin
  CustomSort(StringListCompareStrings);
end;

procedure TStringListEx.CustomSort(Compare: TStringListExSortCompare);
begin
  if not Sorted and (FCount > 1) then
  begin
    Changing;
    QuickSort(0, FCount - 1, Compare);
    Changed;
  end;
end;

function TStringListEx.CompareStrings(const S1, S2: string): Integer;
begin
  if CaseSensitive then
    Result := AnsiCompareStr(S1, S2)
  else
    Result := AnsiCompareText(S1, S2);
end;

procedure TStringListEx.SetCaseSensitive(const Value: Boolean);
begin
  if Value <> FCaseSensitive then
  begin
    FCaseSensitive := Value;
    if Sorted then Sort;
  end;
end;


{ TStringsEx }

procedure TStringsEx.LoadFromFile(const FileName: string; Encoding: TEncoding);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream, Encoding);
  finally
    Stream.Free;
  end;
end;

procedure TStringsEx.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TStringsEx.LoadFromStream(Stream: TStream);
begin
  LoadFromStream(Stream, nil);
end;

procedure TStringsEx.LoadFromStream(Stream: TStream; Encoding: TEncoding);
var
  Size: Integer;
  Buffer: TBytes;
begin
  BeginUpdate;
  try
    Size := Stream.Size - Stream.Position;
    SetLength(Buffer, Size);
    Stream.Read(Buffer[0], Size);

    Size := TEncoding.GetBufferEncoding(Buffer, Encoding);
    SetTextStr(Encoding.GetString(Buffer, Size, Length(Buffer) - Size));
  finally
    EndUpdate;
  end;
end;

procedure TStringsEx.SaveToFile(const FileName: string);
begin
   SaveToFile(FileName, nil);
end;

procedure TStringsEx.SaveToFile(const FileName: string; Encoding: TEncoding);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream, Encoding);
  finally
    Stream.Free;
  end;
end;

procedure TStringsEx.SaveToStream(Stream: TStream; Encoding: TEncoding);
var
  Buffer, Preamble: TBytes;
begin
  if Encoding = nil then
    Encoding := TEncoding.Default;
  Buffer := Encoding.GetBytes(GetTextStr);
  Preamble := Encoding.GetPreamble;
  if Length(Preamble) > 0 then
    Stream.WriteBuffer(Preamble[0], Length(Preamble));
  Stream.WriteBuffer(Buffer[0], Length(Buffer));
end;

procedure TStringsEx.SaveToStream(Stream: TStream);
begin
  SaveToStream(Stream, nil);
end;

{$ENDIF}


{$IFDEF UCS4_ENCODING_SUPPORT}

{ TUCS4Encoding }

constructor TUCS4Encoding.Create;
begin
  //Default
  FBOMEnable := True;
  FBigEndian := False;
  FIsSingleByte := False;
  FMaxCharSize := 4;
end;

constructor TUCS4Encoding.Create(BigEndian: Boolean);
begin
  //Endian Select
  FBOMEnable := True;
  FBigEndian := BigEndian;
  FIsSingleByte := False;
  FMaxCharSize := 4;
end;

constructor TUCS4Encoding.Create(BigEndian, BOMEnable: Boolean);
begin
  //Endian, BOM Select
  FBOMEnable := BOMEnable;
  FBigEndian := BigEndian;
  FIsSingleByte := False;
  FMaxCharSize := 4;
end;

function TUCS4Encoding.GetByteCount(Chars: PChar; CharCount: Integer): Integer;
var
  W:WideString;
begin
  {$IFDEF UNICODE}
  Result := CharCount * SizeOf(UCS4Char);
  {$ELSE}
   W:=WideString(string(Chars));
   Result := Length(W) * SizeOf(UCS4Char)
  {$ENDIF}
end;

function TUCS4Encoding.GetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
begin
  {$IFDEF UNICODE}
  Result := ByteCount div SizeOf(UCS4Char);
  {$ELSE}
  Result := ByteCount div SizeOf(UCS4Char) * SizeOf(WideChar);
  {$ENDIF}
end;

{$IFDEF UNICODE}

function TUCS4Encoding.GetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
var
  U4C: UCS4Char;
  C1,C2: Char;
  i: Integer;
  BS: TBytes;
begin
  Result := CharCount * SizeOf(UCS4Char);

  SetLength(BS,4);
  for i := 0 to CharCount - 1 do
  begin
    if not IsLowSurrogate(Chars^) then
    begin
      if IsHighSurrogate(Chars^) then
      begin
        {SurrogatePair}
        C1 := Chars^;
        Inc(Chars);
        C2 := Chars^;
        U4C := ConvertToUtf32(C1,C2);
      end
      else
      begin
        {BMP}
        U4C := ConvertToUtf32(Chars^,1);
      end;

      Inc(Chars);

      if FBigEndian then
      begin
        //BigEndian
        BS[3] := Lo((U4C shl 16) shr 16);
        BS[2] := Hi((U4C shl 16) shr 16);
        BS[1] := Lo(U4C shr 16);
        BS[0] := Hi(U4C shr 16);
      end
      else
      begin
        //LittleEndian
        BS[0] := Lo((U4C shl 16) shr 16);
        BS[1] := Hi((U4C shl 16) shr 16);
        BS[2] := Lo(U4C shr 16);
        BS[3] := Hi(U4C shr 16);
      end;
      Move(BS[0], Bytes^, SizeOf(Byte));
      Inc(Bytes);
      Move(BS[1], Bytes^, SizeOf(Byte));
      Inc(Bytes);
      Move(BS[2], Bytes^, SizeOf(Byte));
      Inc(Bytes);
      Move(BS[3], Bytes^, SizeOf(Byte));
      Inc(Bytes);
    end;
  end;
end;  

function TUCS4Encoding.GetChars(Bytes: PByte; ByteCount: Integer; Chars: PChar; CharCount: Integer): Integer;
var
  U4C: UCS4Char;
  C: Char;
  i: Integer;
  BS: TBytes;
begin
  Result := CharCount;

  SetLength(BS,4);
  for i := 0 to CharCount - 1 do
  begin
    BS[0] := Bytes^;
    Inc(Bytes);
    BS[1] := Bytes^;
    Inc(Bytes);
    BS[2] := Bytes^;
    Inc(Bytes);
    BS[3] := Bytes^;
    Inc(Bytes);

    if FBigEndian then
    begin
      //BigEndian
      U4C := BS[0] shl 24 + BS[1] shl 16 + BS[2] shl 8 + BS[3];
    end
    else
    begin
      //LittleEndian
      U4C := BS[3] shl 24 + BS[2] shl 16 + BS[1] shl 8 + BS[0];
    end;

    C := ConvertFromUtf32(U4C)[1];
    Move(C,Chars^,SizeOf(Char));
    Inc(Chars);
    if U4C > $FFFF then
    begin
      C := ConvertFromUtf32(U4C)[2];
      Move(C,Chars^,SizeOf(Char));
      Inc(Chars);
    end;
  end;
end;

{$ELSE UNICODE}

function TUCS4Encoding.GetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
var
  U4C: UCS4Char;
  C1,C2: WideChar;
  i,L: Integer;
  BS: TBytes;
  W:WideString;
  Z:PWideChar;
begin
  W:=Widestring(string(Chars));
  Z:=PWideChar(W);
  L:=Length(W);
  Result:=L*SizeOf(UCS4Char);
  SetLength(BS,4);
  for i := 0 to L - 1 do
  if not IsLowSurrogate(Z^) then
  begin
     if IsHighSurrogate(Z^) then
     begin
        C1 := Z^;
        Inc(Z);
        C2 := Z^;
        U4C := ConvertToUtf32(C1,C2);
     end
     else
     begin
        {BMP}
        U4C := ConvertToUtf32(Z^,1);
     end;