• Delphi中array of const应用


    Delphi的Format函数大家都用得很多,第二个参数用着确实很方便。最近在数据库开发应用中需要自己创建一个带array of const参数的函数,对于常用的类型String,Integer,Pointer处理都没什么问题,但当用到Widestring类型时却出错,摸索了一上午,感觉获益良多。现在将问题、解决问题的思路、分析方法等一一道来,希望对诸君有所启发就达到了我写这篇文章的目的了!
    1. ///环境:Winxp + D7
    2. ///进入D7,在默认的新建工程中增加一过程Test(m: Array of const);
    3. procedure TForm1.test(m: array of const);
    4. var
    5. i, zero: Integer;
    6. s, t: String;
    7. c: Char;
    8. const
    9. sBoolean: Array [Boolean] of string = ('False''True');
    10. begin
    11. s := '';
    12. for i := 0 to High(m) do with m[i] do
    13.     case VType of //写到这,按住Ctrl点击VType,打开System单元,将VType的枚举值贴到Case语句
    14.       vtInteger:    (VInteger: Integer; VType: Byte);
    15.       vtBoolean:    (VBoolean: Boolean);
    16.       vtChar:       (VChar: Char);
    17.       vtExtended:   (VExtended: PExtended);
    18.       vtString:     (VString: PShortString);
    19.       vtPointer:    (VPointer: Pointer);
    20.       vtPChar:      (VPChar: PChar);
    21.       vtObject:     (VObject: TObject);
    22.       vtClass:      (VClass: TClass);
    23.       vtWideChar:   (VWideChar: WideChar);
    24.       vtPWideChar: (VPWideChar: PWideChar);
    25.       vtAnsiString: (VAnsiString: Pointer);
    26.       vtCurrency:   (VCurrency: PCurrency);
    27.       vtVariant:    (VVariant: PVariant);
    28.       vtInterface: (VInterface: Pointer);
    29.       vtWideString: (VWideString: Pointer);
    30.       vtInt64:      (VInt64: PInt64);
    31.     end;
    32. Delete(s, 11);
    33. Self.Caption := s;
    34. end;
    35. ///继续写,对各枚举值进行处理!这里作一下解释,Array of const正是由TVarRec类型组成的!
    36. ///请看Case of语句中的代码:
    37.       vtInteger: s := s + ';' + IntToStr(VInteger);
    38.       vtBoolean: s := s + ';' + sBoolean[VBoolean];
    39.       vtChar: s := s + ';' + VChar;
    40.       vtExtended: s := s + ';' + FloatToStr(VExtended^);
    41.       vtString:
    42.         if Assigned(VString) then begin
    43.           t := VString^;
    44.           s := s + ';' + t;
    45.         end;
    46.       vtPointer:
    47.         if Assigned(VPointer) then
    48.           s := Format('%S; Pointer: $%X ',[s, Integer(VPointer)]);
    49.       vtPChar:
    50.         if Assigned(VPChar) then begin
    51.           t := VPChar^;
    52.           s := s + ';' + t;
    53.         end;
    54.       vtObject:
    55.         if Assigned(VObject) then
    56.           s := Format('%S; $%X ClassName: %S ',[s, Integer(@VObject), VObject.ClassName]);
    57.       vtClass:
    58.         if Assigned(VClass) then
    59.           s := Format('%S; Class Reference $%X - ClassName: %S ',[s, Integer(VClass), VClass.ClassName]);
    60.       vtWideChar:
    61.         begin
    62.           t := VWideChar;
    63.           s := s + ';' + t;
    64.         end;
    65.       vtPWideChar:
    66.         if Assigned(VPWideChar) then begin
    67.           t := VPWideChar^;
    68.           s := s + ';' + t;
    69.         end;
    70.       vtAnsiString:
    71.         if Assigned(VAnsiString) then begin
    72.           t := PChar(VAnsiString);
    73.           s := s + ';' + t;
    74.         end;
    75.       vtCurrency:
    76.         if Assigned(VCurrency) then
    77.           s := s + ';' + FloatToStr(VCurrency^);
    78.       vtVariant:
    79.         if Assigned(VVariant) then
    80.           s := s + '; This is variant ';
    81.       vtInterface:
    82.         if Assigned(VInterface) then
    83.           s := Format('%S; Interface: $%X',[s, Integer(VInterface)]);
    84.       vtWideString:
    85.         if Assigned(VWideString) then begin
    86.           t := PWideString(VWideString)^;
    87.           s := s + ';' + t;
    88.         end;
    89.       vtInt64:
    90.         if Assigned(VInt64) then
    91.           s := s + ';' + IntToStr(VInt64^);

    加上一按钮测试该函数

    1. procedure TForm1.Button1Click(Sender: TObject);
    2. var
    3.     ws: WideString;
    4. begin
    5.     ws := 'dda这是一个测试dfa';
    6.     test([self, 'sdf'2.3324, ws, TForm]);
    7. end;

    可以看到测试结果,变量ws的值没有显示出来,怎么办呢?

    我们可以看到WideString类型的值是指针,我们就从这里着手,在事件中添加一句:
    Button1.Caption := Format('$%X',[Integer(@ws)]);
    此句的作用是显示出ws的地址
    再在Test函数中也加上类似的语句,并注释掉无用的语句:
    //t := PWideString(VWideString)^;
    //s := s + ';' + t;
    s := s + ';' + Format('$%X',[Integer(VWideString)]);
    运行可看到二个地址不一样,说明Delphi对传入的参数数据作了复制
    因此将其强制转换成PWidechar应该可以,增加一变量声明
    w: WideString;

    w := PWideString(VWideString)^;
    s := s + ';' + w;
    但运行结果却只显示一个字符,别沮丧,已经摸到门道了!

    我们知道Format可以处理Widestring类型,这里只得到一个字符,说明字符被截断了。Delphi中的字符串是以#0结束,Widestring以二个#0结束,可以肯定w := PWideString(VWideString)^这句Delphi作转换时肯定将其默认作为AnsiString处理了。分析到这里已经可动手写下去了.....

    p: PByte;

            if Assigned(VWideString) then begin
              t := '';
              zero := 0;
              p := VWideString;
              repeat
                c := char(p^);
                inc(p);
                if c = #0 then
                  inc(zero) else
                  begin
                    zero := 0;
                    t := t + c;
                  end;
              until zero = 2;
              s := s + ';' + t;
            end;

    但是显示汉字却变成乱码了,而且处理也显得臃肿。到这里我们已经明白了,VWideString所指示的字符串是二字节宽字符串,而且Intel的字节顺序也是低位在前,高位在后。因此可用PWord进行处理!

    删除c,zero,w变量,p改成:
    p: PWord;

            if Assigned(VWideString) then begin
              t := '';
              p := VWideString;
              repeat
                t := t + widechar(p^);
                inc(p);
              until p^ = 0;
              s := s + ';' + t;
            end;
    可以看到核心代码已经很精练了,运行已经显示正常,汉字也无乱码了!至此我们似乎是大功告成了,但静下来想想,Delphi支持WideString到String的转换,它也应该有这样的处理代码。
    而且在循环中t := t + widechar(p^);语句处下一断点,运行到断点处,再打开CPU窗口,看到看似简洁的代码,单此一句,编译器都要给它加上一大堆处理代码。找到系统的字符串处理函数很有必要,经过在System.pas单元中搜索WideString,找到函数:procedure WideCharToStrVar(Source: PWideChar; var Dest: string);
    呵呵,这正是我们要的!!!
    现在循环语句及P变量都可删除了,代码我就省略了。

  • 相关阅读:
    RabbitMQ死信队列另类用法之复合死信
    Asp.NetCore轻松学-使用Docker进行容器化托管
    Asp.NetCore轻松学-使用Supervisor进行托管部署
    Asp.NetCore轻松学-部署到 Linux 进行托管
    Asp.NetCore轻松学-部署到 IIS 进行托管
    一个提问引发的职业规划热议-拨开迷雾,走向光明
    Asp.Net Core 轻松学-使用MariaDB/MySql/PostgreSQL和支持多个上下文对象
    Asp.Net Core 轻松学-经常使用异步的你,可能需要看看这个文章
    Asp.Net Core 轻松学-10分钟使用EFCore连接MSSQL数据库
    Asp.Net Core 轻松学-多线程之Task(补充)
  • 原文地址:https://www.cnblogs.com/zhaoshujie/p/9594830.html
Copyright © 2020-2023  润新知