dbf_collate.pas

tDBF is new ver, this is BDS 2007 insta

unit Dbf_Collate;

{$i dbf_common.inc}


interface

uses 
  SysUtils;



type
  TCollationTable         = array[0..255] of Byte;
  PCollationTable         = ^TCollationTable;
  TCollationBDEName       = string[8];

  TCollationDefinition = record
    CollationBDEName :TCollationBDEName;
    CollationTable   :PCollationTable;
  end;



const
  BINARY_COLLATION  :PCollationTable = PCollationTable($111);
  UNKNOWN_COLLATION :PCollationTable = PCollationTable($222);



function GetCollationTable( DbfLangId :integer ) :PCollationTable;
function DbfCompareString( CollationTable :PCollationTable; String1 :PChar; nLength1 :integer; String2 :PChar; nLength2 :integer ) :integer;
function RegisterCollation( DbfLangId :integer; CollationTable :PCollationTable; BDEName :TCollationBDEName ) :Boolean;


var
  CollationTables :array[0..255] of TCollationDefinition;


implementation
uses dbf_lang, math;


procedure InitialiseCollationTables;
var
  nCnt :integer;
begin
  for nCnt := Low(CollationTables) to High(CollationTables) do
    begin
      CollationTables[nCnt].CollationTable   := BINARY_COLLATION;
      CollationTables[nCnt].CollationBDEName := '';
    end;
end;

function GetCollationTable( DbfLangId :integer ) :PCollationTable;
begin
  if (DbfLangId < Low(CollationTables)) or (DbfLangId > High(CollationTables)) then
    begin
      Result := nil;
    end
  else
    begin
      Result := CollationTables[DbfLangId].CollationTable;
    end;
end;

function DbfCompareString( CollationTable :PCollationTable; String1 :PChar; nLength1 :integer; String2 :PChar; nLength2 :integer ) :integer;
var
  nCnt, nMax, nVal1, nVal2 :integer;
const
  ONE_LESS_THAN_TWO  = 1;
  EQUAL              = 2;
  TWO_LESS_THAN_ONE  = 3;
begin
  result := EQUAL;

  if CollationTable = BINARY_COLLATION then
    begin
      // binary collation
      nMax := Min( nLength1, nLength2 );
      for nCnt := 1 to nMax do
        begin
          if Ord(String1^) < Ord(String2^) then
            begin
              result := ONE_LESS_THAN_TWO;
              break;
            end
          else if Ord(String1^) > Ord(String2^) then
            begin
              result := TWO_LESS_THAN_ONE;
              break;
            end;

          Inc(String1);
          Inc(String2);
        end;
    end

  else

    begin
      // collation via collation table
      nMax := Min( nLength1, nLength2 );
      for nCnt := 1 to nMax do
        begin
          nVal1 := CollationTable[Ord(String1^)];
          nVal2 := CollationTable[Ord(String2^)];

          if nVal1 < nVal2 then
            begin
              result := ONE_LESS_THAN_TWO;
              break;
            end

          else if nVal1 > nVal2 then
            begin
              result := TWO_LESS_THAN_ONE;
              break;
            end;

          Inc(String1);
          Inc(String2);
        end;

    end;


  if result = EQUAL then
    begin
      // If the two strings are of different lengths, they are compared up to the
      // length of the shortest one. If they are equal to that point, then the
      // return value will indicate that the longer string is greater.
      if nLength1 < nLength2 then
        result := ONE_LESS_THAN_TWO
      else if nLength1 > nLength2 then
        result := TWO_LESS_THAN_ONE;
    end;

end;


function RegisterCollation( DbfLangId :integer; CollationTable :PCollationTable; BDEName :TCollationBDEName ) :Boolean;
begin
  if (DbfLangId < Low(CollationTables)) or (DbfLangId > High(CollationTables)) then
    begin
      result := false;
    end
  else
    begin
      CollationTables[DbfLangId].CollationTable   := CollationTable;
      CollationTables[DbfLangId].CollationBDEName := BDEName;
      result := true;
    end;
end;




const

  {$IFDEF PARADOX_COLLATIONS}

  // intl    55764
  _intl :TCollationTable = (
    000, 001, 002, 003, 004, 005, 006, 007, 008, 009, 010, 011, 012, 013, 014, 015,
    016, 017, 018, 019, 020, 021, 022, 023, 024, 025, 026, 027, 028, 029, 030, 031,
    032, 033, 034, 035, 036, 037, 038, 039, 040, 041, 042, 043, 044, 045, 046, 047,
    048, 049, 050, 051, 052, 053, 054, 055, 056, 057, 058, 059, 060, 061, 062, 063,
    064, 069, 073, 076, 079, 085, 088, 090, 092, 098, 100, 102, 104, 106, 109, 115,
    119, 121, 123, 125, 128, 133, 137, 139, 141, 144, 146, 149, 150, 151, 152, 153,
    154, 065, 072, 074, 078, 080, 087, 089, 091, 093, 099, 101, 103, 105, 107, 111,
    118, 120, 122, 124, 127, 129, 136, 138, 140, 142, 145, 155, 156, 157, 158, 159,
    035, 035, 035, 165, 035, 035, 035, 035, 035, 035, 125, 035, 115, 035, 035, 035,
    035, 035, 035, 035, 035, 035, 035, 035, 035, 035, 124, 035, 111, 035, 035, 144,
    181, 172, 162, 163, 035, 164, 035, 035, 035, 035, 166, 173, 169, 035, 035, 035,
    178, 176, 180, 035, 035, 175, 035, 179, 035, 035, 167, 174, 171, 170, 035, 168,
    069, 069, 069, 069, 071, 148, 161, 077, 085, 086, 085, 085, 098, 098, 098, 098, 
    079, 110, 115, 115, 115, 115, 117, 035, 115, 133, 133, 133, 135, 144, 035, 126, 
    067, 066, 068, 065, 070, 147, 160, 075, 083, 082, 084, 081, 096, 095, 097, 094, 
    078, 108, 113, 112, 114, 111, 116, 177, 111, 131, 130, 132, 134, 142, 035, 143
  );

  intl :PCollationTable = @_intl;

  {$ENDIF}




  {$IFDEF PARADOX_COLLATIONS}

  // nordan    1610

  _nordan :TCollationTable = (
    000, 001, 002, 003, 004, 005, 006, 007, 008, 009, 010, 011, 012, 013, 014, 015,
    016, 017, 018, 019, 020, 021, 022, 023, 024, 025, 026, 027, 028, 029, 030, 031,
    032, 033, 034, 035, 036, 037, 038, 039, 040, 041, 042, 043, 044, 045, 046, 047,
    048, 049, 050, 051, 052, 053, 054, 055, 056, 057, 058, 059, 060, 061, 062, 063,
    064, 069, 071, 074, 077, 083, 086, 088, 090, 096, 098, 100, 102, 104, 107, 113,
    115, 117, 119, 121, 123, 128, 130, 132, 134, 138, 141, 152, 153, 154, 155, 156,
    157, 065, 070, 072, 076, 078, 085, 087, 089, 091, 097, 099, 101, 103, 105, 109,
    114, 116, 118, 120, 122, 124, 129, 131, 133, 135, 140, 158, 159, 160, 161, 162,
    035, 035, 035, 164, 035, 035, 035, 035, 035, 035, 121, 035, 113, 035, 035, 035,
    035, 035, 035, 035, 035, 035, 035, 035, 035, 035, 120, 035, 109, 035, 035, 138,
    181, 171, 035, 163, 173, 035, 035, 035, 035, 035, 165, 172, 168, 035, 035, 035,
    178, 176, 180, 035, 035, 175, 035, 179, 035, 035, 166, 035, 170, 169, 035, 167,
    069, 069, 069, 069, 145, 151, 144, 075, 083, 084, 083, 083, 096, 096, 096, 096,
    077, 108, 113, 113, 113, 113, 149, 035, 148, 128, 128, 128, 139, 138, 035, 174,
    067, 066, 068, 065, 143, 150, 142, 073, 081, 080, 082, 079, 094, 093, 095, 092,
    076, 106, 111, 110, 112, 109, 147, 177, 146, 126, 125, 127, 136, 135, 035, 137
  );
  nordan :PCollationTable = @_nordan;

  {$ENDIF}




  {$IFDEF PARADOX_COLLATIONS}

  // nordan40    31338

  _nordan40 :TCollationTable = (
    000, 001, 002, 003, 004, 005, 006, 007, 008, 009, 010, 011, 012, 013, 014, 015,
    016, 017, 018, 019, 020, 021, 022, 023, 024, 025, 026, 027, 028, 029, 030, 031,
    032, 033, 034, 035, 036, 037, 038, 039, 040, 041, 042, 043, 044, 045, 046, 047,
    048, 049, 050, 051, 052, 053, 054, 055, 056, 057, 058, 059, 060, 061, 062, 063,
    064, 065, 070, 072, 076, 078, 085, 087, 089, 091, 097, 099, 101, 103, 105, 109,
    114, 116, 118, 120, 122, 124, 129, 131, 133, 135, 140, 152, 153, 154, 155, 156,
    157, 066, 071, 074, 077, 080, 086, 088, 090, 092, 098, 100, 102, 104, 107, 110,
    115, 117, 119, 121, 123, 125, 130, 132, 134, 137, 141, 158, 159, 160, 161, 162,
    035, 035, 035, 164, 035, 035, 035, 035, 035, 035, 120, 035, 109, 035, 035, 035,
    035, 035, 035, 035, 035, 035, 035, 035, 035, 035, 121, 035, 110, 035, 035, 135,
    181, 171, 035, 163, 173, 035, 035, 035, 035, 035, 165, 172, 168, 035, 035, 035,
    178, 176, 180, 035, 035, 175, 035, 179, 035, 035, 166, 035, 170, 169, 035, 167,
    065, 065, 065, 065, 143, 150, 142, 073, 078, 079, 078, 078, 091, 091, 091, 091,
    076, 106, 109, 109, 109, 109, 147, 035, 146, 124, 124, 124, 136, 135, 035, 174,
    068, 067, 069, 066, 145, 151, 144, 075, 083, 082, 084, 081, 095, 094, 096, 093,
    077, 108, 112, 111, 113, 110, 149, 177, 148, 127, 126, 128, 139, 137, 035, 138
  );
  nordan40 :PCollationTable = @_nordan40;

  {$ENDIF}




  {$IFDEF PARADOX_COLLATIONS}

  // swedfin    6461

  _swedfin :TCollationTable = (