dxmdaset.pas

在Dephi中用于文件的输出

{*******************************************************************}
{                                                                   }
{       Developer Express Visual Component Library                  }
{       ExpressMemData - CLX/VCL Edition                            }
{                                                                   }
{       Copyright (c) 1998-2008 Developer Express Inc.              }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, DPU, SO, ETC.) ARE CONFIDENTIAL AND PROPRIETARY }
{   TRADE SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER}
{   IS LICENSED TO DISTRIBUTE THE EXPRESSMEMDATA                    }
{   AS PART OF AN EXECUTABLE PROGRAM ONLY.                          }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT  }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                      }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit dxmdaset;

interface

{$I cxVer.inc}

uses
  DB, Classes, SysUtils;

type
  TdxMemData = class;
  TdxMemFields = class;

  TMemBlobData = string;
  TBytes = array of Byte;
  TRecordBuffer = PChar;
  TBookMarkStr = string;
  TValueBuffer = Pointer;

  TdxMemField = class
  private
    FField : TField;
    FDataType : TFieldType;
    FDataSize : Integer;
    FOffSet : Integer;
    FValueOffSet : Integer;
    FMaxIncValue : Integer;
    FOwner : TdxMemFields;
    FIndex : Integer;
    FIsRecId : Boolean;
    FIsNeedAutoInc : Boolean;

    function DataPointer(AIndex, AOffset: Integer): TRecordBuffer;

    function GetValues(AIndex: Integer): TRecordBuffer;
    function GetHasValue(AIndex: Integer): Boolean;
    function GetHasValues(AIndex: Integer): Char;
    procedure SetHasValue(AIndex: Integer; AValue: Boolean);
    procedure SetHasValues(AIndex: Integer; AValue: Char);

    procedure SetAutoIncValue(const Buffer : TRecordBuffer; Value : TRecordBuffer);

    function GetDataSet : TdxMemData;
    function GetMemFields : TdxMemFields;

    property HasValue[Index: Integer]: Boolean read GetHasValue write SetHasValue;
  protected
    procedure CreateField(Field : TField); virtual;

    function GetActiveBuffer(AActiveBuffer, ABuffer: TRecordBuffer): Boolean;
    procedure SetActiveBuffer(AActiveBuffer, ABuffer: TRecordBuffer);

    property MemFields : TDxMemFields read GetMemFields;
  public
    constructor Create(AOwner : TdxMemFields);

    procedure AddValue(const Buffer : TRecordBuffer);
    procedure InsertValue(AIndex : Integer; const Buffer : TRecordBuffer);
    function GetDataFromBuffer(const ABuffer: TRecordBuffer): TRecordBuffer;
    function GetHasValueFromBuffer(const ABuffer: TRecordBuffer): Char;
    function GetValueFromBuffer(const ABuffer: TRecordBuffer): TRecordBuffer;

    //For the guys from AQA.
    property OffSet: Integer read FValueOffSet;

    property DataSet : TdxMemData read GetDataSet;
    property Field : TField read FField;
    property Index : Integer read FIndex;
    property Values[Index : Integer] : TRecordBuffer read GetValues;
    property HasValues[Index : Integer] : Char read GetHasValues write SetHasValues;
  end;

  TdxMemFields = class
  private
    FItems : TList;
    FCalcFields : TList;
    FDataSet : TdxMemData;
    FValues : TList;
    FIsNeedAutoIncList : TList;
    FValuesSize : Integer;

    function GetRecordCount : Integer;
    function GetItem(Index : Integer)  : TdxMemField;
  protected
    function Add(AField : TField) : TdxMemField;
    procedure Clear;
    procedure DeleteRecord(AIndex : Integer);

    procedure InsertRecord(const Buffer: TRecordBuffer; AIndex : Integer; Append: Boolean);

    procedure AddField(Field : TField);
    procedure RemoveField(Field : TField);
  public
    constructor Create(ADataSet : TdxMemData);
    destructor Destroy; override;

    procedure GetBuffer(Buffer : TRecordBuffer; AIndex : Integer);
    procedure SetBuffer(Buffer : TRecordBuffer; AIndex : Integer);
    function GetActiveBuffer(ActiveBuffer, Buffer : TRecordBuffer; Field : TField) : Boolean;
    procedure SetActiveBuffer(ActiveBuffer, Buffer : TRecordBuffer; Field : TField);
    function GetCount : Integer;
    function IndexOf(Field : TField) : TdxMemField;

    function GetValue(mField : TdxMemField; Index : Integer) : TRecordBuffer;
    function GetHasValue(mField : TdxMemField; Index : Integer) : char;
    procedure SetValue(mField : TdxMemField; Index : Integer; Buffer : TRecordBuffer);
    procedure SetHasValue(mField : TdxMemField; Index : Integer; Value : char);

    //For the guys from AQA.
    property Values: TList read FValues;

    property DataSet : TdxMemData read FDataSet;
    property Count : Integer read GetCount;
    property Items[Index : Integer] : TdxMemField read GetItem;
    property RecordCount : Integer read GetRecordCount;
  end;

  PdxRecInfo = ^TdxRecInfo;
  TdxRecInfo = packed record
    Bookmark: Integer;
    BookmarkFlag: TBookmarkFlag;
  end;

  { TBlobStream }

  TMemBlobStream = class(TStream)
  private
    FField: TBlobField;
    FDataSet: TdxMemData;
    FBuffer: TRecordBuffer;
    FMode: TBlobStreamMode;
    FOpened: Boolean;
    FModified: Boolean;
    FPosition: Longint;
    FCached: Boolean;
    function GetBlobSize: Longint;
  public
    constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    procedure Truncate;
  end;

  { TdxMemData }
  TdxSortOption = (soDesc, soCaseInsensitive);
  TdxSortOptions = set of TdxSortOption;

  TdxMemIndex = class(TCollectionItem)
  private
    fIsDirty: Boolean;
    fField: TField;
    FSortOptions: TdxSortOptions;
    fLoadedFieldName: String;
    fFieldName: String;
    FValueList: TList;
    FIndexList: TList;

    procedure SetIsDirty(Value: Boolean);
    procedure DeleteRecord(pRecord: TRecordBuffer);
    procedure UpdateRecord(pRecord: TRecordBuffer);
    procedure SetFieldName(Value: String);
    procedure SetSortOptions(Value: TdxSortOptions);
    procedure SetFieldNameAfterMemdataLoaded;
  protected
    function GetMemData: TdxMemData;
    procedure Prepare;
    function GotoNearest(const Buffer : TRecordBuffer; out Index : Integer) : Boolean;

    property IsDirty: Boolean read fIsDirty write SetIsDirty;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    property MemData: TdxMemData read GetMemData;
  published
    property FieldName: String read fFieldName write SetFieldName;
    property SortOptions: TdxSortOptions read FSortOptions write SetSortOptions;
  end;

  TdxMemIndexes = class(TCollection)
  private
    fMemData: TdxMemData;
  protected
    function GetOwner: TPersistent; override;
    procedure SetIsDirty;
    procedure DeleteRecord(pRecord: TRecordBuffer);
    procedure UpdateRecord(pRecord: TRecordBuffer);
    procedure RemoveField(AField: TField);
    procedure CheckFields;
    procedure AfterMemdataLoaded;
  public
    function Add: TdxMemIndex;
    function GetIndexByField(AField: TField): TdxMemIndex;

    property MemData: TdxMemData read fMemData;
  end;

  TdxMemPersistentOption = (poNone, poActive, poLoad);

  TdxMemPersistent = class(TPersistent)
  private
    FStream: TMemoryStream;
    FOption: TdxMemPersistentOption;
    FMemData: TdxMemData;
    FIsLoadFromPersistent: Boolean;

    procedure ReadData(Stream: TStream);
    procedure WriteData(Stream: TStream);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AMemData: TdxMemData);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveData;
    procedure LoadData;

    function HasData: Boolean;

    property MemData: TdxMemData read FMemData;
  published
    property Option: TdxMemPersistentOption read FOption write FOption default poActive;
  end;

  TdxMemData = class(TDataSet)
  private
    FActive : Boolean;
    FData : TdxMemFields;
    FRecBufSize: Integer;
    FRecInfoOfs: Integer;
    FCurRec: Integer;
    FFilterCurRec : Integer;
    FBookMarks : TList;
    FBlobList : TList;
    FFilterList : TList;
    FLastBookmark: Integer;
    FSaveChanges: Boolean;
    FReadOnly : Boolean;
    FRecIdField : TField;
    FSortOptions : TdxSortOptions;
    FSortedFieldName : String;
    FSortedField : TField;
    FLoadFlag : Boolean;
    FDelimiterChar : Char;
    FIsFiltered : Boolean;
    FGotoNearestMin : Integer;
    FGotoNearestMax : Integer;
    FProgrammedFilter    : Boolean;
    fIndexes: TdxMemIndexes;
    fPersistent: TdxMemPersistent;

    function AllocBufferForField(AField: TField): Pointer;
    function GetSortOptions : TdxSortOptions;
    procedure FillValueList(const AList: TList);
    procedure SetSortedField(Value : String);
    procedure SetSortOptions(Value : TdxSortOptions);
    procedure SetIndexes(Value : TdxMemIndexes);
    procedure SetPersistent(Value: TdxMemPersistent);
    function GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
    procedure DoSort(List : TList; AmField: TdxMemField; ASortOptions: TdxSortOptions; ExhangeList: TList);
    procedure MakeSort;
    procedure GetLookupFields(List: TList);
    procedure CreateRecIDField;

    procedure CheckFields(FieldsName: string);
    function GetStringLength(AFieldType: TFieldType; const ABuffer: Pointer): Integer;
    function InternalSetRecNo(const Value: Integer): Integer;
    function InternalLocate(const KeyFields: string; const KeyValues: Variant;
                  Options: TLocateOptions): Integer;
    procedure UpdateRecordFilteringAndSorting(AIsMakeSort : Boolean);
    function InternalIsFiltering: Boolean;
  protected
    procedure InitializeBlobData(Buffer: TValueBuffer);
    procedure FinalizeBlobData(Buffer: TValueBuffer);
    function GetBlobData(Buffer: TRecordBuffer; AOffSet: Integer): TMemBlobData; overload;
    function GetBlobData(Buffer: TRecordBuffer; Field: TField): TMemBlobData; overload;
    procedure SetInternalBlobData(Buffer: TRecordBuffer; AOffSet: Integer; const Value: TMemBlobData); virtual;
    procedure SetBlobData(Buffer: TRecordBuffer; AOffSet: Integer; const Value: TMemBlobData); overload;
    procedure SetBlobData(Buffer: TRecordBuffer; Field: TField; const Value: TMemBlobData); overload;
    function GetActiveBlobData(Field: TField): TMemBlobData;
    procedure GetMemBlobData(Buffer : TRecordBuffer);
    procedure SetMemBlobData(Buffer : TRecordBuffer);
    procedure BlobClear;

    procedure Loaded; override;
    function AllocRecordBuffer: TRecordBuffer; override;
    procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
    procedure GetBookmarkData(Buffer: TRecordBuffer; Data: TBookMark); override;
    function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordSize: Word; override;
    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
    procedure InternalInsert; override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark(Bookmark: TBookmark); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: TRecordBuffer); override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalRefresh; override;
    procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
    function IsCursorOpen: Boolean; override;
    procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: TRecordBuffer; Data: TBookmark); override;
    procedure SetFieldData(Field: TField; Buffer: TValueBuffer); override;
    procedure SetFieldData(Field: TField; Buffer: TValueBuffer; NativeFormat: Boolean); override;
    function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;

    procedure DoAfterCancel; override;
    procedure DoAfterClose; override;
    procedure DoAfterInsert; override;
    procedure DoAfterOpen; override;
    procedure DoAfterPost; override;
    procedure DoBeforeClose; override;
    procedure DoBeforeInsert; override;
    procedure DoBeforeOpen; override;
    procedure DoBeforePost; override;
    procedure DoOnNewRecord; override;
  protected
    function GetRecordCount: Integer; override;
    function GetRecNo: Integer; override;
    procedure SetRecNo(Value: Integer); override;
    function GetCanModify: Boolean; override;
    procedure ClearCalcFields(Buffer: TRecordBuffer); override;
    procedure SetFiltered(Value: Boolean); override;

    function GetStringValue(const Buffer : TRecordBuffer; ADataSize: Integer) : String;
    function GetIntegerValue(const Buffer : TRecordBuffer; DataType : TFieldType) : Integer;
    function GetLargeIntValue(const Buffer : TRecordBuffer; DataType : TFieldType) : Int64;
    function GetFloatValue(const Buffer : TRecordBuffer) : Double;
    function GetCurrencyValue(const Buffer : TRecordBuffer) : System.Currency;
    function GetDateTimeValue(const Buffer: TRecordBuffer; AField: TField): TDateTime;
    function GetVariantValue(const Buffer : TRecordBuffer; AField : TField) : Variant;
    function InternalCompareValues(const Buffer1, Buffer2: Pointer; AmField: TdxMemField; IsCaseInSensitive: Boolean) : Integer;
    function CompareValues(const Buffer1, Buffer2 : TRecordBuffer; AmField: TdxMemField) : Integer; overload;
    function CompareValues(const Buffer1, Buffer2 : TRecordBuffer; AField: TField) : Integer; overload;

    function InternalGotoNearest(AList: TList; AField : TField;
      const ABuffer: TRecordBuffer; ASortOptions: TdxSortOptions; out AIndex: Integer): Boolean;
    function GotoNearest(const Buffer : TRecordBuffer; ASortOptions: TdxSortOptions; out Index : Integer) : Boolean;

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
    procedure InternalAddFilterRecord;
    procedure MakeRecordSort;
    procedure UpdateFilterRecord; virtual;

    procedure CloseBlob(Field: TField); override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    function GetFieldData(Field: TField; Buffer: TValueBuffer): Boolean; override;
    function GetFieldData(Field: TField; Buffer: TValueBuffer; NativeFormat: Boolean): Boolean; override;
    function BookmarkValid(Bookmark: TBookmark): Boolean; override;
    function GetCurrentRecord(Buffer: TRecordBuffer): Boolean; override;
    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
    function Locate(const KeyFields: string; const KeyValues: Variant;
             Options: TLocateOptions): Boolean; override;
    function Lookup(const KeyFields: string; const KeyValues: Variant;
      const ResultFields: string): Variant; override;
    function GetRecNoByFieldValue(Value : Variant; FieldName : String) : Integer; virtual;

    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;

    function SupportedFieldType(AType: TFieldType): Boolean; virtual;

    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;

    procedure FillBookMarks;
    procedure MoveCurRecordTo(Index : Integer);
    procedure LoadFromTextFile(FileName : String); dynamic;
    procedure SaveToTextFile(FileName : String); dynamic;
    procedure LoadFromBinaryFile(FileName : String);
    procedure SaveToBinaryFile(FileName : String);
    procedure LoadFromStream(Stream : TStream);
    procedure SaveToStream(Stream : TStream);
    procedure CreateFieldsFromStream(Stream : TStream);
    procedure CreateFieldsFromDataSet(DataSet : TDataSet);
    procedure LoadFromDataSet(DataSet : TDataSet);
    procedure CopyFromDataSet(DataSet : TDataSet);

    procedure UpdateFilters; virtual;
    {if failed return -1, in other case the record count with the same value}
    function GetValueCount(AFieldName: string; AValue: Variant): Integer;

    procedure SetFilteredRecNo(Value: Integer);

    //Again for the guys from AQA. Hi Atanas :-)
    property CurRec: Integer read FCurRec write FCurRec;

    property BlobFieldCount;
    property BlobList: TList read FBlobList;