hdcompress.pas

RAY压缩是综合统计和字典方法

unit HdCompress;

interface

uses
  SysUtils, Classes,HdRecLst;

type
  TAgentCode = record
    Code:Byte;
    Str:string[2];
  end;
  PAgentCode = ^TAgentCode;

  TJoinCodeNum = record
    Str:string[2];
    Num:Integer;
  end;
  PJoinCodeNum = ^TJoinCodeNum;

type
  TListAgentCode = class(THdRecordList)
  private
    FCompareFunc:THdCompareFunc;
    function rlGetItem(aIndex: integer): TAgentCode;
    function rlGetItemPoint(aIndex: Integer): Pointer;
  protected
    procedure rlError(aErrorCode : integer;
                const aMethodName : string;
                      aIndex      : integer); override;
  public
    constructor Create(aCompareFunc:THdCompareFunc=nil);
    function Add(aItem : TAgentCode) : integer;
    function IndexOf(aID    : Byte) : integer;
    procedure Insert(aIndex : integer; aItem : TAgentCode);
    function InsertSorted(aItem : TAgentCode) : integer;
    function Remove(aID    : Byte) : integer;
    function CheckSort:Boolean;
    procedure Sort;
    property Items[aIndex : integer] :TAgentCode read rlGetItem; default;
    property ItemsPointer[aIndex:Integer]:Pointer read rlGetItemPoint;
  end;

  TListJoinCodeNum = class(THdRecordList)
  private
    FCompareFunc:THdCompareFunc;
    function rlGetItem(aIndex: integer):TJoinCodeNum;
    function rlGetItemPoint(aIndex: Integer): Pointer;
  protected
    procedure rlError(aErrorCode : integer;
                const aMethodName : string;
                      aIndex      : integer); override;
  public
    constructor Create(aCompareFunc:THdCompareFunc=nil);
    function Add(aItem : TJoinCodeNum) : integer;
    function IndexOf(aID    : ShortString) : integer;
    procedure Insert(aIndex : integer; aItem : TJoinCodeNum);
    function InsertSorted(aItem : TJoinCodeNum) : integer;
    function Remove(aID    : ShortString) : integer;
    function CheckSort:Boolean;
    procedure Sort;
    property Items[aIndex : integer] :TJoinCodeNum read rlGetItem; default;
    property ItemsPointer[aIndex:Integer]:Pointer read rlGetItemPoint;
  end;


function hdCompareAgentCode(aData1, aData2 : pointer) : integer;
function hdCompareJoinCodeNum(aData1, aData2 : pointer) : integer;

implementation

const
  UnitName='HdCompress';

function hdCompareAgentCode(aData1, aData2 : pointer) : integer;
var
  L1 : Byte;
  L2 : Byte;
begin
  L1:=TAgentCode(aData1^).Code;
  L2:=TAgentCode(aData2^).Code;
  if (L1 < L2) then
    Result := -1
  else if (L1 = L2) then
    Result := 0
  else
    Result := 1
end;

function hdCompareJoinCodeNum(aData1, aData2 : pointer) : integer;
var
  L1 : ShortString;
  L2 : ShortString;
begin
  L1:=TJoinCodeNum(aData1^).Str;
  L2:=TJoinCodeNum(aData2^).Str;
  if (L1 < L2) then
    Result := -1
  else if (L1 = L2) then
    Result := 0
  else
    Result := 1
end;

{ TListAgentCode }

function TListAgentCode.Add(aItem: TAgentCode): integer;
begin
  Result:= inherited Add(@aItem);
end;

function TListAgentCode.CheckSort: Boolean;
begin
  Result:= inherited CheckSort(FCompareFunc);
end;

constructor TListAgentCode.Create(aCompareFunc: THdCompareFunc);
begin
  inherited Create(SizeOf(TAgentCode));
  if not Assigned(aCompareFunc) then
    FCompareFunc:=hdCompareAgentCode
  else
    FCompareFunc:=aCompareFunc;
end;

function TListAgentCode.IndexOf(aID: Byte): integer;
//索引
var
  tmp:TAgentCode;
begin
  tmp.Code:=aID;
  Result:= inherited IndexOf(@tmp,FCompareFunc);
end;

procedure TListAgentCode.Insert(aIndex: integer; aItem: TAgentCode);
begin
  inherited Insert(aIndex,@aItem);
end;

function TListAgentCode.InsertSorted(aItem: TAgentCode): integer;
begin
  Result:= inherited InsertSorted(@aItem,FCompareFunc);
end;

function TListAgentCode.Remove(aID:Byte): integer;
//移除
var
  tmp:TAgentCode;
begin
  tmp.Code:=aID;
  Result:= inherited Remove(@tmp,FCompareFunc);
end;

procedure TListAgentCode.rlError(aErrorCode: integer;
  const aMethodName: string; aIndex: integer);
begin
  inherited rlError(aErrorCode,aMethodName,aIndex);
end;

function TListAgentCode.rlGetItem(aIndex: integer): TAgentCode;
begin
  Result:=TAgentCode(inherited rlGetItem(aIndex)^);
end;

function TListAgentCode.rlGetItemPoint(aIndex: Integer): Pointer;
begin
  Result:=inherited rlGetItem(aIndex);
end;

procedure TListAgentCode.Sort;
begin
  inherited Sort(FCompareFunc);
end;

{ TListJoinCodeNum }

function TListJoinCodeNum.Add(aItem: TJoinCodeNum): integer;
begin
  Result:= inherited Add(@aItem);
end;

function TListJoinCodeNum.CheckSort: Boolean;
begin
  Result:= inherited CheckSort(FCompareFunc);
end;

constructor TListJoinCodeNum.Create(aCompareFunc: THdCompareFunc);
begin
  inherited Create(SizeOf(TJoinCodeNum));
  if not Assigned(aCompareFunc) then
    FCompareFunc:=hdCompareJoinCodeNum
  else
    FCompareFunc:=aCompareFunc;
end;

function TListJoinCodeNum.IndexOf(aID: ShortString): integer;
//索引
var
  tmp:TJoinCodeNum;
begin
  tmp.Str:=aID;
  Result:= inherited IndexOf(@tmp,FCompareFunc);
end;

procedure TListJoinCodeNum.Insert(aIndex: integer; aItem: TJoinCodeNum);
begin
  inherited Insert(aIndex,@aItem);
end;

function TListJoinCodeNum.InsertSorted(aItem: TJoinCodeNum): integer;
begin
  Result:= inherited InsertSorted(@aItem,FCompareFunc);
end;

function TListJoinCodeNum.Remove(aID: ShortString): integer;
//移除
var
  tmp:TJoinCodeNum;
begin
  tmp.Str:=aID;
  Result:= inherited Remove(@tmp,FCompareFunc);
end;

procedure TListJoinCodeNum.rlError(aErrorCode: integer;
  const aMethodName: string; aIndex: integer);
begin
  inherited rlError(aErrorCode,aMethodName,aIndex);
end;

function TListJoinCodeNum.rlGetItem(aIndex: integer): TJoinCodeNum;
begin
  Result:=TJoinCodeNum(inherited rlGetItem(aIndex)^);
end;

function TListJoinCodeNum.rlGetItemPoint(aIndex: Integer): Pointer;
begin
  Result:=inherited rlGetItem(aIndex);
end;

procedure TListJoinCodeNum.Sort;
begin
  inherited Sort(FCompareFunc);
end;

end.