Question

我正在使用内存TClientDataSet，其中TStringField列包含文件夹路径（Delphi 7）。当我在此列上创建索引时，订单不是我要查找的。作为一个例子，我得到：

c:\foo
c:\fôo\a
c:\foo\b

当我想要这个订单时：

c:\foo
c:\foo\b
c:\fôo\a

所以我搜索了一种方法来使用我自己的比较字段函数。

根据此RRUZ答案How to change the implementation (detour) of an externally declared function，我尝试了以下内容：

type
  TClientDataSetHelper = class(DBClient.TClientDataSet);
  ...
  MyCDS : TClientDataSet;
  ...
// My custom compare field function
function FldCmpHack
(
  iFldType  : LongWord;
  pFld1     : Pointer;
  pFld2     : Pointer;
  iUnits1   : LongWord;
  iUnits2   : LongWord
): Integer; stdcall;
begin
  // Just to test
  Result := -1;
end;
...
---RRUZ code here---
...
procedure HookDataCompare;
begin
  HookProc
  (
    (MyCDs as TClientDataSetHelper).DSBase.FldCmp, <== do not compile !!!
    @FldCmpHack, 
    FldCmpBackup
  ); 
end;

当我尝试编译时，我收到错误(MyCDs as TClientDataSetHelper).DSBase.FldCmp : not enough actual parameters

我不明白为什么这不编译。你能帮我吗？

甚至可以在IDSBase.FldCmp中“绕道”DSIntf.pas吗？我完全错了吗？

谢谢

修改

最后，感谢Dsm的回答，我将TStringField列转换为TVarBytesField，以避免加倍缓冲区。另外，当索引TVarBytesField时，订单基于字节值，因此我得到了我想要的订单。为了在父文件夹之后和下一个父文件夹（c:\foo.new之后c:\foo\b）之前拥有所有子文件夹，我修改了TVarBytesField，如下所示：

TVarBytesField = class(DB.TVarBytesField)
protected
  function GetAsString: string; override;
  procedure GetText(var Text: string; DisplayText: Boolean); override;
  procedure SetAsString(const Value: string); override;
end;

function TVarBytesField.GetAsString: string;
var
  vBuffer : PAnsiChar;
  vTaille : WORD;
  vTexte  : PAnsiChar;
  vI      : WORD;
begin
  Result := '';
  GetMem(vBuffer, DataSize);
  try
    if GetData(vBuffer) then
    begin
      vTaille := PWORD(vBuffer)^;
      vTexte := vBuffer + 2;
      SetLength(Result, vTaille);
      for vI := 1 to vTaille do
      begin
        if vTexte^ = #2 then
        begin
          Result[vI] := '\';
        end
        else
        begin
          Result[vI] := vTexte^;
        end;
        Inc(vTexte);
      end;
    end;
  finally
    FreeMem(vBuffer);
  end;
end;

procedure TVarBytesField.GetText(var Text: string; DisplayText: Boolean);
begin
  Text := GetAsString;
end;

procedure TVarBytesField.SetAsString(const Value: string);
var
  vBuffer : PAnsiChar;
  vTaille : WORD;
  vTexte  : PAnsiChar;
  vI      : WORD;
begin
  vBuffer := AllocMem(DataSize);
  try
    vTaille := WORD(Length(Value));
    PWORD(vBuffer)^ := vTaille;
    vTexte := vBuffer + 2;
    for vI := 1 to vTaille do
    begin
      if Value[vI] = '\' then
      begin
        vTexte^ := #2
      end
      else
      begin
        vTexte^ := Value[vI];
      end;
      Inc(vTexte);
    end;
    SetData(vBuffer);
  finally
    FreeMem(vBuffer);
  end;
end;

Answer 1

消息告诉你FldCmp是一个函数，它期望你执行它，但它没有足够的参数。我相信你已经意识到这一点，并且可能已经尝试用@获取函数的地址（就像你为FldCmpHack所做的那样），并发现这不起作用。

原因是，我担心，FldCmp不是正常的功能。 DSBase实际上是一个接口，它将由类工厂分配（查看源代码）。你真正需要的是真正的函数本身，为此你需要类工厂创建的真实对象。我很抱歉，但我看不出任何切合实际的方法。

但是，仅在尚未分配DSBase字段时才创建它，因此理论上您可以创建自己的IDSBase接口对象，这就是处理此类问题的方式。不过，这是很多工作，除非你知道班级工厂生产的课程，并且可以从那里下载。

一个狡猾的替代方法是覆盖Translate属性并创建某种散列（可能通过将ASCII代码转换为其HEX值），以便数据库使它们保持正确的顺序

  TClientDataSetHelper = class(TClientDataSet)

  public
      function Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; override;

  end;

TClientDataSet自定义比较字段功能

1 个答案: