home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d45 / ARDOCI.ZIP / ADataSet.pas next >
Pascal/Delphi Source File  |  2001-04-25  |  52KB  |  1,559 lines
  1. unit ADataSet;
  2.  
  3. {
  4.  Descendant of TComponent
  5.  
  6.  The base class for all components which work with database tables.
  7.   TAdataSet does not compatible with TDataSet.
  8.  
  9.  Next datatypes are implemented :
  10.    ftoString, ftoSmallint, ftoInteger, ftoWord, ftoBoolean,
  11.    ftoDouble, ftoCurrency, ftoDate, ftoTime, ftoDateTime, ftoBlob, ftoClob, ftoUnknown
  12.  
  13.  Functions for convert datatypes from or to Delphi datatypes
  14.   function TypeAToDelphi(fta:TAFieldType):TFieldType;
  15.   function TypeDelphiToA(ft:TFieldType):TAFieldType;
  16.  
  17.  Class ADataSet has next virtual abstract methods :
  18.  
  19.    procedure Fetch;
  20.      get next portion of data with size of FetchCount rows.
  21.  
  22.    procedure AddParam(ParamName:string;FieldType:TAFieldType;ParamType:TAParamType);
  23.      add new parameter description
  24.  
  25.    procedure Prepare;
  26.      prepare query or PL/SQL code for execution (parse,optimize)
  27.    procedure UnPrepare;
  28.  
  29.  
  30.  
  31.  Virtual Methods
  32.    procedure ClearParams;
  33.      forget all defined parameters
  34.  
  35.    procedure ClearFields
  36.      forget all fields information (fields data and descriptions)
  37.  
  38.    procedure AddField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean);
  39.      Adds field description to list of fields. Fields must have unique names.
  40.  
  41.    procedure Open;overload;
  42.      Opens ADataSet and allocates fields.
  43.  
  44.    procedure Open(Fields:THArrayPointer);
  45.      Opens ADataSet with defined data and fields.
  46.       Fields - the array of pointers to fields (TAField) with exist data.
  47.       Fields.Count - will count of fileds in opened ADataSet.
  48.       Count records of data in all Fields must be equal and it will a RecordCount
  49.       for ADataSet
  50.  
  51.    procedure Close;
  52.       Closes ADataSet and forget all data.
  53.  
  54.    function ReadRecord(RecordNum:integer):boolean;
  55.      Reads records till record RecordNum will readed.
  56.      Return True if record was readed.
  57.  
  58.    procedure DeleteRecord(RecordNum:integer);
  59.      Deletes record from MEMORY!!
  60.  
  61.    procedure InsertRecord(RecordNum:integer);
  62.      Inserts empty record in MEMORY into place RecordNum
  63.  
  64.    procedure AppendRecord;
  65.      Append an empty record to end of all records (in record with number RecordCount)
  66.  
  67.  
  68.  Other functions :
  69.    function GetParamID(ParamName:string):integer;
  70.      Gets numeric index of Param (if ParamName doesn't exists return -1)
  71.  
  72.    function GetParamByName(ParamName:string):TAParam;
  73.      Gets parameter (class TAParam) by name. Raises exception if ParamName doesn't exists.
  74.  
  75.    function GetParamByIndex(Index:integer):TAParam;
  76.      Gets parameter (class TAParam) by index. Raises exception if Index out of bounds.
  77.  
  78.    function ParamExists(ParamName: string): boolean;
  79.       Return True if param with given name exists, otherwise return False (no exception generated!)
  80.  
  81.    function GetFieldByIndex(Index:integer):TAField;
  82.      Gets field (class TAField) by index. Raises exception if Index out of bounds.
  83.  
  84.    function GetFieldByName(FieldName:string):TAField;
  85.      Gets field (class TAField) by name. Raises exception if FieldName doesn't exists.
  86.  
  87.    function GetFieldID(FieldName:string):integer;
  88.      Gets index of field. If FieldName doesn't exists return -1.
  89.  
  90.    function GetParamCount:integer;
  91.      Returns count of parameters
  92.  
  93.    function GetFieldCount: integer;
  94.      Returns count of fields
  95.  
  96.    procedure AllocateFields;
  97.      Creates empty arrays to store field description data.
  98.  
  99.    procedure ForgetValues;
  100.      Forget all data in all fields. Don't free any arrays in fields - only cleares this arrays.
  101.  
  102.    procedure EmptyFields;
  103.      Forgets all data in all fields and frees all arrays in each field.
  104.      ┬√τ√Γασ≥ ε≈Φ±≥Ω≤ Σδ  ΩαµΣεπε ∩εδ . (Σσδασ≥±  Free Γ±σ∞ ∞α±±ΦΓα∞ Γ ΩαµΣε∞ ∩εδσ)
  105.  
  106.    procedure ClearFields;
  107.      Call EmptyFields and after forgets all descriptions of fields.
  108.      ╬≈Φ∙ασ≥ ε∩Φ±αφΦ  ∩εδσΘ Γ∞σ±≥σ ±ε Γ±σ∞Φ Σαφφ√∞Φ.
  109.  
  110.    property RecordCount:integer read FCount;
  111.      Gets count of records in memory
  112.  
  113.    function EOF:boolean;
  114.  
  115.    procedure Next;
  116.  
  117.    procedure First;
  118.  
  119.    procedure SaveToDBF(FileName:string);
  120.      Saves all data to DBF file with name FileName
  121.  
  122.    procedure CopyStructure(DataSet);
  123.    procedure CopyStructure(ADataSet);
  124.     Copies structure from another DataSet or ADataSet.
  125.     If ADataSet opened - closes one.
  126.  
  127.   Functions for work with BLOB,CLOB fields :
  128.    function WriteBlob(FieldNum,RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal;
  129.    function ReadBlob(FieldNum,RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal;
  130.    function WriteBlob(FieldName:string;RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal;
  131.    function ReadBlob(FieldName:string;RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal;
  132.  
  133.   Functions for work with streamed BLOB,CLOB fields
  134.    function ReadBlobToStream(FieldNum,RecordNum:integer;Stream:TStream):cardinal;
  135.    function WriteBlobFromStream(FieldNum,RecordNum:integer;Stream:TStream):cardinal;
  136.    function ReadBlobToStream(FieldName:string;RecordNum:integer;Stream:TStream):cardinal;
  137.    function WriteBlobFromStream(FieldName:string;RecordNum:integer;Stream:TStream):cardinal;
  138.     }
  139.  
  140.  
  141. interface
  142.  
  143. uses
  144.   Windows, SysUtils, Classes, DynamicArrays, Db, Math;
  145.  
  146. resourcestring
  147.  SUnknownFieldType = 'Unknown field type !';
  148.  SUnknownParamType = 'Unknown parameter type !';
  149.  SWrongParamDataType = '═σδⁿτ  ∩≡Φ±ΓεΦ≥ⁿ ∩α≡α∞σ≥≡≤ %s (%s) τφα≈σφΦσ ≥Φ∩α %s !';
  150.  SFieldTypeMismatch = 'Type mismatch for field ''%s'', expecting: %s actual: %s';
  151. // SWrongFieldDataType = '═σδⁿτ  ∩≡Φ±ΓεΦ≥ⁿ ∩εδ■ %s (%s) τφα≈σφΦσ ≥Φ∩α %s !';
  152.  SRecordNotLoaded = 'Record %d not loaded !';
  153.  SADataSetNotActive = 'ADataSet ''%s'' not active !';
  154.  
  155. type
  156.  TADataSet=class;
  157.  
  158.  TAFieldType = (ftoString, ftoSmallint, ftoInteger, ftoWord, ftoBoolean,
  159.                 ftoDouble, ftoCurrency, ftoDate, ftoTime, ftoDateTime, ftoBlob, ftoClob, ftoUnknown);
  160.  
  161.  TAParamType = (ptoInput,ptoOutput,ptoInputOutput);
  162.  
  163.  TAFieldTypeNames = array [TAFieldType] of string;
  164.  TAParamTypeNames = array [TAParamType] of string;
  165.  
  166.  TADataSetNotifyEvent = procedure(DataSet: TADataSet; Bookm : integer) of object;
  167.  
  168.  TSortType = (stASC,stDESC); // order of sorting (Ascending/Descending)
  169.  
  170.  TADatabase=class(TComponent)
  171.   private
  172.  
  173.   protected
  174.    FDataSets:THArrayPointer; // Γ±σ DataSet√ Ω Ωε≥ε≡√∞ ∩≡ΦΓ ταφ ²≥ε≥ ADatabase
  175.    procedure CloseLinkedDataSets;virtual; // σ±δΦ ταΩ≡√Γασ≥±  ²≥ε≥ Ωε∞∩εφσφ≥ ≥ε Σεδµφ√ ταΩ≡√≥ⁿ Γ±σ DataSet√ Ωε≥ε≡√σ σπε Φ±∩εδⁿτ≤■≥
  176.   public
  177.    constructor Create(AOwner:TComponent);override;
  178.    destructor Destroy; override;
  179.    procedure AddDataSet(DataSet:TDataSet);
  180.    procedure RemoveDataSet(DataSet:TDataSet);
  181.  end;
  182.  
  183.  TAParam = class
  184.   private
  185.    FName:string;
  186.    FFieldType:TAFieldType;
  187.    FParamType:TAParamType;
  188.   protected
  189.    procedure TestType(t:TAFieldType);
  190.  
  191.    function  GetIsNull:boolean; virtual; abstract;
  192.    procedure SetIsNull(Value:boolean); virtual; abstract;
  193.  
  194.    function  GetValue:variant; virtual; abstract;
  195.    procedure SetValue(Value:variant); virtual; abstract;
  196.    function  GetAsInteger:integer; virtual; abstract;
  197.    procedure SetAsInteger(Value:integer); virtual; abstract;
  198.    function  GetAsWord:Word; virtual; abstract;
  199.    procedure SetAsWord(Value:Word); virtual; abstract;
  200.    function  GetAsSmallInt:SmallInt; virtual; abstract;
  201.    procedure SetAsSmallInt(Value:SmallInt); virtual; abstract;
  202.    function  GetAsDate:integer; virtual; abstract;
  203.    procedure SetAsDate(Value:integer); virtual; abstract;
  204.    function  GetAsTime:integer; virtual; abstract;
  205.    procedure SetAsTime(Value:integer); virtual; abstract;
  206.    function  GetAsDateTime:int64; virtual; abstract;
  207.    procedure SetAsDateTime(Value:int64); virtual; abstract;
  208.    function  GetAsString:string; virtual; abstract;
  209.    procedure SetAsString(Value:string); virtual; abstract;
  210.    function  GetAsDouble:double; virtual; abstract;
  211.    procedure SetAsDouble(Value:double); virtual; abstract;
  212.    function  GetAsCurrency:currency; virtual; abstract;
  213.    procedure SetAsCurrency(Value:currency); virtual; abstract;
  214.    function  GetAsBoolean:Boolean; virtual; abstract;
  215.    procedure SetAsBoolean(Value:Boolean); virtual; abstract;
  216.   public
  217.    constructor Create(ParamName:string;ParamFieldType:TAFieldType;ParamParamType:TAParamType); virtual;
  218.    procedure Clear; virtual; abstract;
  219.    property Name:string read FName;
  220.    property IsNull:boolean read GetIsNull;
  221.    property AsInteger:integer read GetAsInteger write SetAsInteger;
  222.    property AsWord:Word read GetAsWord write SetAsWord;
  223.    property AsSmallInt:SmallInt read GetAsSmallInt write SetAsSmallInt;
  224.    property AsDate:integer read GetAsDate write SetAsDate;
  225.    property AsTime:integer read GetAsTime write SetAsTime;
  226.    property AsDateTime:int64 read GetAsDateTime write SetAsDateTime;
  227.    property AsString:string read GetAsString write SetAsString;
  228.    property AsDouble:double read GetAsDouble write SetAsDouble;
  229.    property AsCurrency:currency read GetAsCurrency write SetAsCurrency;
  230.    property AsBoolean:Boolean read GetAsBoolean write SetAsBoolean;
  231.    property FieldType:TAFieldType read FFieldType;
  232.    property ParamType:TAParamType read FParamType;
  233.    property Value:variant read GetValue write SetValue;
  234.   end;
  235.  
  236.   TAField = class
  237.   private
  238.    FRequired:boolean;
  239.    FFieldType:TAFieldType;
  240.    FFieldSize:word;
  241.    FName:string;
  242.  
  243.   protected
  244.    FParent:TADataSet;
  245.    Values:THArray;            // the Values of field
  246.    ValuesSize:THArrayInteger; // sizes in bytes of each field value for datatypes BLOB and CLOB
  247.    ValuesNull:THArrayBoolean; // stores True - if field has value, False - if field has NULL value
  248.    procedure Clear; virtual;
  249.    procedure Allocate; overload; virtual;
  250.  
  251.    function RecordToInternal(RecordNum:integer):integer;
  252.  
  253.    procedure DeleteRecord(RecordNum:integer);
  254.    procedure InsertRecord(RecordNum:integer);
  255.    procedure TestType(t:TAFieldType);
  256.    function  GetIsNull(RecordNum:integer):boolean;
  257.    procedure SetIsNull(RecordNum:integer;Value:boolean);
  258.    function  GetAsString(RecordNum:integer):string;
  259.    procedure SetAsString(RecordNum:integer;Value:string);
  260.    function  GetAsInteger(RecordNum:integer):Integer;
  261.    procedure SetAsInteger(RecordNum:integer;Value:Integer);
  262.    function  GetAsBoolean(RecordNum:integer):Boolean;
  263.    procedure SetAsBoolean(RecordNum:integer;Value:Boolean);
  264.    function  GetAsDate(RecordNum:integer):integer;
  265.    procedure SetAsDate(RecordNum:integer;Value:integer);
  266.    function  GetAsTime(RecordNum:integer):integer;
  267.    procedure SetAsTime(RecordNum:integer;Value:integer);
  268.    function  GetAsDateTime(RecordNum:integer):int64;
  269.    procedure SetAsDateTime(RecordNum:integer;Value:int64);
  270.    function  GetAsDouble(RecordNum:integer):Double;
  271.    procedure SetAsDouble(RecordNum:integer;Value:Double);
  272.    function  GetAsCurrency(RecordNum:integer):Currency;
  273.    procedure SetAsCurrency(RecordNum:integer;Value:Currency);
  274.    function  GetAsSmallInt(RecordNum:integer):SmallInt;
  275.    procedure SetAsSmallInt(RecordNum:integer;Value:SmallInt);
  276.    function  GetAsWord(RecordNum:integer):Word;
  277.    procedure SetAsWord(RecordNum:integer;Value:Word);
  278.    function  GetValue(RecordNum:integer):variant;
  279.    procedure SetValue(RecordNum:integer;Value:variant);
  280.   public
  281.    Visible:boolean;
  282.    ReadOnly:boolean;
  283.  
  284.    constructor Create(Parent:TADataSet;FieldName:string;RFieldType:TAFieldType;FieldSize:word;Required:boolean);virtual;
  285.    destructor Destroy; override;
  286.    procedure Allocate(HArray:THArray;HArrayNull:THArrayBoolean;HArraySize:THArrayInteger=nil); overload; virtual;
  287.  
  288.    procedure ClearBlob(RecordNum:integer); virtual;
  289.    function WriteBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal; virtual;
  290.    function ReadBlob(RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal; virtual;
  291.    function ReadBlobToStream(RecordNum:integer;Stream:TStream):cardinal; virtual;
  292.    function WriteBlobFromStream(RecordNum:integer;Stream:TStream):cardinal; virtual;
  293.    function GetLobLength(RecordNum:integer):integer;virtual;
  294.  
  295.    property Name:string read FName;
  296.    property FieldType:TAFieldType read FFieldType;
  297.    property FieldSize:word read FFieldSize;
  298.    property Required:boolean read FRequired;
  299.    property IsNull[RecordNum:integer]:boolean read GetIsNull write SetIsNull;
  300.    property AsString[RecordNum:integer]:string read GetAsString write SetAsString;
  301.    property AsInteger[RecordNum:integer]:integer read GetAsInteger write SetAsInteger;
  302.    property AsDate[RecordNum:integer]:integer read GetAsDate write SetAsDate;
  303.    property AsTime[RecordNum:integer]:integer read GetAsTime write SetAsTime;
  304.    property AsDateTime[RecordNum:integer]:int64 read GetAsDateTime write SetAsDateTime;
  305.    property AsDouble[RecordNum:integer]:double read GetAsDouble write SetAsDouble;
  306.    property AsCurrency[RecordNum:integer]:currency read GetAsCurrency write SetAsCurrency;
  307.    property AsBoolean[RecordNum:integer]:Boolean read GetAsBoolean write SetAsBoolean;
  308.    property AsWord[RecordNum:integer]:Word read GetAsWord write SetAsWord;
  309.    property AsSmallInt[RecordNum:integer]:SmallInt read GetAsSmallInt write SetAsSmallInt;
  310.    property Value[RecordNum:integer]:variant read GetValue write SetValue;
  311.    property HArrayValues:THArray read Values;
  312.    property HArrayValuesNull:THArrayBoolean read ValuesNull;
  313.    property HArrayValuesSize:THArrayInteger read ValuesSize;
  314.   end;
  315.  
  316.  TADataSet = class(TComponent)
  317.   private
  318.    FActive:boolean;
  319.    FStreamedActive:boolean;
  320.    FCurrentRec:integer;
  321.    FAfterInsert  : TADataSetNotifyEvent;
  322.    FBeforeDelete : TADataSetNotifyEvent;
  323.  
  324.    FUni:boolean;
  325.    FFields:THArrayPointer;
  326.    FSortIndex:THArrayInteger; // index array for sort without moving records
  327.  
  328.    procedure SetActive(Value:boolean);
  329.  
  330.    procedure SetAfterInsert(proc : TADataSetNotifyEvent);
  331.    procedure SetBeforeDelete(proc : TADataSetNotifyEvent);
  332.  
  333.    function GetFieldByIndex(Index:integer):TAField;
  334.    function GetFieldByName(FieldName:string):TAField;
  335.    function GetFieldID(FieldName:string):integer;
  336.    function GetParamByIndex(Index:integer):TAParam;
  337.    function GetParamCount:integer;
  338.    function GetFieldCount: integer;
  339.    function GetSorted:boolean;
  340.  
  341.   protected
  342.    FFetched:boolean;
  343.    FBeginRecord:integer;
  344.    FParams:THArrayPointer; //Φ∞ τΣσ±ⁿ φσ ∞σ±≥ε φαΣε Γ private
  345.    FCount:integer;
  346.    procedure Loaded; override;
  347.    procedure EmptyFields;
  348.    procedure AllocateFields;
  349.    function  GetParamID(ParamName:string):integer;
  350.    function  GetParamByName(ParamName:string):TAParam;
  351.    procedure ForgetValues;
  352.    procedure Sort(FieldIndex:integer;SortType:TSortType);overload;
  353.    procedure Sort(FieldName:string;SortType:TSortType);overload;
  354.    function CreateAField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean):TAField;virtual;
  355.  
  356.   public
  357.      // abstract methods
  358.    procedure Fetch;virtual;abstract;
  359.    procedure Prepare; virtual;abstract;
  360.    procedure UnPrepare; virtual;abstract;
  361.    procedure Open; overload; virtual;
  362.    procedure Open(Fields:THArrayPointer); overload; virtual;
  363.    procedure Close; virtual;
  364.    function ReadRecord(RecordNum:integer):boolean; virtual;
  365.    procedure DeleteRecord(RecordNum:integer); virtual;
  366.    procedure InsertRecord(RecordNum:integer); virtual;
  367.    procedure AppendRecord; virtual;
  368.  
  369.    procedure ClearFields; virtual;
  370.    procedure ClearParams;virtual;
  371.    procedure AddParam(ParamName:string;FieldType:TAFieldType;ParamType:TAParamType);virtual;abstract;
  372.    procedure AddField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean); virtual;
  373.    procedure CopyStructure(DataSet:TDataSet);overload;
  374.    procedure CopyStructure(ADataSet:TADataSet);overload;
  375.  
  376.    procedure ReOpen;
  377.    procedure ReadAll;
  378.    function EOF:boolean;
  379.    procedure Next;
  380.    procedure First;
  381.  
  382.  
  383.    procedure SaveToDBF(FileName:string);
  384.  
  385.    function WriteBlob(FieldNum,RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal;overload;
  386.    function ReadBlob(FieldNum,RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal;overload;
  387.    function ReadBlobToStream(FieldNum,RecordNum:integer;Stream:TStream):cardinal;overload;
  388.    function WriteBlobFromStream(FieldNum,RecordNum:integer;Stream:TStream):cardinal;overload;
  389.  
  390.    function WriteBlob(FieldName:string;RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal; overload;
  391.    function ReadBlob(FieldName:string;RecordNum:integer;Offset:integer;Buffer:pointer;Size:integer):cardinal; overload;
  392.    function ReadBlobToStream(FieldName:string;RecordNum:integer;Stream:TStream):cardinal; overload;
  393.    function WriteBlobFromStream(FieldName:string;RecordNum:integer;Stream:TStream):cardinal;overload;
  394.  
  395.    function ParamExists(ParamName: string): boolean;
  396.  
  397.    constructor Create(AOwner:TComponent); override;
  398.    destructor Destroy; override;
  399.  
  400.    property ParamCount:integer read GetParamCount;
  401.    property ParamByName[Name:string]:TAParam read GetParamByName;
  402.    property ParamByIndex[Index:integer]:TAParam read GetParamByIndex;
  403.    property FieldCount:integer read GetFieldCount;
  404.    property FieldByName[Index:string]:TAField read GetFieldByName;
  405.    property FieldByIndex[Index:integer]:TAField read GetFieldByIndex;
  406.  
  407.  
  408.    property RecordCount:integer read FCount;
  409.    property FieldID[FieldName:string]:integer read GetFieldID;
  410.    property Sorted:boolean read GetSorted;
  411.  
  412.    property CurrentRecord:integer read FCurrentRec;
  413.    property aaAfterInsert : TADataSetNotifyEvent read FAfterInsert write SetAfterInsert;
  414.    property aaBeforeDelete : TADataSetNotifyEvent read FBeforeDelete write SetBeforeDelete;
  415.   published
  416.    property Active:boolean read FActive write SetActive;
  417.    property Fetched:boolean read FFetched;
  418.    property UniDirectional:boolean read FUni write FUni;
  419.   end;
  420.  
  421. function TypeAToDelphi(fta:TAFieldType):TFieldType;
  422. function TypeDelphiToA(ft:TFieldType):TAFieldType;
  423.  
  424. function ParamTypeAToDelphi(pto:TAParamType):TParamType;
  425. function ParamTypeDelphiToA(pt:TParamType):TAParamType;
  426.  
  427. procedure ADatabaseError(const Message: string; Component: TComponent = nil);
  428.  
  429. var
  430.  AParamTypeNames : TAParamTypeNames=('ptoInput','ptoOutput','ptoInputOutput');
  431.  AFieldTypeNames : TAFieldTypeNames=('ftoString','ftoSmallint','ftoInteger','ftoWord','ftoBoolean','ftoDouble',
  432.                                      'ftoCurrency','ftoDate','ftoTime','ftoDateTime','ftoBlob','ftoClob','ftoUnknown');
  433.  
  434. implementation
  435.  
  436. uses GoodDate, DataSetQuery, DBConsts;
  437.  
  438. procedure ADatabaseError(const Message: string; Component: TComponent = nil);
  439. begin
  440.   if Assigned(Component) and (Component.Name <> '')
  441.    then raise Exception.Create(Format('%s: %s', [Component.Name, Message]))
  442.    else raise Exception.Create(Message);
  443. end;
  444.  
  445. function MakeStr(c:char;l:integer):string;
  446. var i:integer;
  447. begin
  448.  Result:='';
  449.  for i:=0 to l-1 do Result:=Result+c;
  450. end;
  451.  
  452. function RightStr(s:string;l:integer):string;
  453. var i:integer;
  454. begin
  455.  Result:=s;
  456.  for i:=length(s) to l-1 do Result:=Result+' ';
  457. end;
  458.  
  459. function StrToOem(const AnsiStr: string): string;
  460. begin
  461.   SetLength(Result, Length(AnsiStr));
  462.   if Length(Result) > 0 then
  463.    CharToOemBuff(PChar(AnsiStr), PChar(Result), Length(Result));
  464. end;
  465.  
  466. function TypeAToDelphi(fta:TAFieldType):TFieldType;
  467. begin
  468.   case fta of
  469.    ftoString:   Result:=ftString;
  470.    ftoBoolean:  Result:=ftBoolean;
  471.    ftoDouble:   Result:=ftFloat;
  472.    ftoCurrency: Result:=ftCurrency;
  473.    ftoDate:     Result:=ftDate;
  474.    ftoTime:     Result:=ftTime;
  475.    ftoDateTime: Result:=ftdateTime;
  476.    ftoInteger:  Result:=ftInteger;
  477.    ftoSmallInt: Result:=ftSmallInt;
  478.    ftoWord:     Result:=ftWord;
  479.    ftoBlob:     Result:=ftBlob;
  480.    ftoClob:     Result:=ftMemo;
  481.   else
  482.    raise Exception.Create(SUnknownFieldType);
  483.   end;
  484. end;
  485.  
  486. function TypeDelphiToA(ft:TFieldType):TAFieldType;
  487. begin
  488.   case ft of
  489.    ftString:   Result:=ftoString;
  490.    ftBoolean:  Result:=ftoBoolean;
  491.    ftFloat:    Result:=ftoDouble;
  492.    ftCurrency: Result:=ftoCurrency;
  493.    ftDate:     Result:=ftoDate;
  494.    ftTime:     Result:=ftoTime;
  495.    ftDateTime: Result:=ftodateTime;
  496.    ftInteger:  Result:=ftoInteger;
  497.    ftSmallInt: Result:=ftoSmallInt;
  498.    ftWord:     Result:=ftoWord;
  499.    ftBlob:     Result:=ftoBlob;
  500.    ftMemo:     Result:=ftoClob;
  501.   else
  502.    raise Exception.Create(SUnknownFieldType);
  503.   end;
  504. end;
  505.  
  506. function ParamTypeAToDelphi(pto:TAParamType):TParamType;
  507. begin
  508.  case pto of
  509.   ptoInput:      Result:=ptInput;
  510.   ptoOutput:     Result:=ptOutput;
  511.   ptoInputOutput:Result:=ptInputOutput;
  512.  else
  513.   raise Exception.Create(SUnknownParamType);
  514.  end;
  515. end;
  516.  
  517. function ParamTypeDelphiToA(pt:TParamType):TAParamType;
  518. begin
  519.  case pt of
  520.   ptInput:       Result:=ptoInput;
  521.   ptOutput:      Result:=ptoOutput;
  522.   ptInputOutput,
  523.   ptUnknown,
  524.   ptResult:      Result:=ptoInputOutput;
  525.  else
  526.   raise Exception.Create(SUnknownFieldType);
  527.  end;
  528. end;
  529.  
  530. { TAParam }
  531.  
  532. constructor TAParam.Create(ParamName: string; ParamFieldType: TAFieldType;
  533.   ParamParamType: TAParamType);
  534. begin
  535.  inherited Create;
  536.  FName:=ParamName;
  537.  FFieldType:=ParamFieldType;
  538.  FParamType:=ParamParamType;
  539. end;
  540.  
  541. procedure TAParam.TestType(t: TAFieldType);
  542. begin
  543.  if t<>FieldType then raise Exception.Create(Format(SWrongParamDataType,[FName,AFieldTypeNames[FFieldType],AFieldTypeNames[t]]));
  544. end;
  545.  
  546. { TAField }
  547.  
  548. procedure TAField.Allocate;
  549. begin
  550.  case FieldType of
  551.   ftoString:   Values:=THArrayStringFix.CreateSize(FieldSize);
  552.   ftoBoolean:  Values:=THArrayBoolean.Create;
  553.   ftoDouble:   Values:=THArrayDouble.Create;
  554.   ftoCurrency: Values:=THArrayCurrency.Create;
  555.   ftoDate:     Values:=THArrayInteger.Create;
  556.   ftoTime:     Values:=THArrayInteger.Create;
  557.   ftoDateTime: Values:=THArrayInt64.Create;
  558.   ftoInteger:  Values:=THArrayInteger.Create;
  559.   ftoSmallInt: Values:=THArraySmallInt.Create;
  560.   ftoWord:     Values:=THArrayWord.Create;
  561.   ftoBlob,
  562.   ftoClob:     begin Values:=THArrayPointer.Create;ValuesSize:=THArrayInteger.Create; end;
  563.  else
  564.   raise Exception.Create(SUnknownFieldType);
  565.  end;
  566.  if (not FRequired)
  567.   then ValuesNull:=THArrayBoolean.Create
  568.   else ValuesNull:=nil;
  569. end;
  570.  
  571. procedure TAField.Allocate(HArray:THArray;HArrayNull:THArrayBoolean;HArraySize:THArrayInteger=nil);
  572. begin
  573.  Values:=HArray;
  574.  ValuesNull:=HArrayNull;
  575.  ValuesSize:=HArraySize;
  576.  FRequired:=(HArrayNull=nil);
  577. end;
  578.  
  579. procedure TAField.Clear;
  580. begin
  581.  if Assigned(Values) then begin Values.Free; Values:=nil; end;
  582.  if Assigned(ValuesSize) then begin ValuesSize.Free; ValuesSize:=nil; end;
  583.  if Assigned(ValuesNull) then begin ValuesNull.Free; ValuesNull:=nil; end;
  584. end;
  585.  
  586. constructor TAField.Create(Parent: TADataSet; FieldName: string;
  587.   RFieldType: TAFieldType; FieldSize: word; Required: boolean);
  588. begin
  589.  inherited Create;
  590.  FParent:=Parent;
  591.  FName:=FieldName;
  592.  FFieldType:=RFieldType;
  593.  FFieldSize:=FieldSize;
  594.  FRequired:=Required;
  595.  if RFieldType in [ftoBlob,ftoClob] then FFieldSize:=0; // Σδ  BLOBεΓ ≡ατ∞σ≡ ⌡≡αφΦ≥±  Γ ∞α±±ΦΓσ ValuesSize
  596.  
  597.  Values:=nil;
  598.  ValuesNull:=nil;
  599.  ValuesSize:=nil;
  600.  
  601.  Visible:=True;
  602.  ReadOnly:=False;
  603. end;
  604.  
  605. procedure TAField.DeleteRecord(RecordNum: integer);
  606. begin
  607.  Values.Delete(RecordToInternal(RecordNum));
  608.  if Assigned(ValuesSize) then ValuesSize.Delete(RecordToInternal(RecordNum));
  609.  if Assigned(ValuesNull) then ValuesNull.Delete((RecordNum));
  610. end;
  611.  
  612. destructor TAField.Destroy;
  613. begin
  614.  Clear;
  615.  inherited Destroy;
  616. end;
  617.  
  618. function TAField.GetAsBoolean(RecordNum: integer): Boolean;
  619. begin
  620.  TestType(ftoBoolean);
  621.  if IsNull[RecordNum]
  622.   then Result:=False
  623.   else Result:=THArrayBoolean(Values)[RecordToInternal(RecordNum)];
  624. end;
  625.  
  626. function TAField.GetAsCurrency(RecordNum: integer): Currency;
  627. begin
  628.  TestType(ftoCurrency);
  629.  if IsNull[RecordNum]
  630.   then Result:=0
  631.   else Result:=THArrayCurrency(Values)[RecordToInternal(RecordNum)];
  632. end;
  633.  
  634. function TAField.GetAsDate(RecordNum: integer): integer;
  635. begin
  636.  TestType(ftoDate);
  637.  if IsNull[RecordNum]
  638.   then Result:=0
  639.   else Result:=THArrayInteger(Values)[RecordToInternal(RecordNum)];
  640. end;
  641.  
  642. function TAField.GetAsDateTime(RecordNum: integer): int64;
  643. begin
  644.  TestType(ftoDateTime);
  645.  if IsNull[RecordNum]
  646.   then Result:=0
  647.   else Result:=THArrayInt64(Values)[RecordToInternal(RecordNum)];
  648. end;
  649.  
  650. function TAField.GetAsDouble(RecordNum: integer): Double;
  651. begin
  652.  TestType(ftoDouble);
  653.  if IsNull[RecordNum]
  654.   then Result:=0
  655.   else Result:=THArrayDouble(Values)[RecordToInternal(RecordNum)];
  656. end;
  657.  
  658. function TAField.GetAsInteger(RecordNum: integer): Integer;
  659. begin
  660.  TestType(ftoInteger);
  661.  if IsNull[RecordNum]
  662.   then Result:=0
  663.   else Result:=THArrayInteger(Values)[RecordToInternal(RecordNum)];
  664. end;
  665.  
  666. function TAField.GetAsSmallInt(RecordNum: integer): SmallInt;
  667. begin
  668.  TestType(ftoSmallInt);
  669.  if IsNull[RecordNum]
  670.   then Result:=0
  671.   else Result:=THArraySmallInt(Values)[RecordToInternal(RecordNum)];
  672. end;
  673.  
  674. function TAField.GetAsString(RecordNum: integer): string;
  675. begin
  676.  TestType(ftoString);
  677.  if IsNull[RecordNum]
  678.   then Result:=''
  679.   else Result:=THArrayStringFix(Values)[RecordToInternal(RecordNum)];
  680. end;
  681.  
  682. function TAField.GetAsTime(RecordNum: integer): integer;
  683. begin
  684.  TestType(ftoTime);
  685.  if IsNull[RecordNum]
  686.   then Result:=0
  687.   else Result:=THArrayInteger(Values)[RecordToInternal(RecordNum)];
  688. end;
  689.  
  690. function TAField.GetValue(RecordNum: integer): variant;
  691. begin
  692.  Result:=Null;
  693.  if IsNull[RecordNum] then begin
  694.   exit;
  695.  end;
  696.  case FieldType of
  697.   ftoString: Result:=AsString[RecordNum];
  698.   ftoSmallint: Result:=AsSmallInt[RecordNum];
  699.   ftoInteger: Result:=AsInteger[RecordNum];
  700.   ftoWord: Result:=AsWord[RecordNum];
  701.   ftoBoolean: Result:=AsBoolean[RecordNum];
  702.   ftoDouble: Result:=AsDouble[RecordNum];
  703.   ftoCurrency: Result:=AsCurrency[RecordNum];
  704.   ftoDate: Result:=GoodDateToDateTime(AsDate[RecordNum]);
  705.   ftoTime: Result:=GoodTimeToDateTime(AsTime[RecordNum]);
  706.   ftoDateTime: Result:=GoodDateTimeToDateTime(AsDateTime[RecordNum]);
  707.   else raise Exception.Create(SUnknownFieldType);
  708.  end;
  709. end;
  710.  
  711. function TAField.GetAsWord(RecordNum: integer): Word;
  712. begin
  713.  TestType(ftoWord);
  714.  if IsNull[RecordNum]
  715.   then Result:=0
  716.   else Result:=THArrayWord(Values)[RecordToInternal(RecordNum)];
  717. end;
  718.  
  719. function TAField.GetIsNull(RecordNum: integer): boolean;
  720. begin
  721.  if ValuesNull=nil
  722.   then Result:=False
  723.   else Result:=not ValuesNull[RecordToInternal(RecordNum)];
  724. end;
  725.  
  726. procedure TAField.InsertRecord(RecordNum: integer);
  727. begin
  728.  if Assigned(Values) then Values.Insert(RecordNum,nil);
  729.  if Assigned(ValuesSize) then begin ValuesSize.Insert(RecordNum,nil); ValuesSize[RecordNum]:=0; end;
  730.  if Assigned(ValuesNull) then begin ValuesNull.Insert(RecordNum,nil); ValuesNull[RecordNum]:=False; end;
  731. end;
  732.  
  733. function TAField.RecordToInternal(RecordNum: integer): integer;
  734. begin
  735.  if (RecordNum<FParent.FBeginRecord) or (RecordNum>=FParent.RecordCount)
  736.   then raise Exception.Create(Format(SRecordNotLoaded,[RecordNum]));
  737.  Result:=RecordNum-FParent.FBeginRecord;
  738. end;
  739.  
  740. procedure TAField.SetAsBoolean(RecordNum: integer; Value: Boolean);
  741. begin
  742.  TestType(ftoBoolean);
  743.  IsNull[RecordNum]:=False;
  744.  THArrayBoolean(Values)[RecordToInternal(RecordNum)]:=Value;
  745. end;
  746.  
  747. procedure TAField.SetAsCurrency(RecordNum: integer; Value: Currency);
  748. begin
  749.  TestType(ftoCurrency);
  750.  IsNull[RecordNum]:=False;
  751.  THArrayCurrency(Values)[RecordToInternal(RecordNum)]:=Value;
  752. end;
  753.  
  754. procedure TAField.SetAsDate(RecordNum, Value: integer);
  755. begin
  756.  TestType(ftoDate);
  757.  IsNull[RecordNum]:=False;
  758.  THArrayInteger(Values)[RecordToInternal(RecordNum)]:=Value;
  759. end;
  760.  
  761. procedure TAField.SetAsDateTime(RecordNum: integer; Value: int64);
  762. begin
  763.  TestType(ftoDateTime);
  764.  IsNull[RecordNum]:=False;
  765.  THArrayInt64(Values)[RecordToInternal(RecordNum)]:=Value;
  766. end;
  767.  
  768. procedure TAField.SetAsDouble(RecordNum: integer; Value: Double);
  769. begin
  770.  TestType(ftoDouble);
  771.  IsNull[RecordNum]:=False;
  772.  THArrayDouble(Values)[RecordToInternal(RecordNum)]:=Value;
  773. end;
  774.  
  775. procedure TAField.SetAsInteger(RecordNum, Value: Integer);
  776. begin
  777.  TestType(ftoInteger);
  778.  IsNull[RecordNum]:=False;
  779.  THArrayInteger(Values)[RecordToInternal(RecordNum)]:=Value;
  780. end;
  781.  
  782. procedure TAField.SetAsSmallInt(RecordNum: integer; Value: SmallInt);
  783. begin
  784.  TestType(ftoSmallInt);
  785.  IsNull[RecordNum]:=False;
  786.  THArraySmallInt(Values)[RecordToInternal(RecordNum)]:=Value;
  787. end;
  788.  
  789. procedure TAField.SetAsString(RecordNum: integer; Value: string);
  790. begin
  791.  TestType(ftoString);
  792.  IsNull[RecordNum]:=False;
  793.  THArrayStringFix(Values)[RecordToInternal(RecordNum)]:=Value;
  794. end;
  795.  
  796. procedure TAField.SetAsTime(RecordNum, Value: integer);
  797. begin
  798.  TestType(ftoTime);
  799.  IsNull[RecordNum]:=False;
  800.  THArrayInteger(Values)[RecordToInternal(RecordNum)]:=Value;
  801. end;
  802.  
  803. procedure TAField.SetAsWord(RecordNum: integer; Value: Word);
  804. begin
  805.  TestType(ftoWord);
  806.  IsNull[RecordNum]:=False;
  807.  THArrayWord(Values)[RecordToInternal(RecordNum)]:=Value;
  808. end;
  809.  
  810. procedure TAField.SetIsNull(RecordNum: integer; Value: boolean);
  811. begin
  812.  if ValuesNull=nil then exit;
  813.  ValuesNull[RecordToInternal(RecordNum)]:=not Value;
  814. end;
  815.  
  816. procedure TAField.SetValue(RecordNum: integer; Value: variant);
  817. begin
  818.  if Value=Null then begin
  819.   IsNull[RecordNum]:=True;
  820.   exit;
  821.  end;
  822.  case FieldType of
  823.   ftoString: AsString[RecordNum]:=Value;
  824.   ftoSmallint: AsSmallInt[RecordNum]:=Value;
  825.   ftoInteger: AsInteger[RecordNum]:=Value;
  826.   ftoWord: AsWord[RecordNum]:=Value;
  827.   ftoBoolean: AsBoolean[RecordNum]:=Value;
  828.   ftoDouble: AsDouble[RecordNum]:=Value;
  829.   ftoCurrency: AsCurrency[RecordNum]:=Value;
  830.   ftoDate: AsDate[RecordNum]:=DateTimeToGoodDate(Value);
  831.   ftoTime: AsTime[RecordNum]:=DateTimeToGoodTime(Value);
  832.   ftoDateTime: AsDateTime[RecordNum]:=DateTimeToGoodDateTime(Value);
  833.   ftoBlob,ftoClob : raise Exception.Create('─δ  τα∩Φ±Φ Γ ∩εδ  BLOB Φ±∩εδⁿτ≤Θ≥σ ⌠-÷Φ■ WriteBlob !!! ');
  834.   else raise Exception.Create(SUnknownFieldType);
  835.  end;
  836. end;
  837.  
  838. procedure TAField.TestType(t: TAFieldType);
  839. begin
  840.  if t<>FFieldType then raise Exception.Create(Format(SFieldTypeMismatch,[FName,AFieldTypeNames[FFieldType],AFieldTypeNames[t]]));
  841. end;
  842.  
  843. procedure TAField.ClearBlob(RecordNum: integer);
  844. begin
  845.  TestType(ftoBlob);
  846.  FreeMem(THArrayPointer(Values)[RecordNum]);
  847.  THArrayPointer(Values)[RecordNum]:=nil;
  848.  ValuesNull[RecordNum]:=False; // flag that Bloba is NULL
  849.  ValuesSize[RecordNum]:=0      // the length set to 0
  850. end;
  851.  
  852. function TAField.ReadBlob(RecordNum, Offset: integer; Buffer: pointer; Size: integer): cardinal;
  853. var pc:PChar;
  854.     RealSize,pi,c:integer;
  855. begin
  856.  TestType(ftoBlob);
  857.  Result:=0;
  858.  if IsNull[RecordNum] then exit; // BLOB is empty
  859.  pi:=cardinal(THArrayPointer(Values)[RecordNum]); // pointer to memory where BLOB field data stores
  860.  if pi=0 then exit; // BLOB is empty
  861.  RealSize:=ValuesSize[RecordNum];
  862.  if Offset>=RealSize then exit;  // the reques offset larger than length of BLOB field
  863.  
  864.  pc:=PChar(pi+offset);
  865.  
  866.  c:=min(RealSize-offset,Size);
  867.  memcpy(pc,Buffer,c);
  868.  Result:=c;
  869. end;
  870.  
  871. function TAField.WriteBlob(RecordNum, Offset: integer; Buffer: pointer; Size: integer): cardinal;
  872. // if offset>0 then alloc memory offset+Size bytes and
  873. // with offset "offset" writing data from buffer
  874. // σ±δΦ offset>0 ≥επΣα τα⌡Γα≥√Γασ∞ ∩α∞ ≥Φ (offset+Size) ßαΘ≥ Φ
  875. // ±ε ±∞σ∙σφΦ  offset ∩σ≡σ∩Φ±√Γασ∞ Σαφφ√σ Φτ ß≤⌠σ≡α Γ ²≥≤ ∩α∞ ≥ⁿ
  876. var pc:PChar;
  877.     pi:integer;
  878. begin
  879.  TestType(ftoBlob);
  880.  Result:=Size;
  881.  
  882. // if(Offset=0)or(Size=0) then ClearBlob(RecordNum);
  883.  
  884.  if Size>0 then begin // have we any info?
  885.   pc:=THArrayPointer(Values)[RecordNum];
  886.   ReallocMem(pc,Offset+Size);
  887.   THArrayPointer(Values)[RecordNum]:=pc;
  888.   pi:=integer(pc);
  889.   pc:=PChar(pi+offset);
  890.   memcpy(Buffer,pc,Size);
  891.   IsNull[RecordNum]:=False; // flag that BLOB field is not empty
  892.  end;
  893.  ValuesSize[RecordNum]:=Offset+Size;
  894. end;
  895.  
  896. function TAField.ReadBlobToStream(RecordNum: integer;Stream: TStream): cardinal;
  897. var buf:array[0..16383] of byte;
  898.     sz:cardinal;
  899.     Offset:integer;
  900. begin
  901.  Result:=0; Offset:=0;
  902.  repeat
  903.   sz:=ReadBlob(RecordNum,Offset,@buf,sizeof(buf));
  904.   Result:=Result+sz;
  905.   inc(Offset,sz);
  906.   Stream.Write(buf,sz);
  907.  until sz<>sizeof(buf);
  908. end;
  909.  
  910. function TAField.WriteBlobFromStream(RecordNum: integer;Stream: TStream): cardinal;
  911. var buf:array[0..16383] of byte;
  912.     sz:integer;
  913.     Offset:integer;
  914. begin
  915.  ClearBlob(RecordNum);
  916.  Result:=0; Offset:=0;
  917.  Stream.Seek(0,soFromBeginning);
  918.  if Stream.Size>0 then begin
  919.   repeat
  920.    sz:=Stream.Read(buf,sizeof(buf));
  921.    Result:=Result+WriteBlob(RecordNum,Offset,@buf,sz);
  922.    inc(Offset,sz);
  923.   until Offset=Stream.Size;
  924.  end;
  925. end;
  926.  
  927. function TAField.GetLobLength(RecordNum: integer): integer;
  928. begin
  929. // if (RecordNum<0)or(RecordNum>=ValuesSize.Count) then raise Exception.Create('The Record number '+IntToStr(RecordNum)+' is more than RecordCount='+IntToStr(ValuesSize.Count)+'!');
  930.  Result:=ValuesSize[RecordToInternal(RecordNum)];
  931. end;
  932.  
  933. { TADataSet }
  934.  
  935. procedure TADataSet.AllocateFields;
  936. var i:integer;
  937. begin
  938.  for i:=0 to FFields.Count-1 do TAField(FFields[i]).Allocate;
  939. end;
  940.  
  941. procedure TADataSet.AppendRecord;
  942. begin
  943.  InsertRecord(RecordCount);
  944. end;
  945.  
  946. procedure TADataSet.ClearFields;
  947. var i:integer;
  948. begin
  949.  for i:=0 to FFields.Count-1 do TAField(FFields[i]).Free;
  950.  FFields.Clear;
  951. end;
  952.  
  953. procedure TADataSet.ClearParams;
  954. var i:integer;
  955. begin
  956.  for i:=0 to FParams.Count-1 do TAParam(FParams[i]).Free;
  957.  FParams.Clear;
  958. end;
  959.  
  960. procedure TADataSet.Close;
  961. begin
  962.  EmptyFields;
  963.  FActive:=False;
  964.  FCount:=0;
  965. end;
  966.  
  967. constructor TADataSet.Create(AOwner: TComponent);
  968. begin
  969.  inherited Create(AOwner);
  970.  FFields:=THArrayPointer.Create;
  971.  FParams:=THArrayPointer.Create;
  972.  FSortIndex:=nil;
  973.  FBeginRecord:=0;
  974.  FCurrentRec:=0;
  975.  FCount:=0;
  976.  FActive:=False;
  977. end;
  978.  
  979. destructor TADataSet.Destroy;
  980. begin
  981.  if FActive then Close;
  982.  ClearFields;
  983.  FFields.Free;
  984.  ClearParams;
  985.  FParams.Free;
  986.  inherited Destroy;
  987. end;
  988.  
  989. procedure TADataSet.AddField(FieldName: string; FieldType: TAFieldType;FieldSize: word; Required: boolean);
  990. var F:TAField;
  991.     i:integer;
  992. begin
  993.  if FieldName = '' then ADatabaseError(SFieldNameMissing, self);
  994.  for i:=0 to FFields.Count-1 do
  995.   if AnsiCompareText(TAField(FFields[i]).Name,FieldName)=0 then ADatabaseError(Format(SDuplicateFieldName,[FieldName,self.name]));
  996.  
  997.  F:=CreateAField(FieldName,FieldType,FieldSize,Required);
  998.  FFields.AddValue(F);
  999. end;
  1000.  
  1001. function TADataSet.CreateAField(FieldName:string;FieldType:TAFieldType;FieldSize:word;Required:boolean): TAField;
  1002. begin
  1003.  Result:=TAField.Create(self,FieldName,FieldType,FieldSize,Required);
  1004. end;
  1005.  
  1006.  
  1007. {procedure TADataSet.AddParam(ParamName:string;FieldType:TAFieldType;ParamType:TAParamType);
  1008. var i:integer;
  1009. begin
  1010.  if ParamName = '' then ADatabaseError('Paramter name missing!', self);
  1011.  for i:=0 to FParams.Count-1 do
  1012.   if AnsiCompareText(TAParam(FParams[i]).Name,ParamName)=0 then ADatabaseError(Format(SDuplicateName,[ParamName,self.name]));
  1013.  
  1014.  FParams.AddValue(TAParam.Create(ParamName,FieldType,ParamType));
  1015. end;}
  1016.  
  1017. procedure TADataSet.DeleteRecord(RecordNum: integer);
  1018. var i:integer;
  1019. begin
  1020.  if not FActive then raise Exception.Create(Format(SADataSetNotActive,[Name]));
  1021.  if (RecordNum<0)or(RecordNum>=FCount) then raise Exception.Create('Record with number '+IntToStr(RecordNum)+' not found!');
  1022.  for i:=0 to FFields.Count-1 do begin
  1023.   TAField(FFields[i]).DeleteRecord(RecordNum);
  1024.  end;
  1025.  FCount:=FCount-1;
  1026.  if Assigned(FBeforeDelete) then FBeforeDelete(Self, RecordNum);
  1027. end;
  1028.  
  1029. procedure TADataSet.InsertRecord(RecordNum: integer);
  1030. var i:integer;
  1031. begin
  1032.  if not FActive then raise Exception.Create(Format(SADataSetNotActive,[Name]));
  1033.  if (RecordNum<0)or(RecordNum>FCount) then raise Exception.Create('Record number '+IntToStr(RecordNum)+' too large! Cannot insert.');
  1034.  
  1035.  for i:=0 to FFields.Count-1 do begin
  1036.   TAField(FFields[i]).InsertRecord(RecordNum);
  1037.  end;
  1038.  FCount:=FCount+1;
  1039.  if Assigned(FAfterInsert) then FAfterInsert(Self, RecordNum);
  1040. end;
  1041.  
  1042. procedure TADataSet.EmptyFields;
  1043. var i:integer;
  1044. begin
  1045.  for i:=0 to FFields.Count-1 do TAField(FFields[i]).Clear;
  1046. end;
  1047.  
  1048. procedure TADataSet.ForgetValues;
  1049. var i:integer;
  1050. begin
  1051.  for i:=0 to FFields.Count-1 do begin
  1052.   TAField(FFields.Value[i]).Values.Clear;
  1053.   if Assigned(TAField(FFields.Value[i]).ValuesNull)
  1054.    then TAField(FFields.Value[i]).ValuesNull.Clear;
  1055.   if Assigned(TAField(FFields.Value[i]).ValuesSize)
  1056.    then TAField(FFields.Value[i]).ValuesSize.Clear;
  1057.  end;
  1058. end;
  1059.  
  1060. function TADataSet.GetFieldByIndex(Index: integer): TAField;
  1061. begin
  1062.  if(Index<0)or(Index>=FFields.Count)then raise Exception.Create(SFieldIndexError);
  1063.  Result:=FFields[Index];
  1064. end;
  1065.  
  1066. function TADataSet.GetFieldCount: integer;
  1067. begin
  1068.  Result:=FFields.Count;
  1069. end;
  1070.  
  1071. function TADataSet.GetFieldID(FieldName: string): integer;
  1072. begin
  1073.   for Result:=0 to FFields.Count-1 do
  1074.   if AnsiCompareText(TAField(FFields[Result]).Name,FieldName)=0 then exit;
  1075.   raise Exception.Create('Field '''+FieldName+''' not found!');
  1076. end;
  1077.  
  1078. function TADataSet.GetParamByIndex(Index: integer): TAParam;
  1079. begin
  1080.  if(Index<0)or(Index>=FParams.Count)then raise Exception.Create('Param with index '+IntToStr(Index)+' does not exists!');
  1081.  Result:=FParams[Index];
  1082. end;
  1083.  
  1084. function TADataSet.ParamExists(ParamName: string): boolean;
  1085. begin
  1086.  Result:=GetParamID(ParamName)>=0;
  1087. end;
  1088.  
  1089. function TADataSet.GetParamByName(ParamName: string): TAParam;
  1090. var i:integer;
  1091. begin
  1092.  i:=GetParamID(ParamName);
  1093.  if i=-1 then raise Exception.Create('Param '''+ParamName+''' not found !') //Result:=nil
  1094.          else Result:=FParams[i];
  1095. end;
  1096.  
  1097. function TADataSet.GetParamID(ParamName: string): integer;
  1098. begin
  1099.  for Result:=0 to FParams.Count-1 do
  1100.   if AnsiCompareText(TAParam(FParams[Result]).Name,ParamName)=0 then exit;
  1101.  Result:=-1;
  1102. end;
  1103.  
  1104. procedure TADataSet.Loaded;
  1105. begin
  1106.  inherited Loaded;
  1107.  Active:=FStreamedActive;
  1108. end;
  1109.  
  1110. procedure TADataSet.Open;
  1111. begin
  1112.  if FActive then exit;
  1113.  AllocateFields;
  1114.  FActive:=True;
  1115.  FCount:=0;
  1116. end;
  1117.  
  1118. procedure TADataSet.Open(Fields: THArrayPointer);
  1119. var i:integer;
  1120. begin
  1121. // if FActive then exit;
  1122.  if Fields.Count>0 then begin
  1123.   for i:=0 to Fields.Count-1 do TAField(Fields[i]).FParent:=self;
  1124.   FFields.Clear;
  1125.   FFields.AddMany(Fields.Memory,Fields.Count);
  1126.   FActive:=True;
  1127.   FCount:=TAField(FFields[0]).Values.Count;
  1128.  end else Open;
  1129. end;
  1130.  
  1131. function TADataSet.ReadRecord(RecordNum: integer):boolean;
  1132. begin
  1133.  Result:=FCount>RecordNum;
  1134. end;
  1135.  
  1136. procedure TADataSet.ReOpen;
  1137. begin
  1138.  Close;
  1139.  Open;
  1140. end;
  1141.  
  1142. procedure TADataSet.SetActive(Value: boolean);
  1143. begin
  1144.  if (csReading in ComponentState) then  begin
  1145.    if Value then FStreamedActive := True;
  1146.    exit;
  1147.  end;
  1148. // if (csDestroying in ComponentState) then exit;
  1149.  if Value=FActive then exit;
  1150.  if Value then Open else Close;
  1151. end;
  1152.  
  1153. procedure TADataSet.SaveToDBF(FileName:string);
  1154. { ============================================================
  1155.  ª         ╟α∩Φ±ⁿ ταπεδεΓΩα Γ ⌠αΘδσ ± Σαφφ√∞Φ               ª
  1156.  ª----------------------------------------------------------ª
  1157.  ª ┴αΘ≥√ :              ╬∩Φ±αφΦσ                            ª
  1158.  ª==========================================================ª
  1159.  ª 00    :╥Φ∩√ ⌠αΘδεΓ ± Σαφφ√∞Φ:                            ª
  1160.  ª       : FoxBASE+/dBASE III +, ßστ memo - 0⌡03            ª
  1161.  ª       : FoxBASE+/dBASE III +, ± memo - 0⌡83              ª
  1162.  ª       : FoxPro/dBASE IV, ßστ memo - 0⌡03                 ª
  1163.  ª       : FoxPro ± memo - 0⌡F5                             ª
  1164.  ª       : dBASE IV ± memo - 0x8B                           ª
  1165.  ª----------------------------------------------------------ª
  1166.  ª 01-03 :╧ε±δσΣφσσ Φτ∞σφσφΦσ (├├╠╠──)                      ª
  1167.  ª----------------------------------------------------------ª
  1168.  ª 04-07 :╫Φ±δε τα∩Φ±σΘ Γ ⌠αΘδσ                             ª
  1169.  ª----------------------------------------------------------ª
  1170.  ª 08-09 :╧εδεµσφΦσ ∩σ≡ΓεΘ τα∩Φ±Φ ± Σαφφ√∞Φ                 ª
  1171.  ª----------------------------------------------------------ª
  1172.  ª 10-11 :─δΦφα εΣφεΘ τα∩Φ±Φ ± Σαφφ√∞Φ (ΓΩδ■≈α  ∩≡ΦτφαΩ     ª
  1173.  ª       :≤ΣαδσφΦ )                                         ª
  1174.  ª----------------------------------------------------------ª
  1175.  ª 12-27 :╟α≡στσ≡ΓΦ≡εΓαφ√                                   ª
  1176.  ª----------------------------------------------------------ª
  1177.  ª 28    :1-σ±≥ⁿ ±≥≡≤Ω≥.±ε±≥αΓφεΘ ΦφΣ.⌠αΘδ (≥Φ∩α .CDX),0-φσ≥ª
  1178.  ª----------------------------------------------------------ª
  1179.  ª 29-31 :╟α≡στσ≡ΓΦ≡εΓαφ√                                   ª
  1180.  ª----------------------------------------------------------ª
  1181.  ª 32-n  :╧εΣτα∩Φ±Φ ∩εδσΘ**                                 ª
  1182.  ª----------------------------------------------------------ª
  1183.  ª  n+1  :╧≡ΦτφαΩ ταΓσ≡°σφΦ  τα∩Φ±Φ ταπεδεΓΩα (0⌡01)        ª
  1184.  ============================================================
  1185.  
  1186.  ============================================================
  1187.  ª                    ╧εΣτα∩Φ±Φ ∩εδσΘ                       ª
  1188.  ª----------------------------------------------------------ª
  1189.  ª ┴αΘ≥√ :                ╬∩Φ±αφΦσ                          ª
  1190.  ª==========================================================ª
  1191.  ª 00-10 :═ατΓαφΦσ ∩εδ  (∞αΩ±Φ∞αδⁿφε - 10 ±Φ∞ΓεδεΓ, σ±δΦ    ª
  1192.  ª       :∞σφⁿ°σ 10, ≥ε Σε∩εδφ σ≥±  ∩≤±≥√∞ ±Φ∞Γεδε∞ (0⌡00)) ª
  1193.  ª----------------------------------------------------------ª
  1194.  ª 11    :╥Φ∩ Σαφφ√⌡:                                       ª
  1195.  ª       : C - ±Φ∞Γεδⁿφεσ;                                  ª
  1196.  ª       : N - ≈Φ±δεΓεσ;                                    ª
  1197.  ª       : L - δεπΦ≈σ±Ωεσ;                                  ª
  1198.  ª       : M - ≥Φ∩α memo;                                   ª
  1199.  ª       : D - Σα≥α;                                        ª
  1200.  ª       : F - ± ∩δαΓα■∙σΘ ≥ε≈ΩεΘ;                          ª
  1201.  ª       : P - °αßδεφ.                                      ª
  1202.  ª----------------------------------------------------------ª
  1203.  ª 12-15 :╨α±∩εδεµσφΦσ ∩εδ  Γφ≤≥≡Φ τα∩Φ±Φ                   ª
  1204.  ª----------------------------------------------------------ª
  1205.  ª 16    :─δΦφα ∩εδ  (Γ ßαΘ≥α⌡)                             ª
  1206.  ª----------------------------------------------------------ª
  1207.  ª 18-32 :╟α≡στσ≡ΓΦ≡εΓαφ√                                   ª
  1208.  ============================================================}
  1209.  type
  1210.     TFieldHeader=record
  1211.      Name:array[0..10] of char;  // φατΓαφΦσ ∩εδ 
  1212.      DataType:char;              // ≥Φ∩ Σαφφ√⌡ ∩εδ 
  1213.      Offset:integer;             // ±∞σ°σφΦσ ∩εδ  Γφ≤≥≡Φ τα∩Φ±Φ
  1214.      Length:byte;                // ΣδΦφα ∩εδ  Γ ßαΘ≥α⌡
  1215.      dummy:array[18..32] of byte;// τα≡στσ≡ΓΦ≡εΓαφ√
  1216.     end;
  1217.  
  1218.     THeader=record
  1219.      ftype:byte;
  1220.      LastChange:array[1..3] of byte;
  1221.      RecordCount:integer;
  1222.      FirstOffset:word;
  1223.      RecordLength:word;
  1224.      dummy1:array[12..27] of byte;
  1225.      HaveIndex:byte;
  1226.      dummy2:array[29..31] of byte;
  1227.     end;
  1228.  
  1229.    procedure ConvertToOut(RecordNum:integer;fi:TAField;Buffer:pointer;Len:integer);
  1230.    // ∩σ≡σΓεΣΦ≥ τφα≈σφΦσ ∩εδ  Γ φ≤µφ√Θ Σδ  τα∩Φ±Φ .DBF ⌠ε≡∞α≥
  1231.    //(≈α∙σ ∩σ≡σπεφ σ≥ ∩≡ε±≥ε Γ ±≥≡εΩ≤ ε∩≡σΣσδσφφεΘ ΩεΣΦ≡εΓΩΦ)
  1232.    var Data:string;
  1233.        y,m,d:word;
  1234.    begin
  1235.     if fi.IsNull[RecordNum] then Data:=MakeStr(' ',Len) else
  1236.      case fi.FieldType of
  1237.       ftoString: Data:=fi.AsString[RecordNum];
  1238.       ftoDouble: Data:=RightStr(FloatToStr(fi.AsDouble[RecordNum]),Len);
  1239.       ftoCurrency: Data:=RightStr(CurrToStr(fi.AsCurrency[RecordNum]),Len);
  1240.       ftoSmallInt: Data:=RightStr(IntToStr(fi.AsSmallInt[RecordNum]),Len);
  1241.       ftoInteger: Data:=RightStr(IntToStr(fi.AsInteger[RecordNum]),Len);
  1242.       ftoWord: Data:=RightStr(IntToStr(fi.AsWord[RecordNum]),Len);
  1243.       ftoBoolean: if fi.AsBoolean[RecordNum] then Data:='T' else Data:='F';
  1244.       ftoDate: begin
  1245.                 UnMakeGoodDate(fi.AsDate[RecordNum],y,m,d);
  1246.                 Data:=inttostr(y);
  1247.                 if m<10 then Data:=Data+'0'+inttostr(m) else Data:=Data+inttostr(m);
  1248.                 if d<10 then Data:=Data+'0'+inttostr(d) else Data:=Data+inttostr(d);
  1249.                end;
  1250.      end;
  1251.     Data:=StrToOem(copy(Data,0,Len));
  1252.     memcpy(pchar(Data),Buffer,Length(Data));
  1253.    end;
  1254.  
  1255. var y,m,d:word;
  1256.     f,i:integer;
  1257.     Header:THeader;
  1258.     fi:TAField;
  1259.     Offset:integer;
  1260.  
  1261.     DBFFields:THArray;
  1262.     fh:^TFieldHeader;
  1263.     fd:pointer;
  1264.     r:integer;
  1265. begin
  1266.  
  1267.  f:=FileCreate(FileName);
  1268.  if f=-1 then raise Exception.Create('Error create file :'+FileName);
  1269.  
  1270.  memclr(@Header,sizeof(Header));
  1271.  
  1272.  Header.ftype:=3;
  1273.  Header.RecordCount:=RecordCount;
  1274.  Header.FirstOffset:=sizeof(Header)+sizeof(TFieldHeader)*FFields.Count+1;
  1275.  
  1276.  DecodeDate(SysUtils.Date,y,m,d);
  1277.  Header.LastChange[1]:=y;
  1278.  Header.LastChange[2]:=m;
  1279.  Header.LastChange[3]:=d;
  1280.  
  1281.  DBFFields:=THArray.Create;
  1282.  DBFFields.ItemSize:=sizeof(TFieldHeader);
  1283.  DBFFields.AddFillValues(FFields.Count);
  1284.  
  1285.  Offset:=1;
  1286.  for i:=0 to FFields.Count-1 do begin
  1287.   fi:=TAField(FFields[i]);
  1288.   fh:=DBFFields.GetAddr(i);
  1289.   memclr(fh,sizeof(TFieldHeader));
  1290.   strplcopy(fh.Name,uppercase(fi.Name),10);
  1291.  
  1292.   case TAField(FFields[i]).FieldType of
  1293.    ftoString: fh.DataType:='C';
  1294.    ftoDouble,ftoCurrency,ftoSmallInt,ftoInteger,ftoWord : fh.DataType:='N';
  1295.    ftoBoolean: fh.DataType:='L';
  1296.    ftoDate: fh.DataType:='D';
  1297.    ftoBlob,ftoClob:begin
  1298.                     fh.DataType:='M';
  1299.                     Header.ftype:=$83;
  1300.                    end;
  1301.   else raise Exception.Create('Unknown fields type !');
  1302.   end;
  1303.  
  1304.   case fi.FieldType of
  1305.    ftoString:begin
  1306.               if fi.FieldSize<1 then raise Exception.Create('╨ατ∞σ≡ ∩εδ  Γ DBF φσ ∞εµσ≥ ß√≥ⁿ ∞σφⁿ°σ 1 !');
  1307.               if fi.FieldSize>254 then raise Exception.Create('╨ατ∞σ≡ ∩εδ  Γ DBF φσ ∞εµσ≥ ∩≡σΓ√°α≥ⁿ 254 ±Φ∞Γεδα !');
  1308.               fh.Length:=fi.FieldSize;
  1309.              end;
  1310.    ftoDouble:   fh.Length:=17;
  1311.    ftoCurrency: fh.Length:=22;
  1312.    ftoSmallInt: fh.Length:=6;
  1313.    ftoInteger:  fh.Length:=11;
  1314.    ftoWord:     fh.Length:=5;
  1315.    ftoBoolean:  fh.Length:=1;
  1316.    ftoDate:     fh.Length:=8;//10;
  1317.    ftoBlob,ftoClob:fh.Length:=25;
  1318.   else raise Exception.Create('Unknown fields type !');
  1319.   end;
  1320.   fh.Offset:=Offset;
  1321.   inc(Offset,fh.Length);
  1322.  end;
  1323.  
  1324.  Header.RecordLength:=Offset;
  1325.  
  1326.  FileWrite(f,Header,sizeof(Header));
  1327.  FileWrite(f,(DBFFields.Memory)^,DBFFields.ItemSize*DBFFields.Count);
  1328.  i:=$0D;
  1329.  FileWrite(f,i,1);
  1330.  
  1331.  // Γ√ΓεΣ τα∩Φ±σΘ
  1332.  fd:=AllocMem(Header.RecordLength);
  1333.  try
  1334.   for r:=0 to RecordCount-1 do begin
  1335.    memclr(fd,Header.RecordLength);
  1336.    for i:=0 to FFields.Count-1 do begin
  1337.     fi:=TAField(FFields[i]);
  1338.     fh:=DBFFields.GetAddr(i);
  1339.     ConvertToOut(r,fi,pointer(longword(fd)+longword(fh.Offset)),fh.Length);
  1340.    end;
  1341.    FileWrite(f,fd^,Header.RecordLength);
  1342.   end;
  1343.  finally
  1344.   FreeMem(fd);
  1345.  end;
  1346.  DBFFields.Free;
  1347.  FileClose(f);
  1348. end;
  1349.  
  1350. function TADataSet.EOF: boolean;
  1351. begin
  1352.  if not FFetched
  1353.   then Result:=False
  1354.   else Result:=RecordCount<=FCurrentRec;
  1355. end;
  1356.  
  1357. procedure TADataSet.Next;
  1358. begin
  1359.  Inc(FCurrentRec);
  1360.  ReadRecord(FCurrentRec);
  1361. end;
  1362.  
  1363. procedure TADataSet.First;
  1364. begin
  1365.  FCurrentRec:=0;
  1366.  ReadRecord(FCurrentRec);
  1367. end;
  1368.  
  1369. function TADataSet.GetParamCount: integer;
  1370. begin
  1371.  Result:=FParams.Count;
  1372. end;
  1373.  
  1374. procedure TADataSet.SetAfterInsert(proc : TADataSetNotifyEvent);
  1375. begin
  1376.   FAfterInsert := proc;
  1377. end;
  1378.  
  1379. procedure TADataSet.SetBeforeDelete(proc : TADataSetNotifyEvent);
  1380. begin
  1381.   FBeforeDelete := proc;
  1382. end;
  1383.  
  1384. function TADataSet.GetFieldByName(FieldName: string): TAField;
  1385. var n:integer;
  1386. begin
  1387.  n:=GetFieldID(FieldName);
  1388.  Result:=FFields[n];
  1389. end;
  1390.  
  1391. procedure TADataSet.ReadAll;
  1392. begin
  1393.  while not FFetched do Fetch;
  1394. end;
  1395.  
  1396. function TADataSet.ReadBlob(FieldName: string; RecordNum, Offset: integer;
  1397.   Buffer: pointer; Size: integer): cardinal;
  1398. begin
  1399.  Result:=GetFieldByName(FieldName).ReadBlob(RecordNum,Offset,Buffer,Size);
  1400. end;
  1401.  
  1402. function TADataSet.ReadBlob(FieldNum, RecordNum, Offset: integer;
  1403.   Buffer: pointer; Size: integer): cardinal;
  1404. begin
  1405.   Result:=GetFieldByIndex(FieldNum).ReadBlob(RecordNum,Offset,Buffer,Size);
  1406. end;
  1407.  
  1408. function TADataSet.ReadBlobToStream(FieldName: string; RecordNum: integer;
  1409.   Stream: TStream): cardinal;
  1410. begin
  1411.   Result:=GetFieldByName(FieldName).ReadBlobToStream(RecordNum,Stream);
  1412. end;
  1413.  
  1414. function TADataSet.ReadBlobToStream(FieldNum, RecordNum: integer;
  1415.   Stream: TStream): cardinal;
  1416. begin
  1417.  Result:=GetFieldByIndex(FieldNum).ReadBlobToStream(RecordNum,Stream);
  1418. end;
  1419.  
  1420. function TADataSet.WriteBlob(FieldNum, RecordNum, Offset: integer;
  1421.   Buffer: pointer; Size: integer): cardinal;
  1422. begin
  1423.  Result:=GetFieldByIndex(FieldNum).WriteBlob(RecordNum,Offset,Buffer,Size);
  1424. end;
  1425.  
  1426. function TADataSet.WriteBlob(FieldName: string; RecordNum, Offset: integer;
  1427.   Buffer: pointer; Size: integer): cardinal;
  1428. begin
  1429.  Result:=GetFieldByName(FieldName).WriteBlob(RecordNum,Offset,Buffer,Size);
  1430. end;
  1431.  
  1432. function TADataSet.WriteBlobFromStream(FieldNum, RecordNum: integer;
  1433.   Stream: TStream): cardinal;
  1434. begin
  1435.   Result:=GetFieldByIndex(FieldNum).WriteBlobFromStream(RecordNum,Stream);
  1436. end;
  1437.  
  1438. function TADataSet.WriteBlobFromStream(FieldName: string;
  1439.   RecordNum: integer; Stream: TStream): cardinal;
  1440. begin
  1441.   Result:=GetFieldByName(FieldName).WriteBlobFromStream(RecordNum,Stream);
  1442. end;
  1443.  
  1444. procedure TADataSet.CopyStructure(DataSet: TDataSet);
  1445. var i:integer;
  1446. begin
  1447.  Close;
  1448.  FFields.Clear;
  1449.  for i:=0 to DataSet.FieldDefs.Count-1 do begin
  1450.    AddField(DataSet.FieldDefs[i].Name,TypeDelphiToA(DataSet.FieldDefs[i].DataType),DataSet.FieldDefs[i].Size,DataSet.FieldDefs[i].Required);
  1451.  end;
  1452. end;
  1453.  
  1454. procedure TADataSet.CopyStructure(ADataSet: TADataSet);
  1455. var i:integer;
  1456. begin
  1457.  Close;
  1458.  FFields.Clear;
  1459.  for i:=0 to ADataSet.FieldCount-1 do begin
  1460.   AddField(ADataSet.FieldByIndex[i].Name,ADataSet.FieldByIndex[i].FieldType,ADataSet.FieldByIndex[i].FieldSize,ADataSet.FieldByIndex[i].Required);
  1461.  end;
  1462. end;
  1463.  
  1464. procedure TADataSet.Sort(FieldIndex: integer;SortType:TSortType);
  1465. //var i,j:integer;
  1466. //    a:THArray;
  1467. begin
  1468. { if Assigned(FSortIndex)
  1469.   then FSortIndex.Clear
  1470.   else FSortIndex:=THArrayInteger.Create;
  1471.  
  1472.  FSortIndex.SetCapacity(FCount); // so many items as many records in ADataSet
  1473.  for i:=0 to FCount do
  1474.   FSortIndex[i]:=i;
  1475.  
  1476.  a:=TAField(FFields[FieldIndex]).Values;
  1477.  if TAField(FFields[FieldIndex]).FFieldType in [ftoBlob, ftoClob]
  1478.   then raise Exception.Create('Can''t sort by BLOB field!');
  1479.  }
  1480. { for i:=0 to FCount-1 do
  1481.   for j:=i to FCount-1 do begin
  1482.    case TAField(FFields[FieldIndex]).FFieldType of
  1483. //    ftoString:    THArrayStringFix(a).
  1484.     ftoSmallint,
  1485.     ftoInteger,
  1486.     ftoWord,
  1487.     ftoBoolean,
  1488.     ftoDouble,
  1489.     ftoCurrency,
  1490.     ftoDate,
  1491.     ftoTime,
  1492.     ftoDateTime,
  1493.   ftoString:   Values:=THArrayStringFix.CreateSize(FieldSize);
  1494.   ftoBoolean:  Values:=THArrayBoolean.Create;
  1495.   ftoDouble:   Values:=THArrayDouble.Create;
  1496.   ftoCurrency: Values:=THArrayCurrency.Create;
  1497.   ftoDate:     Values:=THArrayInteger.Create;
  1498.   ftoTime:     Values:=THArrayInteger.Create;
  1499.   ftoDateTime: Values:=THArrayInt64.Create;
  1500.   ftoInteger:  Values:=THArrayInteger.Create;
  1501.   ftoSmallInt: Values:=THArraySmallInt.Create;
  1502.   ftoWord:     Values:=THArrayWord.Create;
  1503.  
  1504.  
  1505.    end;
  1506.   end;}
  1507. end;
  1508.  
  1509. procedure TADataSet.Sort(FieldName: string;SortType:TSortType);
  1510. begin
  1511.  Sort(GetFieldID(FieldName),SortType);
  1512. end;
  1513.  
  1514. function TADataSet.GetSorted: boolean;
  1515. begin
  1516.  Result:=Assigned(FSortIndex);
  1517. end;
  1518.  
  1519.  
  1520.  
  1521. { TADatabase }
  1522.  
  1523. constructor TADatabase.Create(AOwner: TComponent);
  1524. begin
  1525.  inherited Create(AOwner);
  1526.  FDataSets:=THArrayPointer.Create;
  1527. end;
  1528.  
  1529. destructor TADatabase.Destroy;
  1530. begin
  1531.  while FDataSets.Count>0 do
  1532.   TDataSetQuery(FDataSets[0]).SetDatabase(nil);
  1533.  FDataSets.Free;
  1534.  inherited Destroy;
  1535. end;
  1536.  
  1537. procedure TADatabase.CloseLinkedDataSets;
  1538. // if we close TADatabase - all linked DataSets must be closed too.
  1539. var i:integer;
  1540. begin
  1541.  for i:=0 to FDataSets.Count-1 do
  1542.    TDataSet(FDataSets[i]).Close;
  1543. end;
  1544.  
  1545. procedure TADatabase.AddDataSet(DataSet: TDataSet);
  1546. begin
  1547.  FDataSets.AddValue(DataSet);
  1548. end;
  1549.  
  1550. procedure TADatabase.RemoveDataSet(DataSet: TDataSet);
  1551. var n:integer;
  1552. begin
  1553.  if DataSet=nil then exit;
  1554.  n:=FDataSets.IndexOf(DataSet);
  1555.  if n<>-1 then FDataSets.Delete(n);
  1556. end;
  1557.  
  1558. end.
  1559.