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