cltranslator.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

  ASource.Position := PrevSourcePos;
  ADestination.Position := PrevDestPos;
end;

class procedure TclCharSetTranslator.TranslateFrom(const ACharSet: string;
  ASource, ADestination: TStream);
var
  i: Integer;
  Xlat: TclXLATTable;
  Ch: Byte;
  PrevSourcePos, PrevDestPos: Integer;
begin
  Xlat := GetXLATByID(ACharSet);
  PrevSourcePos := ASource.Position;
  PrevDestPos := ADestination.Position;
  ASource.Position := 0;
  ADestination.Position := 0;
  if (Xlat.Name <> '') then
  begin
    for i := 0 to ASource.Size - 1 do
    begin
      ASource.Read(Ch, 1);
      Ch := Xlat.Table[Ch];
      ADestination.Write(Ch, 1);
    end;
  end else
  begin
    ADestination.CopyFrom(ASource, ASource.Size);
  end;
  ASource.Position := PrevSourcePos;
  ADestination.Position := PrevDestPos;
end;

class function TclCharSetTranslator.TranslateTo(const ACharSet, ASource: string): string;
var
  Src, Dst: TStringStream;
begin
  Src := TStringStream.Create(ASource);
  Dst := TStringStream.Create('');
  try
    TranslateTo(ACharSet, Src, Dst);
    Result := Dst.DataString;
  finally
    Dst.Free();
    Src.Free();
  end;
end;

class function TclCharSetTranslator.TranslateFrom(const ACharSet, ASource: string): string;
var
  Src, Dst: TStringStream;
begin
  Src := TStringStream.Create(ASource);
  Dst := TStringStream.Create('');
  try
    TranslateFrom(ACharSet, Src, Dst);
    Result := Dst.DataString;
  finally
    Dst.Free();
    Src.Free();
  end;
end;

class function TclCharSetTranslator.ToUtf8(Source: PWideChar; SourceLength: Integer;
  Dest: PChar; DestLength: Integer): Integer;
var
  i, count: Integer;
  c: Cardinal;
begin
  count := 0;
  i := 0;
  while (i < SourceLength) and (count < DestLength) do
  begin
    c := Cardinal(Source[i]);
    Inc(i);
    if c <= $7F then
    begin
      Dest[count] := Char(c);
      Inc(count);
    end else
    if c > $7FF then
    begin
      if count + 3 > DestLength then Break;
      Dest[count] := Char($E0 or (c shr 12));
      Dest[count+1] := Char($80 or ((c shr 6) and $3F));
      Dest[count+2] := Char($80 or (c and $3F));
      Inc(count,3);
    end else
    begin
      if count + 2 > DestLength then Break;
      Dest[count] := Char($C0 or (c shr 6));
      Dest[count + 1] := Char($80 or (c and $3F));
      Inc(count, 2);
    end;
  end;
  if count >= DestLength then
  begin
    count := DestLength - 1;
  end;
  Dest[count] := #0;
  Result := count + 1;
end;

class function TclCharSetTranslator.FromUtf8(Source: PChar;
  SourceLength: Integer; Dest: PWideChar; DestLength: Integer): Integer;
var
  i, count: Integer;
  c: Byte;
  wc: Cardinal;
begin
  Result := -1;
  count := 0;
  i := 0;
  while (i < SourceLength) and (count < DestLength) do
  begin
    wc := Cardinal(Source[i]);
    Inc(i);
    if (wc and $80) <> 0 then
    begin
      wc := wc and $3F;
      if i > SourceLength then Exit;
      if (wc and $20) <> 0 then
      begin
        c := Byte(Source[i]);
        Inc(i);
        if (c and $C0) <> $80 then
        begin
          if (c = $20) then
          begin
            Dest[count] := #32;
          end else
          begin
            Dest[count] := #128;
          end;
          Inc(count);
          continue;
        end;
        if i > SourceLength then Exit;
        wc := (wc shl 6) or (c and $3F);
      end;
      c := Byte(Source[i]);
      Inc(i);
      if (c and $C0) <> $80 then
      begin
        if (c = $20) then
        begin
          Dest[count] := #32;
        end else
        begin
          Dest[count] := #128;
        end;
        Inc(count);
        continue;
      end;

      Dest[count] := WideChar((wc shl 6) or (c and $3F));
    end else
    begin
      Dest[count] := WideChar(wc);
    end;
    Inc(count);
  end;
  if count >= DestLength then
  begin
    count := DestLength - 1;
  end;
  Dest[count] := #0;
  Result := count + 1;
end;

class function TclCharSetTranslator.TranslateFromUtf8(const ASource: string): WideString;
var
  len: Integer;
  ws: WideString;
begin
  Result := '';
  if (ASource = '') then Exit;
  
  SetLength(ws, Length(ASource));

  len := FromUtf8(PChar(ASource), Length(ASource), PWideChar(ws), Length(ws) + 1);

  if (len > 0) then
  begin
    SetLength(ws, len - 1);
  end else
  begin
    ws := '';
  end;
  Result := ws;
end;

class function TclCharSetTranslator.TranslateToUtf8(const ASource: WideString): string;
var
  len: Integer;
  s: string;
begin
  Result := '';
  if (ASource = '') then Exit;

  SetLength(s, Length(ASource) * 3);

  len := ToUtf8(PWideChar(ASource), Length(ASource), PChar(s), Length(s) + 1);
  if (len > 0) then
  begin
    SetLength(s, len - 1);
  end else
  begin
    s := '';
  end;
  Result := s;
end;

end.