Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.08.22;
Скачать: [xml.tar.bz2];

Вниз

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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.033 c
3-1091426466
guest_Dmitry
2004-08-02 10:01
2004.08.22
Можно ли поднять backup где not null поле является null


14-1091241121
Думкин
2004-07-31 06:32
2004.08.22
С днем рождения! 31 июля


3-1089268594
Григорьев Антон
2004-07-08 10:36
2004.08.22
БД без СУБД


9-1084004367
Igit
2004-05-08 12:19
2004.08.22
Арканоид. Алгоритм отражения от стен.


14-1091437316
@Ujin
2004-08-02 13:01
2004.08.22
Подскажите как на VB записать "procedure Proc (Sender: TObject);"





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский