維's profileIT : 是工作還是嗜好?PhotosBlogListsMore Tools Help

Blog


    July 14

    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.


    Comments (3)

    Please wait...
    Sorry, the comment you entered is too long. Please shorten it.
    You didn't enter anything. Please try again.
    Sorry, we can't add your comment right now. Please try again later.
    To add a comment, you need permission from your parent. Ask for permission
    Your parent has turned off comments.
    Sorry, we can't delete your comment right now. Please try again later.
    You've exceeded the maximum number of comments that can be left in one day. Please try again in 24 hours.
    Your account has had the ability to leave comments disabled because our systems indicate that you may be spamming other users. If you believe that your account has been disabled in error please contact Windows Live support.
    Complete the security check below to finish leaving your comment.
    The characters you type in the security check must match the characters in the picture or audio.

    To add a comment, sign in with your Windows Live ID (if you use Hotmail, Messenger, or Xbox LIVE, you have a Windows Live ID). Sign in


    Don't have a Windows Live ID? Sign up

    bmwrote:
    delphi2009简体中文还是有问题, 比如自带的例子Guess,将提示改为中文, 提示则输出乱码,而在delphi2010下面则没这个问题.
    感觉delphi2009 凡是用到ajax的地方输出中文就有问题. 用了李老师的方法也没法解决.
    July 20
    維 李wrote:
    >简体中文是否也存在这样的问题,如果存在,是否可以使用该方法解决?

    简体中文沒有問題, 因此不需要.
    July 15
    lzf1010wrote:
    简体中文是否也存在这样的问题,如果存在,是否可以使用该方法解决?
    July 15

    Trackbacks

    The trackback URL for this entry is:
    http://gordonliwei.spaces.live.com/blog/cns!CCE1F10BD8108687!3603.trak
    Weblogs that reference this entry
    • None