解决Delphi7的自带的UTF-8编码转换函数BUG

原作者: [db:作者] 来自: [db:来源] 收藏邀请

Delphi7及其以下版本的 VCL 只支持 Ansi, 所以... WideString 与 UTF8String (定义与 AnsiString 相同) 并没有办法正确的在 VCL 中显示

Delphi7自带的utf-8转换函数遇到其无法识别的字符串就返回空。

用以下转换函数可以解决这个bug

unit util_utf8;
 
interface
 
uses Windows;
 
type
  UTF8String = AnsiString;
 
  function AnsiToWide(const S: AnsiString): WideString;
  function WideToUTF8(const WS: WideString): UTF8String;
  function AnsiToUTF8(const S: AnsiString): UTF8String;
  function UTF8ToWide(const US: UTF8String): WideString;
  function WideToAnsi(const WS: WideString): AnsiString;
  function UTF8ToAnsi(const S: UTF8String): AnsiString;
 
implementation
 
function AnsiToWide(const S: AnsiString): WideString;
var
  len: integer;
  ws: WideString;
begin
  Result:='';
  if (Length(S) = 0) then
    exit;
  len:=MultiByteToWideChar(CP_ACP, 0, PChar(s), -1, nil, 0);
  SetLength(ws, len);
  MultiByteToWideChar(CP_ACP, 0, PChar(s), -1, PWideChar(ws), len);
  Result:=ws;
end;
 
function WideToUTF8(const WS: WideString): UTF8String;
var
  len: integer;
  us: UTF8String;
begin
  Result:='';
  if (Length(WS) = 0) then
    exit;
  len:=WideCharToMultiByte(CP_UTF8, 0, PWideChar(WS), -1, nil, 0, nil, nil);
  SetLength(us, len);
  WideCharToMultiByte(CP_UTF8, 0, PWideChar(WS), -1, PChar(us), len, nil, nil);
  Result:=us;
end;
 
function AnsiToUTF8(const S: AnsiString): UTF8String;
begin
  Result:=WideToUTF8(AnsiToWide(S));
end;
 
function UTF8ToWide(const US: UTF8String): WideString;
var
  len: integer;
  ws: WideString;
begin
  Result:='';
  if (Length(US) = 0) then
    exit;
  len:=MultiByteToWideChar(CP_UTF8, 0, PChar(US), -1, nil, 0);
  SetLength(ws, len);
  MultiByteToWideChar(CP_UTF8, 0, PChar(US), -1, PWideChar(ws), len);
  Result:=ws;
end;
 
function WideToAnsi(const WS: WideString): AnsiString;
var
  len: integer;
  s: AnsiString;
begin
  Result:='';
  if (Length(WS) = 0) then
    exit;
  len:=WideCharToMultiByte(CP_ACP, 0, PWideChar(WS), -1, nil, 0, nil, nil);
  SetLength(s, len);
  WideCharToMultiByte(CP_ACP, 0, PWideChar(WS), -1, PChar(s), len, nil, nil);
  Result:=s;
end;
 
function UTF8ToAnsi(const S: UTF8String): AnsiString;
begin
  Result:=WideToAnsi(UTF8ToWide(S));
end;
 
end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    IdHTTP1: TIdHTTP;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
  util_utf8;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  strm: TStringStream;
begin
  strm := TStringStream.Create('');
  try
    IdHTTP1.Get('http://gz.ganji.com/zpshichangyingxiao/', strm);
    Memo1.Clear;
    Memo1.Lines.Add(UTF8ToAnsi(strm.DataString));
  finally
    strm.Free;
  end;
end;

end.

窗体文件

object Form1: TForm1
  Left = 206
  Top = 211
  Width = 783
  Height = 540
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 56
    Top = 40
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Memo1: TMemo
    Left = 24
    Top = 88
    Width = 737
    Height = 409
    Lines.Strings = (
      'Memo1')
    ScrollBars = ssVertical
    TabOrder = 1
  end
  object IdHTTP1: TIdHTTP
    MaxLineAction = maException
    ReadTimeout = 0
    AllowCookies = True
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.ContentRangeEnd = 0
    Request.ContentRangeStart = 0
    Request.ContentType = 'text/html'
    Request.Accept = 'text/html, */*'
    Request.BasicAuthentication = False
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    HTTPOptions = [hoForceEncodeParams]
    Left = 240
    Top = 48
  end
end

测试效果：