2009 年 07 月 的封存

VCL For Web 2009繁體中文問題解決方法

在追了IntraWeb團隊和Delphi團隊將近半年之後終於追出了解決方案,由於了IntraWeb團隊和Delphi團隊都忙於下一版Delphi的開發工作,因此為了讓他們能夠解決這個問題實在是因為徹底發揮了『追,纏,黏』的功夫。不多說了,如果有朋友在VCL For Web下有繁體中文的問題的話,那麼請使用下列的方法即可解決:

        1. http://www.atozed.com/intraweb/Download/Files/index.EN.aspx下載並且安裝IntraWeb build 10.0.15

        2.  把文後下附的UTF8ContentParser.pas放到您的專案目錄中

        3.  在您的專案中加入UTF8ContentParser.pas

4.     
在您的應用程式中的uses句子中加入參考UTF8ContentParser

5.     
重新編譯和執行

現在VCL For Web在繁體中文作業系統中的問題就會自動解決了。

我已經和IntraWeb團隊和Delphi團隊確認在下一版的DelphiUTF8ContentParser會加入到VCL框架中,因此下一版Delphi1出來時就不再需要上述的步驟了。

Have Fun!

// TUTF8ContentParser is a WebRequest content parser that parses UTF-8 requests.

// TUTF8ContentParser class automatically replace the default content parser when this unit (UTF8ContentParser)

// is used in a web application.  You should only use UTF8ContentParser in web applications that generate UTF-8

// responses.

//

// To generated UTF-8 encoded responses, set Response.ContentType as follows before setting Response.Content.

//    Response.ContentType := ‘text/html; charset=UTF-8’;

//

// Note that, if your application uses the ReqMulti unit to parse multipart content, ReqMulti must appear in the application

// uses list after UTF8ContentParser.

unit UTF8ContentParser;

interface

uses SysUtils, Classes, Masks, Contnrs, HTTPApp,

  ReqFiles, HTTPParse;

type

{ TUTF8ContentParser }

  TUTF8ContentParser = class(TContentParser)

  private

    FContentFields: TStrings;

  public

    destructor Destroy; override;

    function GetContentFields: TStrings; override;

    class function CanParse(AWebRequest: TWebRequest): Boolean; override;

  end;

implementation

uses WebConst, WebComp, BrkrConst, Windows;

{ TUTF8ContentParser }

class function TUTF8ContentParser.CanParse(AWebRequest: TWebRequest): Boolean;

begin

  Result := True;

end;

destructor TUTF8ContentParser.Destroy;

begin

  FContentFields.Free;

  inherited Destroy;

end;

procedure ExtractHeaderFields(Separators, WhiteSpace: TSysCharSet; Content: PAnsiChar;

  Strings: TStrings; Decode: Boolean; Encoding: TEncoding; StripQuotes: Boolean = False); forward;

function TUTF8ContentParser.GetContentFields: TStrings;

begin

  if FContentFields = nil then

  begin

    FContentFields := TStringList.Create;

    if WebRequest.ContentLength > 0 then

    begin

      ExtractHeaderFields([‘&’], [], PAnsiChar(WebRequest.RawContent), FContentFields, True, TEncoding.UTF8);

    end;

  end;

  Result := FContentFields;

end;

// Version of HTTP.ExtractHeaderFields that supports encoding parameter

procedure ExtractHeaderFields(Separators, WhiteSpace: TSysCharSet; Content: PAnsiChar;

  Strings: TStrings; Decode: Boolean; Encoding: TEncoding; StripQuotes: Boolean = False);

var

  Head, Tail: PAnsiChar;

  EOS, InQuote, LeadQuote: Boolean;

  QuoteChar: AnsiChar;

  ExtractedField: AnsiString;

  WhiteSpaceWithCRLF: TSysCharSet;

  SeparatorsWithCRLF: TSysCharSet;

  procedure AddString(const S: AnsiString);

  var

    LBytes: TBytes;

    LString: string;

  begin

    LBytes := BytesOf(S);

    LString := Encoding.GetString(LBytes);

    Strings.Add(LString);

  end;

  function DoStripQuotes(const S: AnsiString): AnsiString;

  var

    I: Integer;

    InStripQuote: Boolean;

    StripQuoteChar: AnsiChar;

  begin

    Result := S;

    InStripQuote := False;

    StripQuoteChar := #0;

    if StripQuotes then

      for I := Length(Result) downto 1 do

        if CharInSet(Result[I], [“", ‘"’]) then

          if InStripQuote and (StripQuoteChar = Result[I]) then

          begin

          Delete(Result, I, 1);

            InStripQuote := False;

          end

          else if not InStripQuote then

          begin

            StripQuoteChar := Result[I];

            InStripQuote := True;

            Delete(Result, I, 1);

          end

  end;

begin

  if (Content = nil) or (Content^ = #0) then Exit;

  WhiteSpaceWithCRLF := WhiteSpace + [#13, #10];

  SeparatorsWithCRLF := Separators + [#0, #13, #10, ‘"’];

  Tail := Content;

  QuoteChar := #0;

  repeat

    while CharInSet(Tail^, WhiteSpaceWithCRLF) do Inc(Tail);

    Head := Tail;

    InQuote := False;

    LeadQuote := False;

    while True do

    begin

     while (InQuote and not CharInSet(Tail^, [#0, ‘"’])) or

        not CharInSet(Tail^, SeparatorsWithCRLF) do Inc(Tail);

      if Tail^ = ‘"’ then

      begin

        if (QuoteChar <> #0) and (QuoteChar = Tail^) then

          QuoteChar := #0

        else

        begin

          LeadQuote := Head = Tail;

          QuoteChar := Tail^;

          if LeadQuote then Inc(Head);

        end;

        InQuote := QuoteChar <> #0;

        if InQuote then

          Inc(Tail)

        else Break;

      end else Break;

    end;

    if not LeadQuote and (Tail^ <> #0) and (Tail^ = ‘"’) then

      Inc(Tail);

    EOS := Tail^ = #0;

    if Head^ <> #0 then

    begin

      SetString(ExtractedField, Head, Tail-Head);

      if Decode then

        AddString(HTTPDecode(AnsiString(DoStripQuotes(ExtractedField))))

      else AddString(DoStripQuotes(ExtractedField));

    end;

    Inc(Tail);

  until EOS;

end;

initialization

  RegisterContentParser(TUTF8ContentParser);

end.

廣告

8 則迴響