DBR Delphi-Ecke

// Das "Unicode Transformation Format", abgekürzt UTF, ist eine Methode,
// Unicode-Zeichen auf Folgen von Bytes abzubilden. Es gibt verschiedene
// Arten, welche am Dateianfang gekennzeichnet werden:
// UTF-8: EF BB BF
// UTF-16-Big-Endian-Bytereihenfolge: FE FF
// UTF-16-Little-Endian-Bytereihenfolge: FF FE
// UTF-32-Big-Endian-Bytereihenfolge: 00 00 FE FF
// UTF-32-Little-Endian-Bytereihenfolge: FF FE 00 00
// Bei Big-Endian wird das Byte mit den höchstwertigen Bits zuerst
// gespeichert, bei Little-Endian wird dagegen das Byte mit den
// niederwertigsten Bits an der kleinsten Speicheradresse hinterlegt.
// Im Allgemeinen ist es effizienter, Unicode-Zeichen in der systemeigenen
// Bytereihenfolge zu speichern. So ist es besser, Little-Endian auf
// entsprechenden Plattformen, beispielsweise auf Intel-Computern, zu verwenden.
// Der nachfolgende Code testet (Text)Dateien auf die entsprechende Unicode-Art.

// Getestet mit D4 unter XP


 
type 
  T_UTF_Type = (NO_UTF, UTF_8, UTF16_L, UTF16_B, UTF32_L, UTF32_B); 
 
function TestFileType(c: Cardinal): T_UTF_Type; 
begin 
  if c and $BFBBEF = $BFBBEF then Result := UTF_8 else    
    if c and $FFFFFEFF = $FEFF then Result := UTF32_L else 
      if c and $FFFEFFFF = $FFFE0000 then Result := UTF32_B else 
        if c and $FEFF = $FEFF then Result := UTF16_L else 
          if c and $FFFE = $FFFE then Result := UTF16_B else 
            Result := NO_UTF; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  f: TFilestream; 
  c: Cardinal; 
  s: string; 
begin 
  f := TFileStream.create('C:\WINDOWS\SchedLgU.Txt', fmOpenread or fmShareDenyNone); 
  f.readbuffer(c, 4); 
  f.free; 
  case TestFileType(c) of 
    UTF_8  : s := 'UTF-8'; 
    UTF16_L: s := 'UTF-16-Little-Endian'; 
    UTF16_B: s := 'UTF-16-Big-Endian'; 
    UTF32_L: s := 'UTF-32-Little-Endian'; 
    UTF32_B: s := 'UTF-32-Big-Endian'; 
    else     s := 'Kein UTF'; 
  end; 
  showmessage(s); 
end;

//------------- Textbetrachter ---------------------------------

// Da bei XP außer Ansi-Text auch UTF8 und UTF16-Little-Endian
// benutzt wird, kann man sich dafür einen Textbetrachter basteln,
// welcher automatisch UTF8 und UTF16 erkennt (wie Notepad auch).

type 
  T_UTF_Type = (NO_UTF, UTF_8, UTF16_L, UTF16_B, UTF32_L, UTF32_B); 
 
function TestFileType(c: Cardinal): T_UTF_Type; 
begin 
  if c and $BFBBEF = $BFBBEF then Result := UTF_8 else 
    if c and $FFFFFEFF = $FEFF then Result := UTF32_L else 
      if c and $FFFEFFFF = $FFFE0000 then Result := UTF32_B else 
        if c and $FEFF = $FEFF then Result := UTF16_L else 
          if c and $FFFE = $FFFE then Result := UTF16_B else 
            Result := NO_UTF; 
end; 
 
procedure Unicode2Ansi(WStr: WideString; var s: string; CP: UINT); 
var 
  sz: integer; 
begin 
  sz := WideCharToMultiByte(CP, 0, PWidechar(WStr), -1, 
    nil, 0, nil, nil); 
  setlength(s, sz); 
  WideCharToMultiByte(CP, 0, PWidechar(WStr), -1, PChar(s), 
    sz, nil, nil); 
end; 
 
procedure Ansi2Unicode(s: string; var WStr: WideString; CP: UINT); 
var 
  sz: integer; 
begin 
  sz := MultiByteToWideChar(CP, 0, PChar(s), -1, nil, 0); 
  setlength(WStr, sz * 2); 
  MultiByteToWideChar(CP, 0, PChar(s), -1, PWidechar(WStr), sz); 
end; 
 
function UTF82Ansi(s: string): string; 
var 
  WStr: WideString; 
begin 
  Ansi2Unicode(s, WStr, CP_UTF8); 
  Unicode2Ansi(WStr, Result, CP_ACP); 
end; 
 
procedure ladtxt(memo: TMemo; nam: TFilename); 
var 
  s: string; 
  ms: TMemorystream; 
  wc: Widestring; 
  pw: PWideChar; 
  P: PChar; 
  tx: T_UTF_Type; 
  pc: PDWord; 
  x: integer; 
begin 
  ms := TMemorystream.create; 
  ms.loadfromfile(nam); 
  ms.position := 0; 
  pc := ms.memory; 
  tx := testfileType(pc^); 
  if tx = UTF_8 then begin 
    p := ms.memory; 
    inc(p, 3); 
    s := ''; 
    for x := 1 to ms.size - 3 do begin 
      s := s + p^; 
      inc(p); 
    end; 
    memo.text := UTF82Ansi(s); 
    setlength(s, 0); 
  end else 
    if tx = UTF16_L 
      then begin 
      setlength(wc, ms.size - 4); 
      pw := ms.memory; 
      inc(pw); 
      copymemory(Pwidechar(wc), pw, ms.size - 4); 
      Unicode2Ansi(wc, s, CP_ACP); 
      setlength(s, (ms.size - 4) div 2); 
      memo.text := s; 
      setlength(s, 0); 
    end else memo.lines.loadfromstream(ms); 
  ms.free; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  ladtxt(Memo1, 'c:\UTF16L.txt'); 
end;