Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.08.22;
Скачать: CL | DM;

Вниз

UTF-8   Найти похожие ветки 

 
Alek ©   (2004-08-05 11:46) [0]

Есть ли у кого функции кодировки сабжа?


 
Alek ©   (2004-08-05 12:48) [1]

никто не знает?


 
Romkin ©   (2004-08-05 12:52) [2]

Utf8ToAnsi и др... Delphi 6 и выше...


 
ZrenBy ©   (2004-08-05 12:55) [3]

См. UnicodeToUtf8 и другие в system.pas


 
Alek ©   (2004-08-05 13:02) [4]

у меня Делфи 5!

модет у кого есть под пятую делфи?


 
[lamer]Barmaglot ©   (2004-08-05 13:09) [5]

STFW?

http://show.dm.ru/pSeries/usr/share/man/info/ru_RU/a_doc_lib/aixprggd/genprogc/convert_prg.htm


 
Alek ©   (2004-08-05 15:00) [6]

можете из делфи 6 кинуть сюда функцию

UnicodeToUtf8?


 
Alek ©   (2004-08-05 15:01) [7]

можете из делфи 6 кинуть сюда функцию

UnicodeToUtf8?


 
Romkin ©   (2004-08-05 15:08) [8]


type
 UTF8String = type string;

function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: Integer): Integer;
var
 len: Cardinal;
begin
 len := 0;
 if Source <> nil then
   while Source[len] <> #0 do
     Inc(len);
 Result := Utf8ToUnicode(Dest, MaxChars, Source, len);
end;

function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal;
var
 i, count: Cardinal;
 c: Byte;
 wc: Cardinal;
begin
 if Source = nil then
 begin
   Result := 0;
   Exit;
 end;
 Result := Cardinal(-1);
 count := 0;
 i := 0;
 if Dest <> nil then
 begin
   while (i < SourceBytes) and (count < MaxDestChars) do
   begin
     wc := Cardinal(Source[i]);
     Inc(i);
     if (wc and $80) <> 0 then
     begin
       wc := wc and $3F;
       if i > SourceBytes then Exit;           // incomplete multibyte char
       if (wc and $20) <> 0 then
       begin
         c := Byte(Source[i]);
         Inc(i);
         if (c and $C0) <> $80 then  Exit;     // malformed trail byte or out of range char
         if i > SourceBytes then Exit;         // incomplete multibyte char
         wc := (wc shl 6) or (c and $3F);
       end;
       c := Byte(Source[i]);
       Inc(i);
       if (c and $C0) <> $80 then Exit;       // malformed trail byte

       Dest[count] := WideChar((wc shl 6) or (c and $3F));
     end
     else
       Dest[count] := WideChar(wc);
     Inc(count);
   end;
if count >= MaxDestChars then count := MaxDestChars-1;
Dest[count] := #0;
 end
 else
 begin
while (i <= SourceBytes) do
begin
  c := Byte(Source[i]);
  Inc(i);
  if (c and $80) <> 0 then
  begin
 if (c and $F0) = $F0 then Exit;  // too many bytes for UCS2
 if (c and $40) = 0 then Exit;    // malformed lead byte
 if i > SourceBytes then Exit;         // incomplete multibyte char

 if (Byte(Source[i]) and $C0) <> $80 then Exit;  // malformed trail byte
 Inc(i);
 if i > SourceBytes then Exit;         // incomplete multibyte char
 if ((c and $20) <> 0) and ((Byte(Source[i]) and $C0) <> $80) then Exit; // malformed trail byte
 Inc(i);
  end;
  Inc(count);
end;
 end;
 Result := count+1;
end;

function UnicodeToUtf8(Dest: PChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal;
var
 i, count: Cardinal;
 c: Cardinal;
begin
 Result := 0;
 if Source = nil then Exit;
 count := 0;
 i := 0;
 if Dest <> nil then
 begin
   while (i < SourceChars) and (count < MaxDestBytes) 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 > MaxDestBytes 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 //  $7F < Source[i] <= $7FF
     begin
       if count + 2 > MaxDestBytes 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 >= MaxDestBytes then count := MaxDestBytes-1;
   Dest[count] := #0;
 end
 else
 begin
   while i < SourceChars do
   begin
     c := Integer(Source[i]);
     Inc(i);
     if c > $7F then
     begin
       if c > $7FF then
         Inc(count);
       Inc(count);
     end;
     Inc(count);
   end;
 end;
 Result := count+1;  // convert zero based index to byte count
end;

function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: Integer): Integer;
var
 len: Cardinal;
begin
 len := 0;
 if Source <> nil then
   while Source[len] <> #0 do
     Inc(len);
 Result := Utf8ToUnicode(Dest, MaxChars, Source, len);
end;

function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal;
var
 i, count: Cardinal;
 c: Byte;
 wc: Cardinal;
begin
 if Source = nil then
 begin
   Result := 0;
   Exit;
 end;
 Result := Cardinal(-1);
 count := 0;
 i := 0;
 if Dest <> nil then
 begin
   while (i < SourceBytes) and (count < MaxDestChars) do
   begin
     wc := Cardinal(Source[i]);
     Inc(i);
     if (wc and $80) <> 0 then
     begin
       wc := wc and $3F;
       if i > SourceBytes then Exit;           // incomplete multibyte char
       if (wc and $20) <> 0 then
       begin
         c := Byte(Source[i]);
         Inc(i);
         if (c and $C0) <> $80 then  Exit;     // malformed trail byte or out of range char
         if i > SourceBytes then Exit;         // incomplete multibyte char
         wc := (wc shl 6) or (c and $3F);
       end;
       c := Byte(Source[i]);
       Inc(i);
       if (c and $C0) <> $80 then Exit;       // malformed trail byte

       Dest[count] := WideChar((wc shl 6) or (c and $3F));
     end
     else
       Dest[count] := WideChar(wc);
     Inc(count);
   end;
if count >= MaxDestChars then count := MaxDestChars-1;
Dest[count] := #0;
 end
 else
 begin
while (i <= SourceBytes) do
begin
  c := Byte(Source[i]);
  Inc(i);
  if (c and $80) <> 0 then
  begin
 if (c and $F0) = $F0 then Exit;  // too many bytes for UCS2
 if (c and $40) = 0 then Exit;    // malformed lead byte
 if i > SourceBytes then Exit;         // incomplete multibyte char

 if (Byte(Source[i]) and $C0) <> $80 then Exit;  // malformed trail byte
 Inc(i);
 if i > SourceBytes then Exit;         // incomplete multibyte char
 if ((c and $20) <> 0) and ((Byte(Source[i]) and $C0) <> $80) then Exit; // malformed trail byte
 Inc(i);
  end;
  Inc(count);
end;
 end;
 Result := count+1;
end;

function Utf8Encode(const WS: WideString): UTF8String;
var
 L: Integer;
 Temp: UTF8String;
begin
 Result := "";
 if WS = "" then Exit;
 SetLength(Temp, Length(WS) * 3); // SetLength includes space for null terminator

 L := UnicodeToUtf8(PChar(Temp), Length(Temp)+1, PWideChar(WS), Length(WS));
 if L > 0 then
   SetLength(Temp, L-1)
 else
   Temp := "";
 Result := Temp;
end;

function Utf8Decode(const S: UTF8String): WideString;
var
 L: Integer;
 Temp: WideString;
begin
 Result := "";
 if S = "" then Exit;
 SetLength(Temp, Length(S));

 L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PChar(S), Length(S));
 if L > 0 then
   SetLength(Temp, L-1)
 else
   Temp := "";
 Result := Temp;
end;

function AnsiToUtf8(const S: string): UTF8String;
begin
 Result := Utf8Encode(S);
end;

function Utf8ToAnsi(const S: UTF8String): string;
begin
 Result := Utf8Decode(S);
end;


Уф... вроде все


 
Romkin ©   (2004-08-05 15:10) [9]

Еще одна...

// Scans the source data to find the null terminator, up to MaxBytes
// Dest must have MaxBytes available in Dest.

function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: Integer): Integer;
var
 len: Cardinal;
begin
 len := 0;
 if Source <> nil then
   while Source[len] <> #0 do
     Inc(len);
 Result := UnicodeToUtf8(Dest, MaxBytes, Source, len);
end;


 
Alek ©   (2004-08-05 16:54) [10]

Огромное спасибо ))))



Страницы: 1 вся ветка

Текущий архив: 2004.08.22;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.032 c
6-1087579794
Senti
2004-06-18 21:29
2004.08.22
Вопрос по Kylix


14-1091075206
Kerk
2004-07-29 08:26
2004.08.22
skype


14-1091620589
Максим
2004-08-04 15:56
2004.08.22
License error


1-1091948146
k-sergey
2004-08-08 10:55
2004.08.22
Про поток и TImage


4-1089223380
maverick
2004-07-07 22:03
2004.08.22
Добрый вечер. Как запретить смену раскладки клавитуры