CODEWITHSUNDEEP
delphi
NMD
NMD

Reputation: 135

TClientDataSet Custom compare field function

I am using an in-memory TClientDataSet with a TStringField column which contains folders path (Delphi 7). When I create an index on this column the order is not what I am looking for. As an example I get :

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

when I would like this order :

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

So I searched a way to use my own compare field function.

Based on this RRUZ answer How to change the implementation (detour) of an externally declared function I tried the following :

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;

When I try to compile I get an error (MyCDs as TClientDataSetHelper).DSBase.FldCmp : not enough actual parameters

I do not understand why this does not compile. Could you please help me ?

Is it even possible to "detour" IDSBase.FldCmp in DSIntf.pas ? Am i totally wrong ?

Thank you

EDIT

Finally, thanks to Dsm answer, I transformed the TStringFieldcolumn into a TVarBytesField in order to avoid doubling the buffer. Plus, when a TVarBytesField is indexed the order is based on the bytes value so I get the order I want. For having all child folders after a parent folder and before the next parent folder (c:\foo.new after c:\foo\b), I patched TVarBytesFieldlike this :

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;

Upvotes: 1

Views: 303

Answers (1)

Dsm
Dsm

Reputation: 6013

The message is telling you that FldCmp is a function, and it is expecting you to execute it, but it has not got enough parameters. I am sure that you already realised that and probably already tried to get the address of the function with the @ (like you do for FldCmpHack) and found that that does not work.

The reason for that is, I am afraid, that FldCmp is not a normal function. DSBase is actually an interface, which will have been assigned (looking at the source code) by a class factory. What you actually need is the real function itself and for that you need the real object that the class factory creates. And I am sorry, but I can't see any realistic way of doing that.

However, the DSBase field is only created if it has not been assigned, so you could, in theory, create your own IDSBase interface object, which is the way this type of problem is meant to be handled. That is a lot of work, though, unless you know class that the class factory produces and can descend from that.

A sneakier alternative is to override the Translate property and create some sort of hash (perhaps by translating the ASCII codes to their HEX values) so that the database keeps them in the right order

  TClientDataSetHelper = class(TClientDataSet)

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

  end;

Upvotes: 1

Related Questions