home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / RxMemDS.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  44KB  |  1,540 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1998 Master-Bank                }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit RxMemDS;
  10.  
  11. {$I RX.INC}
  12.  
  13. interface
  14.  
  15. {$IFDEF RX_D3}
  16.  
  17. uses Windows, SysUtils, Classes, Controls, DB, DBUtils, Variants;
  18.  
  19. { TRxMemoryData }
  20.  
  21. type
  22.   TMemBlobData = string;
  23.   TMemBlobArray = array[0..0] of TMemBlobData;
  24.   PMemBlobArray = ^TMemBlobArray;
  25.   TMemoryRecord = class;
  26.   TLoadMode = (lmCopy, lmAppend);
  27.   TCompareRecords = function (Item1, Item2: TMemoryRecord): Integer of object;
  28.  
  29.   TRxMemoryData = class(TDataSet)
  30.   private
  31.     FRecordPos: Integer;
  32.     FRecordSize: Integer;
  33.     FBookmarkOfs: Integer;
  34.     FBlobOfs: Integer;
  35.     FRecBufSize: Integer;
  36.     FOffsets: PWordArray;
  37.     FLastID: Integer;
  38.     FAutoInc: Longint;
  39.     FActive: Boolean;
  40.     FRecords: TList;
  41.     FIndexList: TList;
  42.     FCaseInsensitiveSort: Boolean;
  43.     FDescendingSort: Boolean;
  44.     function AddRecord: TMemoryRecord;
  45.     function InsertRecord(Index: Integer): TMemoryRecord;
  46.     function FindRecordID(ID: Integer): TMemoryRecord;
  47.     procedure CreateIndexList(const FieldNames: string);
  48.     procedure FreeIndexList;
  49.     procedure QuickSort(L, R: Integer; Compare: TCompareRecords);
  50.     procedure Sort;
  51.     function CalcRecordSize: Integer;
  52.     function FindFieldData(Buffer: Pointer; Field: TField): Pointer;
  53.     function GetMemoryRecord(Index: Integer): TMemoryRecord;
  54.     function GetCapacity: Integer;
  55.     function RecordFilter: Boolean;
  56.     procedure SetCapacity(Value: Integer);
  57.     procedure ClearRecords;
  58.     procedure InitBufferPointers(GetProps: Boolean);
  59.   protected
  60.     procedure AssignMemoryRecord(Rec: TMemoryRecord; Buffer: PChar);
  61.     function GetActiveRecBuf(var RecBuf: PChar): Boolean; virtual;
  62.     procedure InitFieldDefsFromFields;
  63.     procedure RecordToBuffer(Rec: TMemoryRecord; Buffer: PChar);
  64.     procedure SetMemoryRecordData(Buffer: PChar; Pos: Integer); virtual;
  65.     procedure SetAutoIncFields(Buffer: PChar); virtual;
  66.     function CompareRecords(Item1, Item2: TMemoryRecord): Integer; virtual;
  67.     function GetBlobData(Field: TField; Buffer: PChar): TMemBlobData;
  68.     procedure SetBlobData(Field: TField; Buffer: PChar; Value: TMemBlobData);
  69.     function AllocRecordBuffer: PChar; override;
  70.     procedure FreeRecordBuffer(var Buffer: PChar); override;
  71. {$IFNDEF RX_D5}
  72.     function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; override;
  73.     function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  74.       Decimals: Integer): Boolean; override;
  75. {$ENDIF}
  76.     procedure InternalInitRecord(Buffer: PChar); override;
  77.     procedure ClearCalcFields(Buffer: PChar); override;
  78.     function GetRecord(Buffer: PChar; GetMode: TGetMode;
  79.       DoCheck: Boolean): TGetResult; override;
  80.     function GetRecordSize: Word; override;
  81.     procedure SetFiltered(Value: Boolean); override;
  82.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
  83.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  84.     procedure CloseBlob(Field: TField); override;
  85.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  86.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  87.     procedure InternalGotoBookmark(Bookmark: TBookmark); override;
  88.     procedure InternalSetToRecord(Buffer: PChar); override;
  89.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  90.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  91.     function GetIsIndexField(Field: TField): Boolean; override;
  92.     procedure InternalFirst; override;
  93.     procedure InternalLast; override;
  94.     procedure InitRecord(Buffer: PChar); override;
  95.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  96.     procedure InternalDelete; override;
  97.     procedure InternalPost; override;
  98.     procedure InternalClose; override;
  99.     procedure InternalHandleException; override;
  100.     procedure InternalInitFieldDefs; override;
  101.     procedure InternalOpen; override;
  102.     procedure OpenCursor(InfoQuery: Boolean); override;
  103.     function IsCursorOpen: Boolean; override;
  104.     function GetRecordCount: Integer; override;
  105.     function GetRecNo: Integer; override;
  106.     procedure SetRecNo(Value: Integer); override;
  107.     property Records[Index: Integer]: TMemoryRecord read GetMemoryRecord;
  108.   public
  109.     constructor Create(AOwner: TComponent); override;
  110.     destructor Destroy; override;
  111.     function BookmarkValid(Bookmark: TBookmark): Boolean; override;
  112.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
  113.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  114.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  115.     function GetCurrentRecord(Buffer: PChar): Boolean; override;
  116.     function IsSequenced: Boolean; override;
  117.     function Locate(const KeyFields: string; const KeyValues: Variant;
  118.       Options: TLocateOptions): Boolean; override;
  119.     procedure SortOnFields(const FieldNames: string;
  120. {$IFDEF RX_D4}
  121.       CaseInsensitive: Boolean = True; Descending: Boolean = False);
  122. {$ELSE}
  123.       CaseInsensitive, Descending: Boolean);
  124. {$ENDIF}
  125.     procedure EmptyTable;
  126.     procedure CopyStructure(Source: TDataSet);
  127.     function LoadFromDataSet(Source: TDataSet; RecordCount: Integer;
  128.       Mode: TLoadMode): Integer;
  129.     function SaveToDataSet(Dest: TDataSet; RecordCount: Integer): Integer;
  130.   published
  131.     property Capacity: Integer read GetCapacity write SetCapacity default 0;
  132.     property Active;
  133.     property AutoCalcFields;
  134.     property Filtered;
  135. {$IFDEF RX_D4}
  136.     property FieldDefs;
  137.     property ObjectView default False;
  138. {$ENDIF}
  139.     property BeforeOpen;
  140.     property AfterOpen;
  141.     property BeforeClose;
  142.     property AfterClose;
  143.     property BeforeInsert;
  144.     property AfterInsert;
  145.     property BeforeEdit;
  146.     property AfterEdit;
  147.     property BeforePost;
  148.     property AfterPost;
  149.     property BeforeCancel;
  150.     property AfterCancel;
  151.     property BeforeDelete;
  152.     property AfterDelete;
  153.     property BeforeScroll;
  154.     property AfterScroll;
  155.     property OnCalcFields;
  156.     property OnDeleteError;
  157.     property OnEditError;
  158.     property OnFilterRecord;
  159.     property OnNewRecord;
  160.     property OnPostError;
  161.   end;
  162.  
  163. { TMemBlobStream }
  164.  
  165.   TMemBlobStream = class(TStream)
  166.   private
  167.     FField: TBlobField;
  168.     FDataSet: TRxMemoryData;
  169.     FBuffer: PChar;
  170.     FMode: TBlobStreamMode;
  171.     FOpened: Boolean;
  172.     FModified: Boolean;
  173.     FPosition: Longint;
  174.     FCached: Boolean;
  175.     function GetBlobSize: Longint;
  176.     function GetBlobFromRecord(Field: TField): TMemBlobData;
  177.   public
  178.     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
  179.     destructor Destroy; override;
  180.     function Read(var Buffer; Count: Longint): Longint; override;
  181.     function Write(const Buffer; Count: Longint): Longint; override;
  182.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  183.     procedure Truncate;
  184.   end;
  185.  
  186. { TMemoryRecord }
  187.  
  188.   TMemoryRecord = class(TPersistent)
  189.   private
  190.     FMemoryData: TRxMemoryData;
  191.     FID: Integer;
  192.     FData: Pointer;
  193.     FBlobs: Pointer;
  194.     function GetIndex: Integer;
  195.     procedure SetMemoryData(Value: TRxMemoryData; UpdateParent: Boolean);
  196.   protected
  197.     procedure SetIndex(Value: Integer); virtual;
  198.   public
  199.     constructor Create(MemoryData: TRxMemoryData); virtual;
  200.     constructor CreateEx(MemoryData: TRxMemoryData; UpdateParent: Boolean); virtual;
  201.     destructor Destroy; override;
  202.     property MemoryData: TRxMemoryData read FMemoryData;
  203.     property ID: Integer read FID write FID;
  204.     property Index: Integer read GetIndex write SetIndex;
  205.     property Data: Pointer read FData;
  206.   end;
  207.  
  208. {$ENDIF RX_D3}
  209.  
  210. implementation
  211.  
  212. {$IFDEF RX_D3}
  213.  
  214. uses Forms, DbConsts {$IFDEF RX_D5}, ComObj {$ENDIF};
  215.  
  216. resourcestring
  217.   SMemNoRecords = 'No data found';
  218. {$IFNDEF RX_D4}
  219.   SInvalidFields = 'No fields defined';
  220. {$ENDIF}
  221.  
  222. const
  223.   ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
  224.     ftDBaseOle, ftTypedBinary {$IFDEF RX_D5}, ftOraBlob, ftOraClob {$ENDIF}];
  225.  
  226.   ftSupported = [ftString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
  227.     ftCurrency, ftDate, ftTime, ftDateTime, ftAutoInc, ftBCD, ftBytes,
  228.     ftVarBytes {$IFDEF RX_D4}, ftADT, ftFixedChar, ftWideString,
  229.     ftLargeint {$ENDIF} {$IFDEF RX_D5}, ftVariant, ftGuid {$ENDIF}] + 
  230.     ftBlobTypes;
  231.  
  232.   fkStoredFields = [fkData];
  233.  
  234. {$IFDEF RX_D5}
  235.   GuidSize = 38;
  236. {$ENDIF}
  237.  
  238. { Utility routines }
  239.  
  240. function CompareFields(Data1, Data2: Pointer; FieldType: TFieldType;
  241.   CaseInsensitive: Boolean): Integer;
  242. begin
  243.   Result := 0;
  244.   case FieldType of
  245.     ftString:
  246.       if CaseInsensitive then
  247.         Result := AnsiCompareText(PChar(Data1), PChar(Data2))
  248.       else
  249.         Result := AnsiCompareStr(PChar(Data1), PChar(Data2));
  250.     ftSmallint:
  251.       if SmallInt(Data1^) > SmallInt(Data2^) then Result := 1
  252.       else if SmallInt(Data1^) < SmallInt(Data2^) then Result := -1;
  253.     ftInteger, ftDate, ftTime, ftAutoInc:
  254.       if Longint(Data1^) > Longint(Data2^) then Result := 1
  255.       else if Longint(Data1^) < Longint(Data2^) then Result := -1;
  256.     ftWord:
  257.       if Word(Data1^) > Word(Data2^) then Result := 1
  258.       else if Word(Data1^) < Word(Data2^) then Result := -1;
  259.     ftBoolean:
  260.       if WordBool(Data1^) and not WordBool(Data2^) then Result := 1
  261.       else if not WordBool(Data1^) and WordBool(Data2^) then Result := -1;
  262.     ftFloat, ftCurrency:
  263.       if Double(Data1^) > Double(Data2^) then Result := 1
  264.       else if Double(Data1^) < Double(Data2^) then Result := -1;
  265.     ftDateTime:
  266.       if TDateTime(Data1^) > TDateTime(Data2^) then Result := 1
  267.       else if TDateTime(Data1^) < TDateTime(Data2^) then Result := -1;
  268. {$IFDEF RX_D4}
  269.     ftFixedChar:
  270.       if CaseInsensitive then
  271.         Result := AnsiCompareText(PChar(Data1), PChar(Data2))
  272.       else
  273.         Result := AnsiCompareStr(PChar(Data1), PChar(Data2));
  274.     ftWideString:
  275.       if CaseInsensitive then
  276.         Result := AnsiCompareText(WideCharToString(PWideChar(Data1)),
  277.           WideCharToString(PWideChar(Data2)))
  278.       else
  279.         Result := AnsiCompareStr(WideCharToString(PWideChar(Data1)),
  280.           WideCharToString(PWideChar(Data2)));
  281.     ftLargeint: 
  282.       if Int64(Data1^) > Int64(Data2^) then Result := 1
  283.       else if Int64(Data1^) < Int64(Data2^) then Result := -1;
  284. {$ENDIF}
  285. {$IFDEF RX_D5}
  286.     ftVariant:
  287.       Result := 0;
  288.     ftGuid:
  289.       Result := AnsiCompareText(PChar(Data1), PChar(Data2));
  290. {$ENDIF}
  291.   end;
  292. end;
  293.  
  294. function CalcFieldLen(FieldType: TFieldType; Size: Word): Word;
  295. begin
  296.   if not (FieldType in ftSupported) then
  297.     Result := 0
  298.   else if (FieldType in ftBlobTypes) then
  299.     Result := SizeOf(Longint)
  300.   else begin
  301.     Result := Size;
  302.     case FieldType of
  303.       ftString: Inc(Result);
  304.       ftSmallint: Result := SizeOf(SmallInt);
  305.       ftInteger: Result := SizeOf(Longint);
  306.       ftWord: Result := SizeOf(Word);
  307.       ftBoolean: Result := SizeOf(WordBool);
  308.       ftFloat: Result := SizeOf(Double);
  309.       ftCurrency: Result := SizeOf(Double);
  310.       ftBCD: Result := 34;
  311.       ftDate, ftTime: Result := SizeOf(Longint);
  312.       ftDateTime: Result := SizeOf(TDateTime);
  313.       ftBytes: Result := Size;
  314.       ftVarBytes: Result := Size + 2;
  315.       ftAutoInc: Result := SizeOf(Longint);
  316. {$IFDEF RX_D4}
  317.       ftADT: Result := 0;
  318.       ftFixedChar: Inc(Result);
  319.       ftWideString: Result := (Result + 1) * 2;
  320.       ftLargeint: Result := SizeOf(Int64);
  321. {$ENDIF}
  322. {$IFDEF RX_D5}
  323.       ftVariant: Result := SizeOf(Variant);
  324.       ftGuid: Result := GuidSize + 1;
  325. {$ENDIF}
  326.     end;
  327.   end;
  328. end;
  329.  
  330. procedure CalcDataSize(FieldDef: TFieldDef; var DataSize: Integer);
  331. {$IFDEF RX_D4}
  332. var
  333.   I: Integer;
  334. {$ENDIF}
  335. begin
  336.   with FieldDef do begin
  337.     if (DataType in ftSupported - ftBlobTypes) then
  338.       Inc(DataSize, CalcFieldLen(DataType, Size) + 1);
  339. {$IFDEF RX_D4}
  340.     for I := 0 to ChildDefs.Count - 1 do
  341.       CalcDataSize(ChildDefs[I], DataSize);
  342. {$ENDIF}
  343.   end;
  344. end;
  345.  
  346. procedure Error(const Msg: string);
  347. begin
  348.   DatabaseError(Msg);
  349. end;
  350.  
  351. procedure ErrorFmt(const Msg: string; const Args: array of const);
  352. begin
  353.   DatabaseErrorFmt(Msg, Args);
  354. end;
  355.  
  356. type
  357.   TBookmarkData = Integer;
  358.   PMemBookmarkInfo = ^TMemBookmarkInfo;
  359.   TMemBookmarkInfo = record
  360.     BookmarkData: TBookmarkData;
  361.     BookmarkFlag: TBookmarkFlag;
  362.   end;
  363.  
  364. { TMemoryRecord }
  365.  
  366. constructor TMemoryRecord.Create(MemoryData: TRxMemoryData);
  367. begin
  368.   CreateEx(MemoryData, True);
  369. end;
  370.  
  371. constructor TMemoryRecord.CreateEx(MemoryData: TRxMemoryData;
  372.   UpdateParent: Boolean);
  373. begin
  374.   inherited Create;
  375.   SetMemoryData(MemoryData, UpdateParent);
  376. end;
  377.  
  378. destructor TMemoryRecord.Destroy;
  379. begin
  380.   SetMemoryData(nil, True);
  381.   inherited Destroy;
  382. end;
  383.  
  384. function TMemoryRecord.GetIndex: Integer;
  385. begin
  386.   if FMemoryData <> nil then Result := FMemoryData.FRecords.IndexOf(Self)
  387.   else Result := -1;
  388. end;
  389.  
  390. procedure TMemoryRecord.SetMemoryData(Value: TRxMemoryData; UpdateParent: Boolean);
  391. var
  392.   I: Integer;
  393.   DataSize: Integer;
  394. begin
  395.   if FMemoryData <> Value then begin
  396.     if FMemoryData <> nil then begin
  397.       FMemoryData.FRecords.Remove(Self);
  398.       if FMemoryData.BlobFieldCount > 0 then
  399.         Finalize(PMemBlobArray(FBlobs)[0], FMemoryData.BlobFieldCount);
  400.       ReallocMem(FBlobs, 0);
  401.       ReallocMem(FData, 0);
  402.       FMemoryData := nil;
  403.     end;
  404.     if Value <> nil then begin
  405.       if UpdateParent then begin
  406.         Value.FRecords.Add(Self);
  407.         Inc(Value.FLastID);
  408.         FID := Value.FLastID;
  409.       end;
  410.       FMemoryData := Value;
  411.       if Value.BlobFieldCount > 0 then begin
  412.         ReallocMem(FBlobs, Value.BlobFieldCount * SizeOf(Pointer));
  413.         Initialize(PMemBlobArray(FBlobs)[0], Value.BlobFieldCount);
  414.       end;
  415.       DataSize := 0;
  416.       for I := 0 to Value.FieldDefs.Count - 1 do
  417.         CalcDataSize(Value.FieldDefs[I], DataSize);
  418.       ReallocMem(FData, DataSize);
  419.     end;
  420.   end;
  421. end;
  422.  
  423. procedure TMemoryRecord.SetIndex(Value: Integer);
  424. var
  425.   CurIndex: Integer;
  426. begin
  427.   CurIndex := GetIndex;
  428.   if (CurIndex >= 0) and (CurIndex <> Value) then
  429.     FMemoryData.FRecords.Move(CurIndex, Value);
  430. end;
  431.  
  432. { TRxMemoryData }
  433.  
  434. constructor TRxMemoryData.Create(AOwner: TComponent);
  435. begin
  436.   inherited Create(AOwner);
  437.   FRecordPos := -1;
  438.   FLastID := Low(Integer);
  439.   FAutoInc := 1;
  440.   FRecords := TList.Create;
  441. end;
  442.  
  443. destructor TRxMemoryData.Destroy;
  444. begin
  445.   inherited Destroy;
  446.   FreeIndexList;
  447.   ClearRecords;
  448.   FRecords.Free;
  449.   ReallocMem(FOffsets, 0);
  450. end;
  451.  
  452. { Records Management }
  453.  
  454. function TRxMemoryData.GetCapacity: Integer;
  455. begin
  456.   if FRecords <> nil then Result := FRecords.Capacity
  457.   else Result := 0;
  458. end;
  459.  
  460. procedure TRxMemoryData.SetCapacity(Value: Integer);
  461. begin
  462.   if FRecords <> nil then FRecords.Capacity := Value;
  463. end;
  464.  
  465. function TRxMemoryData.AddRecord: TMemoryRecord;
  466. begin
  467.   Result := TMemoryRecord.Create(Self);
  468. end;
  469.  
  470. function TRxMemoryData.FindRecordID(ID: Integer): TMemoryRecord;
  471. var
  472.   I: Integer;
  473. begin
  474.   for I := 0 to FRecords.Count - 1 do begin
  475.     Result := TMemoryRecord(FRecords[I]);
  476.     if Result.ID = ID then Exit;
  477.   end;
  478.   Result := nil;
  479. end;
  480.  
  481. function TRxMemoryData.InsertRecord(Index: Integer): TMemoryRecord;
  482. begin
  483.   Result := AddRecord;
  484.   Result.Index := Index;
  485. end;
  486.  
  487. function TRxMemoryData.GetMemoryRecord(Index: Integer): TMemoryRecord;
  488. begin
  489.   Result := TMemoryRecord(FRecords[Index]);
  490. end;
  491.  
  492. { Field Management }
  493.  
  494. {$IFNDEF RX_D5}
  495.  
  496. function TRxMemoryData.BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean;
  497. begin
  498.   Move(BCD^, Curr, SizeOf(Currency));
  499.   Result := True;
  500. end;
  501.  
  502. function TRxMemoryData.CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  503.   Decimals: Integer): Boolean;
  504. begin
  505.   Move(Curr, BCD^, SizeOf(Currency));
  506.   Result := True;
  507. end;
  508.  
  509. {$ENDIF RX_D5}
  510.  
  511. procedure TRxMemoryData.InitFieldDefsFromFields;
  512. var
  513.   I: Integer;
  514.   Offset: Word;
  515. begin
  516.   if FieldDefs.Count = 0 then begin
  517.     for I := 0 to FieldCount - 1 do begin
  518.       with Fields[I] do
  519.         if (FieldKind in fkStoredFields) and not (DataType in ftSupported) then
  520.           ErrorFmt(SUnknownFieldType, [DisplayName]);
  521.     end;
  522.     FreeIndexList;
  523.   end;
  524.   Offset := 0;
  525. {$IFDEF RX_D4}
  526.   inherited InitFieldDefsFromFields;
  527.   { Calculate fields offsets }
  528.   ReallocMem(FOffsets, FieldDefList.Count * SizeOf(Word));
  529.   for I := 0 to FieldDefList.Count - 1 do begin
  530.     FOffsets^[I] := Offset;
  531.     with FieldDefList[I] do begin
  532.       if (DataType in ftSupported - ftBlobTypes) then
  533.         Inc(Offset, CalcFieldLen(DataType, Size) + 1);
  534.     end;
  535.   end;
  536. {$ELSE}
  537.   { Create FieldDefs from persistent fields if needed }
  538.   if FieldDefs.Count = 0 then
  539.     for I := 0 to FieldCount - 1 do begin
  540.       with Fields[I] do
  541.         if (FieldKind = fkData) then
  542.           FieldDefs.Add(FieldName, DataType, Size, Required);
  543.     end;
  544.   { Calculate fields offsets }
  545.   ReallocMem(FOffsets, FieldDefs.Count * SizeOf(Word));
  546.   for I := 0 to FieldDefs.Count - 1 do begin
  547.     FOffsets^[I] := Offset;
  548.     with FieldDefs[I] do begin
  549.       if (DataType in ftSupported - ftBlobTypes) then
  550.         Inc(Offset, CalcFieldLen(DataType, Size) + 1);
  551.     end;
  552.   end;
  553. {$ENDIF}
  554. end;
  555.  
  556. function TRxMemoryData.FindFieldData(Buffer: Pointer; Field: TField): Pointer;
  557. var
  558.   Index: Integer;
  559. begin
  560. {$IFDEF RX_D4}
  561.   Index := FieldDefList.IndexOf(Field.FullName);
  562. {$ELSE}
  563.   Index := FieldDefs.IndexOf(Field.FieldName);
  564. {$ENDIF}
  565.   if (Index >= 0) and (Buffer <> nil) and
  566. {$IFDEF RX_D4}
  567.     (FieldDefList[Index].DataType in ftSupported - ftBlobTypes) then
  568. {$ELSE}
  569.     (FieldDefs[Index].DataType in ftSupported - ftBlobTypes) then
  570. {$ENDIF}
  571.     Result := (PChar(Buffer) + FOffsets[Index])
  572.   else Result := nil;
  573. end;
  574.  
  575. { Buffer Manipulation }
  576.  
  577. function TRxMemoryData.CalcRecordSize: Integer;
  578. var
  579.   I: Integer;
  580. begin
  581.   Result := 0;
  582.   for I := 0 to FieldDefs.Count - 1 do
  583.     CalcDataSize(FieldDefs[I], Result);
  584. end;
  585.  
  586. procedure TRxMemoryData.InitBufferPointers(GetProps: Boolean);
  587. begin
  588.   if GetProps then FRecordSize := CalcRecordSize;
  589.   FBookmarkOfs := FRecordSize + CalcFieldsSize;
  590.   FBlobOfs := FBookmarkOfs + SizeOf(TMemBookmarkInfo);
  591.   FRecBufSize := FBlobOfs + BlobFieldCount * SizeOf(Pointer);
  592. end;
  593.  
  594. procedure TRxMemoryData.ClearRecords;
  595. begin
  596.   while FRecords.Count > 0 do TObject(FRecords.Last).Free;
  597.   FLastID := Low(Integer);
  598.   FRecordPos := -1;
  599. end;
  600.  
  601. function TRxMemoryData.AllocRecordBuffer: PChar;
  602. begin
  603.   Result := StrAlloc(FRecBufSize);
  604.   if BlobFieldCount > 0 then
  605.     Initialize(PMemBlobArray(Result + FBlobOfs)[0], BlobFieldCount);
  606. end;
  607.  
  608. procedure TRxMemoryData.FreeRecordBuffer(var Buffer: PChar);
  609. begin
  610.   if BlobFieldCount > 0 then
  611.     Finalize(PMemBlobArray(Buffer + FBlobOfs)[0], BlobFieldCount);
  612.   StrDispose(Buffer);
  613.   Buffer := nil;
  614. end;
  615.  
  616. procedure TRxMemoryData.ClearCalcFields(Buffer: PChar);
  617. begin
  618.   FillChar(Buffer[FRecordSize], CalcFieldsSize, 0);
  619. end;
  620.  
  621. procedure TRxMemoryData.InternalInitRecord(Buffer: PChar);
  622. var
  623.   I: Integer;
  624. begin
  625.   FillChar(Buffer^, FBlobOfs, 0);
  626.   for I := 0 to BlobFieldCount - 1 do
  627.     PMemBlobArray(Buffer + FBlobOfs)[I] := '';
  628. end;
  629.  
  630. procedure TRxMemoryData.InitRecord(Buffer: PChar);
  631. begin
  632.   inherited InitRecord(Buffer);
  633.   with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do begin
  634.     BookmarkData := Low(Integer);
  635.     BookmarkFlag := bfInserted;
  636.   end;
  637. end;
  638.  
  639. function TRxMemoryData.GetCurrentRecord(Buffer: PChar): Boolean;
  640. begin
  641.   Result := False;
  642.   if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then begin
  643.     UpdateCursorPos;
  644.     if (FRecordPos >= 0) and (FRecordPos < RecordCount) then begin
  645.       Move(Records[FRecordPos].Data^, Buffer^, FRecordSize);
  646.       Result := True;
  647.     end;
  648.   end;
  649. end;
  650.  
  651. procedure TRxMemoryData.RecordToBuffer(Rec: TMemoryRecord; Buffer: PChar);
  652. var
  653.   I: Integer;
  654. begin
  655.   Move(Rec.Data^, Buffer^, FRecordSize);
  656.   with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do begin
  657.     BookmarkData := Rec.ID;
  658.     BookmarkFlag := bfCurrent;
  659.   end;
  660.   for I := 0 to BlobFieldCount - 1 do
  661.     PMemBlobArray(Buffer + FBlobOfs)[I] := PMemBlobArray(Rec.FBlobs)[I];
  662.   GetCalcFields(Buffer);
  663. end;
  664.  
  665. function TRxMemoryData.GetRecord(Buffer: PChar; GetMode: TGetMode;
  666.   DoCheck: Boolean): TGetResult;
  667. var
  668.   Accept: Boolean;
  669. begin
  670.   Result := grOk;
  671.   Accept := True;
  672.   case GetMode of
  673.     gmPrior:
  674.       if FRecordPos <= 0 then begin
  675.         Result := grBOF;
  676.         FRecordPos := -1;
  677.       end
  678.       else begin
  679.         repeat
  680.           Dec(FRecordPos);
  681.           if Filtered then Accept := RecordFilter;
  682.         until Accept or (FRecordPos < 0);
  683.         if not Accept then begin
  684.           Result := grBOF;
  685.           FRecordPos := -1;
  686.         end;
  687.       end;
  688.     gmCurrent:
  689.       if (FRecordPos < 0) or (FRecordPos >= RecordCount) then
  690.         Result := grError
  691.       else if Filtered then begin
  692.         if not RecordFilter then Result := grError;
  693.       end;
  694.     gmNext:
  695.       if FRecordPos >= RecordCount - 1 then Result := grEOF
  696.       else begin
  697.         repeat
  698.           Inc(FRecordPos);
  699.           if Filtered then Accept := RecordFilter;
  700.         until Accept or (FRecordPos > RecordCount - 1);
  701.         if not Accept then begin
  702.           Result := grEOF;
  703.           FRecordPos := RecordCount - 1;
  704.         end;
  705.       end;
  706.   end;
  707.   if Result = grOk then RecordToBuffer(Records[FRecordPos], Buffer)
  708.   else if (Result = grError) and DoCheck then Error(SMemNoRecords);
  709. end;
  710.  
  711. function TRxMemoryData.GetRecordSize: Word;
  712. begin
  713.   Result := FRecordSize;
  714. end;
  715.  
  716. function TRxMemoryData.GetActiveRecBuf(var RecBuf: PChar): Boolean;
  717. begin
  718.   case State of
  719.     dsBrowse:
  720.       if IsEmpty then RecBuf := nil
  721.       else RecBuf := ActiveBuffer;
  722.     dsEdit, dsInsert: RecBuf := ActiveBuffer;
  723.     dsCalcFields: RecBuf := CalcBuffer;
  724.     dsFilter: RecBuf := TempBuffer;
  725.     else RecBuf := nil;
  726.   end;
  727.   Result := RecBuf <> nil;
  728. end;
  729.  
  730. function TRxMemoryData.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  731. var
  732.   RecBuf, Data: PChar;
  733. {$IFDEF RX_D5}
  734.   VarData: Variant;
  735. {$ENDIF}
  736. begin
  737.   Result := False;
  738.   if not GetActiveRecBuf(RecBuf) then Exit;
  739.   if Field.FieldNo > 0 then begin
  740.     Data := FindFieldData(RecBuf, Field);
  741.     if Data <> nil then begin
  742.       Result := Boolean(Data[0]);
  743.       Inc(Data);
  744.       if Field.DataType in [ftString {$IFDEF RX_D4}, ftFixedChar,
  745.         ftWideString {$ENDIF} {$IFDEF RX_D5}, ftGuid {$ENDIF}] then
  746.         Result := Result and (StrLen(Data) > 0);
  747.       if Result and (Buffer <> nil) then
  748. {$IFDEF RX_D5}
  749.         if Field.DataType = ftVariant then begin
  750.           VarData := PVariant(Data)^;
  751.           PVariant(Buffer)^ := VarData;
  752.         end else
  753. {$ENDIF}
  754.         Move(Data^, Buffer^, CalcFieldLen(Field.DataType, Field.Size));
  755.     end;
  756.   end
  757.   else begin
  758.     if State in [dsBrowse, dsEdit, dsInsert, dsCalcFields] then begin
  759.       Inc(RecBuf, FRecordSize + Field.Offset);
  760.       Result := Boolean(RecBuf[0]);
  761.       if Result and (Buffer <> nil) then
  762.         Move(RecBuf[1], Buffer^, Field.DataSize);
  763.     end;
  764.   end;
  765. end;
  766.  
  767. procedure TRxMemoryData.SetFieldData(Field: TField; Buffer: Pointer);
  768. var
  769.   RecBuf, Data: PChar;
  770. {$IFDEF RX_D5}
  771.   VarData: Variant;
  772. {$ENDIF}
  773. begin
  774.   if not (State in dsWriteModes) then Error(SNotEditing);
  775.   GetActiveRecBuf(RecBuf);
  776.   with Field do begin
  777.     if FieldNo > 0 then
  778.     begin
  779.       if State in [dsCalcFields, dsFilter] then Error(SNotEditing);
  780.       if ReadOnly and not (State in [dsSetKey, dsFilter]) then
  781.         ErrorFmt(SFieldReadOnly, [DisplayName]);
  782.       Validate(Buffer);
  783.       if FieldKind <> fkInternalCalc then begin
  784.         Data := FindFieldData(RecBuf, Field);
  785.         if Data <> nil then begin
  786. {$IFDEF RX_D5}
  787.           if DataType = ftVariant then begin
  788.             if Buffer <> nil then
  789.               VarData := PVariant(Buffer)^
  790.             else
  791.               VarData := EmptyParam;
  792.             Boolean(Data[0]) := LongBool(Buffer) and not
  793.               (VarIsNull(VarData) or VarIsEmpty(VarData));
  794.             if Boolean(Data[0]) then begin
  795.               Inc(Data);
  796.               PVariant(Data)^ := VarData;
  797.             end
  798.             else FillChar(Data^, CalcFieldLen(DataType, Size), 0);
  799.           end else
  800. {$ENDIF}
  801.           begin
  802.             Boolean(Data[0]) := LongBool(Buffer);
  803.             Inc(Data);
  804.             if LongBool(Buffer) then
  805.               Move(Buffer^, Data^, CalcFieldLen(DataType, Size))
  806.             else FillChar(Data^, CalcFieldLen(DataType, Size), 0);
  807.           end;
  808.         end;
  809.       end;
  810.     end else {fkCalculated, fkLookup}
  811.     begin
  812.       Inc(RecBuf, FRecordSize + Offset);
  813.       Boolean(RecBuf[0]) := LongBool(Buffer);
  814.       if Boolean(RecBuf[0]) then Move(Buffer^, RecBuf[1], DataSize);
  815.     end;
  816.     if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  817.       DataEvent(deFieldChange, Longint(Field));
  818.   end;
  819. end;
  820.  
  821. { Filter }
  822.  
  823. procedure TRxMemoryData.SetFiltered(Value: Boolean);
  824. begin
  825.   if Active then begin
  826.     CheckBrowseMode;
  827.     if Filtered <> Value then begin
  828.       inherited SetFiltered(Value);
  829.       First;
  830.     end;
  831.   end
  832.   else inherited SetFiltered(Value);
  833. end;
  834.  
  835. procedure TRxMemoryData.SetOnFilterRecord(const Value: TFilterRecordEvent);
  836. begin
  837.   if Active then begin
  838.     CheckBrowseMode;
  839.     inherited SetOnFilterRecord(Value);
  840.     if Filtered then First;
  841.   end
  842.   else inherited SetOnFilterRecord(Value);
  843. end;
  844.  
  845. function TRxMemoryData.RecordFilter: Boolean;
  846. var
  847.   SaveState: TDataSetState;
  848. begin
  849.   Result := True;
  850.   if Assigned(OnFilterRecord) then begin
  851.     if (FRecordPos >= 0) and (FRecordPos < RecordCount) then begin
  852.       SaveState := SetTempState(dsFilter);
  853.       try
  854.         RecordToBuffer(Records[FRecordPos], TempBuffer);
  855.         OnFilterRecord(Self, Result);
  856.       except
  857.         Application.HandleException(Self);
  858.       end;
  859.       RestoreState(SaveState);
  860.     end
  861.     else Result := False;
  862.   end;
  863. end;
  864.  
  865. { Blobs }
  866.  
  867. function TRxMemoryData.GetBlobData(Field: TField; Buffer: PChar): TMemBlobData;
  868. begin
  869.   Result := PMemBlobArray(Buffer + FBlobOfs)[Field.Offset];
  870. end;
  871.  
  872. procedure TRxMemoryData.SetBlobData(Field: TField; Buffer: PChar;
  873.   Value: TMemBlobData);
  874. begin
  875.   if (Buffer = ActiveBuffer) then begin
  876.     if State = dsFilter then Error(SNotEditing);
  877.     PMemBlobArray(Buffer + FBlobOfs)[Field.Offset] := Value;
  878.   end;
  879. end;
  880.  
  881. procedure TRxMemoryData.CloseBlob(Field: TField);
  882. begin
  883.   if (FRecordPos >= 0) and (FRecordPos < FRecords.Count) and
  884.     (State = dsEdit) then
  885.     PMemBlobArray(ActiveBuffer + FBlobOfs)[Field.Offset] := 
  886.       PMemBlobArray(Records[FRecordPos].FBlobs)[Field.Offset]
  887.   else PMemBlobArray(ActiveBuffer + FBlobOfs)[Field.Offset] := '';
  888. end;
  889.  
  890. function TRxMemoryData.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  891. begin
  892.   Result := TMemBlobStream.Create(Field as TBlobField, Mode);
  893. end;
  894.  
  895. { Bookmarks }
  896.  
  897. function TRxMemoryData.BookmarkValid(Bookmark: TBookmark): Boolean;
  898. begin
  899.   Result := FActive and (TBookmarkData(Bookmark^) > Low(Integer)) and
  900.     (TBookmarkData(Bookmark^) <= FLastID);
  901. end;
  902.  
  903. function TRxMemoryData.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
  904. begin
  905.   if (Bookmark1 = nil) and (Bookmark2 = nil) then Result := 0
  906.   else if (Bookmark1 <> nil) and (Bookmark2 = nil) then Result := 1
  907.   else if (Bookmark1 = nil) and (Bookmark2 <> nil) then Result := -1
  908.   else if TBookmarkData(Bookmark1^) > TBookmarkData(Bookmark2^) then
  909.     Result := 1
  910.   else if TBookmarkData(Bookmark1^) < TBookmarkData(Bookmark2^) then
  911.     Result := -1
  912.   else Result := 0;
  913. end;
  914.  
  915. procedure TRxMemoryData.GetBookmarkData(Buffer: PChar; Data: Pointer);
  916. begin
  917.   Move(PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkData, Data^,
  918.     SizeOf(TBookmarkData));
  919. end;
  920.  
  921. procedure TRxMemoryData.SetBookmarkData(Buffer: PChar; Data: Pointer);
  922. begin
  923.   Move(Data^, PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkData,
  924.     SizeOf(TBookmarkData));
  925. end;
  926.  
  927. function TRxMemoryData.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  928. begin
  929.   Result := PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkFlag;
  930. end;
  931.  
  932. procedure TRxMemoryData.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  933. begin
  934.   PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkFlag := Value;
  935. end;
  936.  
  937. procedure TRxMemoryData.InternalGotoBookmark(Bookmark: TBookmark);
  938. var
  939.   Rec: TMemoryRecord;
  940.   SavePos: Integer;
  941.   Accept: Boolean;
  942. begin
  943.   Rec := FindRecordID(TBookmarkData(Bookmark^));
  944.   if Rec <> nil then begin
  945.     Accept := True;
  946.     SavePos := FRecordPos;
  947.     try
  948.       FRecordPos := Rec.Index;
  949.       if Filtered then Accept := RecordFilter;
  950.     finally
  951.       if not Accept then FRecordPos := SavePos;
  952.     end;
  953.   end;
  954. end;
  955.  
  956. { Navigation }
  957.  
  958. procedure TRxMemoryData.InternalSetToRecord(Buffer: PChar);
  959. begin
  960.   InternalGotoBookmark(@PMemBookmarkInfo(Buffer + FBookmarkOfs)^.BookmarkData);
  961. end;
  962.  
  963. procedure TRxMemoryData.InternalFirst;
  964. begin
  965.   FRecordPos := -1;
  966. end;
  967.  
  968. procedure TRxMemoryData.InternalLast;
  969. begin
  970.   FRecordPos := FRecords.Count;
  971. end;
  972.  
  973. { Data Manipulation }
  974.  
  975. procedure TRxMemoryData.AssignMemoryRecord(Rec: TMemoryRecord; Buffer: PChar);
  976. var
  977.   I: Integer;
  978. begin
  979.   Move(Buffer^, Rec.Data^, FRecordSize);
  980.   for I := 0 to BlobFieldCount - 1 do
  981.     PMemBlobArray(Rec.FBlobs)[I] := PMemBlobArray(Buffer + FBlobOfs)[I];
  982. end;
  983.  
  984. procedure TRxMemoryData.SetMemoryRecordData(Buffer: PChar; Pos: Integer);
  985. var
  986.   Rec: TMemoryRecord;
  987. begin
  988.   if State = dsFilter then Error(SNotEditing);
  989.   Rec := Records[Pos];
  990.   AssignMemoryRecord(Rec, Buffer);
  991. end;
  992.  
  993. procedure TRxMemoryData.SetAutoIncFields(Buffer: PChar);
  994. var
  995.   I, Count: Integer;
  996.   Data: PChar;
  997. begin
  998.   Count := 0;
  999.   for I := 0 to FieldCount - 1 do
  1000.     if (Fields[I].FieldKind in fkStoredFields) and
  1001.       (Fields[I].DataType = ftAutoInc) then
  1002.     begin
  1003.       Data := FindFieldData(Buffer, Fields[I]);
  1004.       if Data <> nil then begin
  1005.         Boolean(Data[0]) := True;
  1006.         Inc(Data);
  1007.         Move(FAutoInc, Data^, SizeOf(Longint));
  1008.         Inc(Count);
  1009.       end;
  1010.     end;
  1011.   if Count > 0 then Inc(FAutoInc);
  1012. end;
  1013.  
  1014. procedure TRxMemoryData.InternalAddRecord(Buffer: Pointer; Append: Boolean);
  1015. var
  1016.   RecPos: Integer;
  1017.   Rec: TMemoryRecord;
  1018. begin
  1019.   if Append then begin
  1020.     Rec := AddRecord;
  1021.     FRecordPos := FRecords.Count - 1;
  1022.   end
  1023.   else begin
  1024.     if FRecordPos = -1 then RecPos := 0
  1025.     else RecPos := FRecordPos;
  1026.     Rec := InsertRecord(RecPos);
  1027.     FRecordPos := RecPos;
  1028.   end;
  1029.   SetAutoIncFields(Buffer);
  1030.   SetMemoryRecordData(Buffer, Rec.Index);
  1031. end;
  1032.  
  1033. procedure TRxMemoryData.InternalDelete;
  1034. var
  1035.   Accept: Boolean;
  1036. begin
  1037.   Records[FRecordPos].Free;
  1038.   if FRecordPos >= FRecords.Count then Dec(FRecordPos);
  1039.   Accept := True;
  1040.   repeat
  1041.     if Filtered then Accept := RecordFilter;
  1042.     if not Accept then Dec(FRecordPos);
  1043.   until Accept or (FRecordPos < 0);
  1044.   if FRecords.Count = 0 then FLastID := Low(Integer);
  1045. end;
  1046.  
  1047. procedure TRxMemoryData.InternalPost;
  1048. var
  1049.   RecPos: Integer;
  1050. begin
  1051.   if State = dsEdit then
  1052.     SetMemoryRecordData(ActiveBuffer, FRecordPos)
  1053.   else begin
  1054.     if State in [dsInsert] then SetAutoIncFields(ActiveBuffer);
  1055.     if FRecordPos >= FRecords.Count then begin
  1056.       SetMemoryRecordData(ActiveBuffer, AddRecord.Index);
  1057.       FRecordPos := FRecords.Count - 1;
  1058.     end
  1059.     else begin
  1060.       if FRecordPos = -1 then RecPos := 0
  1061.       else RecPos := FRecordPos;
  1062.       SetMemoryRecordData(ActiveBuffer, InsertRecord(RecPos).Index);
  1063.       FRecordPos := RecPos;
  1064.     end;
  1065.   end;
  1066. end;
  1067.  
  1068. procedure TRxMemoryData.OpenCursor(InfoQuery: Boolean);
  1069. begin
  1070.   if not InfoQuery then begin
  1071.     if FieldCount > 0 then FieldDefs.Clear;
  1072.     InitFieldDefsFromFields;
  1073.   end;
  1074.   FActive := True;
  1075.   inherited OpenCursor(InfoQuery);
  1076. end;
  1077.  
  1078. procedure TRxMemoryData.InternalOpen;
  1079. begin
  1080.   BookmarkSize := SizeOf(TBookmarkData);
  1081. {$IFDEF RX_D4}
  1082.   if DefaultFields then CreateFields;
  1083. {$ELSE}
  1084.   if DefaultFields then Error(SInvalidFields);
  1085. {$ENDIF}
  1086.   BindFields(True);
  1087.   InitBufferPointers(True);
  1088.   InternalFirst;
  1089. end;
  1090.  
  1091. procedure TRxMemoryData.InternalClose;
  1092. begin
  1093.   ClearRecords;
  1094.   FAutoInc := 1;
  1095.   BindFields(False);
  1096. {$IFDEF RX_D4}
  1097.   if DefaultFields then DestroyFields;
  1098. {$ENDIF}
  1099.   FreeIndexList;
  1100.   FActive := False;
  1101. end;
  1102.  
  1103. procedure TRxMemoryData.InternalHandleException;
  1104. begin
  1105.   Application.HandleException(Self);
  1106. end;
  1107.  
  1108. procedure TRxMemoryData.InternalInitFieldDefs;
  1109. begin
  1110. end;
  1111.  
  1112. function TRxMemoryData.IsCursorOpen: Boolean;
  1113. begin
  1114.   Result := FActive;
  1115. end;
  1116.  
  1117. { Informational }
  1118.  
  1119. function TRxMemoryData.GetRecordCount: Integer;
  1120. begin
  1121.   Result := FRecords.Count;
  1122. end;
  1123.  
  1124. function TRxMemoryData.GetRecNo: Integer;
  1125. begin
  1126.   CheckActive;
  1127.   UpdateCursorPos;
  1128.   if (FRecordPos = -1) and (RecordCount > 0) then Result := 1
  1129.   else Result := FRecordPos + 1;
  1130. end;
  1131.  
  1132. procedure TRxMemoryData.SetRecNo(Value: Integer);
  1133. begin
  1134.   if (Value > 0) and (Value <= FRecords.Count) then begin
  1135.     FRecordPos := Value - 1;
  1136.     Resync([]);
  1137.   end;
  1138. end;
  1139.  
  1140. function TRxMemoryData.IsSequenced: Boolean;
  1141. begin
  1142.   Result := not Filtered;
  1143. end;
  1144.  
  1145. function TRxMemoryData.Locate(const KeyFields: string;
  1146.   const KeyValues: Variant; Options: TLocateOptions): Boolean;
  1147. begin
  1148.   DoBeforeScroll;
  1149.   Result := DataSetLocateThrough(Self, KeyFields, KeyValues, Options);
  1150.   if Result then begin
  1151.     DataEvent(deDataSetChange, 0);
  1152.     DoAfterScroll;
  1153.   end;
  1154. end;
  1155.  
  1156. { Table Manipulation }
  1157.  
  1158. procedure TRxMemoryData.EmptyTable;
  1159. begin
  1160.   if Active then begin
  1161.     CheckBrowseMode;
  1162.     ClearRecords;
  1163.     ClearBuffers;
  1164.     DataEvent(deDataSetChange, 0);
  1165.   end;
  1166. end;
  1167.  
  1168. procedure TRxMemoryData.CopyStructure(Source: TDataSet);
  1169.  
  1170.   procedure CheckDataTypes(FieldDefs: TFieldDefs);
  1171.   var
  1172.     I: Integer;
  1173.   begin
  1174.     for I := FieldDefs.Count - 1 downto 0 do begin
  1175.       if not (FieldDefs.Items[I].DataType in ftSupported) then
  1176.         FieldDefs.Items[I].Free
  1177. {$IFDEF RX_D4}
  1178.       else CheckDataTypes(FieldDefs[I].ChildDefs);
  1179. {$ENDIF}
  1180.     end;
  1181.   end;
  1182.  
  1183. var
  1184.   I: Integer;
  1185. begin
  1186.   CheckInactive;
  1187.   for I := FieldCount - 1 downto 0 do Fields[I].Free;
  1188.   if (Source = nil) then Exit;
  1189.   Source.FieldDefs.Update;
  1190.   FieldDefs := Source.FieldDefs;
  1191.   CheckDataTypes(FieldDefs);
  1192. {$IFDEF RX_D4}
  1193.   CreateFields;
  1194. {$ELSE}
  1195.   for I := 0 to FieldDefs.Count - 1 do begin
  1196.     if (csDesigning in ComponentState) and (Owner <> nil) then
  1197.       FieldDefs.Items[I].CreateField(Owner)
  1198.     else
  1199.       FieldDefs.Items[I].CreateField(Self);
  1200.   end;
  1201. {$ENDIF}
  1202. end;
  1203.  
  1204. function TRxMemoryData.LoadFromDataSet(Source: TDataSet; RecordCount: Integer;
  1205.   Mode: TLoadMode): Integer;
  1206. var
  1207.   SourceActive: Boolean;
  1208.   MovedCount: Integer;
  1209. begin
  1210.   Result := 0;
  1211.   if Source = Self then Exit;
  1212.   SourceActive := Source.Active;
  1213.   Source.DisableControls;
  1214.   try
  1215.     DisableControls;
  1216.     try
  1217.       Filtered := False;
  1218.       with Source do begin
  1219.         Open;
  1220.         CheckBrowseMode;
  1221.         UpdateCursorPos;
  1222.       end;
  1223.       if Mode = lmCopy then begin
  1224.         Close;
  1225.         CopyStructure(Source);
  1226.       end;
  1227.       FreeIndexList;
  1228.       if not Active then Open;
  1229.       CheckBrowseMode;
  1230.       if RecordCount > 0 then MovedCount := RecordCount
  1231.       else begin
  1232.         Source.First;
  1233.         MovedCount := MaxInt;
  1234.       end;
  1235.       try
  1236.         while not Source.EOF do begin
  1237.           Append;
  1238.           AssignRecord(Source, Self, True);
  1239.           Post;
  1240.           Inc(Result);
  1241.           if Result >= MovedCount then Break;
  1242.           Source.Next;
  1243.         end;
  1244.       finally
  1245.         First;
  1246.       end;
  1247.     finally
  1248.       EnableControls;
  1249.     end;
  1250.   finally
  1251.     if not SourceActive then Source.Close;
  1252.     Source.EnableControls;
  1253.   end;
  1254. end;
  1255.  
  1256. function TRxMemoryData.SaveToDataSet(Dest: TDataSet; RecordCount: Integer): Integer;
  1257. var
  1258.   MovedCount: Integer;
  1259. begin
  1260.   Result := 0;
  1261.   if Dest = Self then Exit;
  1262.   CheckBrowseMode;
  1263.   UpdateCursorPos;
  1264.   Dest.DisableControls;
  1265.   try
  1266.     DisableControls;
  1267.     try
  1268.       if not Dest.Active then Dest.Open
  1269.       else Dest.CheckBrowseMode;
  1270.       if RecordCount > 0 then MovedCount := RecordCount
  1271.       else begin
  1272.         First;
  1273.         MovedCount := MaxInt;
  1274.       end;
  1275.       try
  1276.         while not EOF do begin
  1277.           Dest.Append;
  1278.           AssignRecord(Self, Dest, True);
  1279.           Dest.Post;
  1280.           Inc(Result);
  1281.           if Result >= MovedCount then Break;
  1282.           Next;
  1283.         end;
  1284.       finally
  1285.         Dest.First;
  1286.       end;
  1287.     finally
  1288.       EnableControls;
  1289.     end;
  1290.   finally
  1291.     Dest.EnableControls;
  1292.   end;
  1293. end;
  1294.  
  1295. { Index Related }
  1296.  
  1297. procedure TRxMemoryData.SortOnFields(const FieldNames: string;
  1298. {$IFDEF RX_D4}
  1299.   CaseInsensitive: Boolean = True; Descending: Boolean = False);
  1300. {$ELSE}
  1301.   CaseInsensitive, Descending: Boolean);
  1302. {$ENDIF}
  1303. begin
  1304.   CreateIndexList(FieldNames);
  1305.   FCaseInsensitiveSort := CaseInsensitive;
  1306.   FDescendingSort := Descending;
  1307.   try
  1308.     Sort;
  1309.   except
  1310.     FreeIndexList;
  1311.     raise;
  1312.   end;
  1313. end;
  1314.  
  1315. procedure TRxMemoryData.Sort;
  1316. var
  1317.   Pos: TBookmarkStr;
  1318. begin
  1319.   if Active and (FRecords <> nil) and (FRecords.Count > 0) then begin
  1320.     Pos := Bookmark;
  1321.     try
  1322.       QuickSort(0, FRecords.Count - 1, CompareRecords);
  1323.       SetBufListSize(0);
  1324.       InitBufferPointers(False);
  1325.       try
  1326.         SetBufListSize(BufferCount + 1);
  1327.       except
  1328.         SetState(dsInactive);
  1329.         CloseCursor;
  1330.         raise;
  1331.       end;
  1332.     finally
  1333.       Bookmark := Pos;
  1334.     end;
  1335.     Resync([]);
  1336.   end;
  1337. end;
  1338.  
  1339. procedure TRxMemoryData.QuickSort(L, R: Integer; Compare: TCompareRecords);
  1340. var
  1341.   I, J: Integer;
  1342.   P: TMemoryRecord;
  1343. begin
  1344.   repeat
  1345.     I := L;
  1346.     J := R;
  1347.     P := Records[(L + R) shr 1];
  1348.     repeat
  1349.       while Compare(Records[I], P) < 0 do Inc(I);
  1350.       while Compare(Records[J], P) > 0 do Dec(J);
  1351.       if I <= J then begin
  1352.         FRecords.Exchange(I, J);
  1353.         Inc(I);
  1354.         Dec(J);
  1355.       end;
  1356.     until I > J;
  1357.     if L < J then QuickSort(L, J, Compare);
  1358.     L := I;
  1359.   until I >= R;
  1360. end;
  1361.  
  1362. function TRxMemoryData.CompareRecords(Item1, Item2: TMemoryRecord): Integer;
  1363. var
  1364.   Data1, Data2: PChar;
  1365.   F: TField;
  1366.   I: Integer;
  1367. begin
  1368.   Result := 0;
  1369.   if FIndexList <> nil then begin
  1370.     for I := 0 to FIndexList.Count - 1 do begin
  1371.       F := TField(FIndexList[I]);
  1372.       Data1 := FindFieldData(Item1.Data, F);
  1373.       if Data1 <> nil then begin
  1374.         Data2 := FindFieldData(Item2.Data, F);
  1375.         if Data2 <> nil then begin
  1376.           if Boolean(Data1[0]) and Boolean(Data2[0]) then begin
  1377.             Inc(Data1);
  1378.             Inc(Data2);
  1379.             Result := CompareFields(Data1, Data2, F.DataType,
  1380.               FCaseInsensitiveSort);
  1381.           end
  1382.           else if Boolean(Data1[0]) then Result := 1
  1383.           else if Boolean(Data2[0]) then Result := -1;
  1384.           if FDescendingSort then Result := -Result;
  1385.         end;
  1386.       end;
  1387.       if Result <> 0 then Exit;
  1388.     end;
  1389.   end;
  1390.   if (Result = 0) then begin
  1391.     if Item1.ID > Item2.ID then Result := 1
  1392.     else if Item1.ID < Item2.ID then Result := -1;
  1393.     if FDescendingSort then Result := -Result;
  1394.   end;
  1395. end;
  1396.  
  1397. function TRxMemoryData.GetIsIndexField(Field: TField): Boolean;
  1398. begin
  1399.   if FIndexList <> nil then
  1400.     Result := FIndexList.IndexOf(Field) >= 0
  1401.   else Result := False;
  1402. end;
  1403.  
  1404. procedure TRxMemoryData.CreateIndexList(const FieldNames: string);
  1405. var
  1406.   Pos: Integer;
  1407.   F: TField;
  1408. begin
  1409.   if FIndexList = nil then FIndexList := TList.Create
  1410.   else FIndexList.Clear;
  1411.   Pos := 1;
  1412.   while Pos <= Length(FieldNames) do begin
  1413.     F := FieldByName(ExtractFieldName(FieldNames, Pos));
  1414.     if (F.FieldKind = fkData) and
  1415.       (F.DataType in ftSupported - ftBlobTypes) then
  1416.       FIndexList.Add(F)
  1417.     else ErrorFmt(SFieldTypeMismatch, [F.DisplayName]);
  1418.   end;
  1419. end;
  1420.  
  1421. procedure TRxMemoryData.FreeIndexList;
  1422. begin
  1423.   FIndexList.Free;
  1424.   FIndexList := nil;
  1425. end;
  1426.  
  1427. { TMemBlobStream }
  1428.  
  1429. constructor TMemBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
  1430. begin
  1431.   FMode := Mode;
  1432.   FField := Field;
  1433.   FDataSet := FField.DataSet as TRxMemoryData;
  1434.   if not FDataSet.GetActiveRecBuf(FBuffer) then Exit;
  1435.   if not FField.Modified and (Mode <> bmRead) then begin
  1436.     if FField.ReadOnly then ErrorFmt(SFieldReadOnly, [FField.DisplayName]);
  1437.     if not (FDataSet.State in [dsEdit, dsInsert]) then Error(SNotEditing);
  1438.     FCached := True;
  1439.   end
  1440.   else FCached := (FBuffer = FDataSet.ActiveBuffer);
  1441.   FOpened := True;
  1442.   if Mode = bmWrite then Truncate;
  1443. end;
  1444.  
  1445. destructor TMemBlobStream.Destroy;
  1446. begin
  1447.   if FOpened and FModified then FField.Modified := True;
  1448.   if FModified then
  1449.   try
  1450.     FDataSet.DataEvent(deFieldChange, Longint(FField));
  1451.   except
  1452.     Application.HandleException(Self);
  1453.   end;
  1454. end;
  1455.  
  1456. function TMemBlobStream.GetBlobFromRecord(Field: TField): TMemBlobData;
  1457. var
  1458.   Rec: TMemoryRecord;
  1459.   Pos: Integer;
  1460. begin
  1461.   Result := '';
  1462.   Pos := FDataSet.FRecordPos;
  1463.   if (Pos < 0) and (FDataSet.RecordCount > 0) then Pos := 0
  1464.   else if Pos >= FDataSet.RecordCount then Pos := FDataSet.RecordCount - 1;
  1465.   if (Pos >= 0) and (Pos < FDataSet.RecordCount) then begin
  1466.     Rec := FDataSet.Records[Pos];
  1467.     if Rec <> nil then 
  1468.       Result := PMemBlobArray(Rec.FBlobs)[FField.Offset];
  1469.   end;
  1470. end;
  1471.  
  1472. function TMemBlobStream.Read(var Buffer; Count: Longint): Longint;
  1473. begin
  1474.   Result := 0;
  1475.   if FOpened then begin
  1476.     if Count > Size - FPosition then Result := Size - FPosition
  1477.     else Result := Count;
  1478.     if Result > 0 then begin
  1479.       if FCached then begin
  1480.         Move(PChar(FDataSet.GetBlobData(FField, FBuffer))[FPosition], Buffer,
  1481.           Result);
  1482.         Inc(FPosition, Result);
  1483.       end
  1484.       else begin
  1485.         Move(PChar(GetBlobFromRecord(FField))[FPosition], Buffer,
  1486.           Result);
  1487.         Inc(FPosition, Result);
  1488.       end;
  1489.     end;
  1490.   end;
  1491. end;
  1492.  
  1493. function TMemBlobStream.Write(const Buffer; Count: Longint): Longint;
  1494. var
  1495.   Temp: TMemBlobData;
  1496. begin
  1497.   Result := 0;
  1498.   if FOpened and FCached and (FMode <> bmRead) then begin
  1499.     Temp := FDataSet.GetBlobData(FField, FBuffer);
  1500.     if Length(Temp) < FPosition + Count then
  1501.       SetLength(Temp, FPosition + Count);
  1502.     Move(Buffer, PChar(Temp)[FPosition], Count);
  1503.     FDataSet.SetBlobData(FField, FBuffer, Temp);
  1504.     Inc(FPosition, Count);
  1505.     Result := Count;
  1506.     FModified := True;
  1507.   end;
  1508. end;
  1509.  
  1510. function TMemBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
  1511. begin
  1512.   case Origin of
  1513.     0: FPosition := Offset;
  1514.     1: Inc(FPosition, Offset);
  1515.     2: FPosition := GetBlobSize + Offset;
  1516.   end;
  1517.   Result := FPosition;
  1518. end;
  1519.  
  1520. procedure TMemBlobStream.Truncate;
  1521. begin
  1522.   if FOpened and FCached and (FMode <> bmRead) then begin
  1523.     FDataSet.SetBlobData(FField, FBuffer, '');
  1524.     FModified := True;
  1525.   end;
  1526. end;
  1527.  
  1528. function TMemBlobStream.GetBlobSize: Longint;
  1529. begin
  1530.   Result := 0;
  1531.   if FOpened then
  1532.     if FCached then
  1533.       Result := Length(FDataSet.GetBlobData(FField, FBuffer))
  1534.     else
  1535.       Result := Length(GetBlobFromRecord(FField))
  1536. end;
  1537.  
  1538. {$ENDIF RX_D3}
  1539.  
  1540. end.