維'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.