cxdatastorage.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,304 行 · 第 1/5 页

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressDataController                                        }
{                                                                    }
{       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, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSDATACONTROLLER AND ALL         }
{   ACCOMPANYING VCL CONTROLS 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 cxDataStorage;                   

{$I cxVer.inc}

interface

uses
  SysUtils, Classes{$IFDEF DELPHI6},Variants
  {$IFNDEF NONDB},FMTBcd, SqlTimSt{$ENDIF}{$ENDIF};

type
{$IFNDEF DELPHI6}
  PPointer = ^Pointer;
  PSmallInt = ^SmallInt;
  PInteger = ^Integer;
  PWord = ^Word;
  PBoolean = ^Boolean;
  PDouble =^Double;
  PByte = ^Byte;
{$ELSE}
  LargeInt = Int64;
  PLargeInt = ^LargeInt;
{$ENDIF}

  { Value Types }

  
  PStringValue = PString;
  PWideStringValue = PWideString;

  TcxValueType = class
  protected
    class function Compare(P1, P2: Pointer): Integer; virtual;
    class procedure FreeBuffer(PBuffer: PChar); virtual;
    class procedure FreeTextBuffer(PBuffer: PChar); virtual;
    class function GetDataSize: Integer; virtual;
    class function GetDataValue(PBuffer: PChar): Variant; virtual;
    class function GetDefaultDisplayText(PBuffer: PChar): string; virtual;
    class function GetDisplayText(PBuffer: PChar): string; virtual;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); virtual;
    class procedure ReadDisplayText(PBuffer: PChar; AStream: TStream); virtual;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); virtual;
    class procedure SetDisplayText(PBuffer: PChar; const DisplayText: string); virtual;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); virtual;
    class procedure WriteDisplayText(PBuffer: PChar; AStream: TStream); virtual;
  public
    class function Caption: string; virtual;
    class function CompareValues(P1, P2: Pointer): Integer; virtual;
    class function GetValue(PBuffer: PChar): Variant; virtual;
    class function GetVarType: Integer; virtual;
    class function IsValueValid(var{const }Value: Variant): Boolean; virtual;
    class function IsString: Boolean; virtual;
    class procedure PrepareValueBuffer(var PBuffer: PChar); virtual;
  end;

  TcxValueTypeClass = class of TcxValueType;

  TcxStringValueType = class(TcxValueType)
  protected
    class function Compare(P1, P2: Pointer): Integer; override;
    class procedure FreeBuffer(PBuffer: PChar); override;
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetValue(PBuffer: PChar): Variant; override;
    class function GetVarType: Integer; override;
    class function IsString: Boolean; override;
    class procedure PrepareValueBuffer(var PBuffer: PChar); override;
  end;

  TcxWideStringValueType = class(TcxStringValueType)
  protected
    class function Compare(P1, P2: Pointer): Integer; override;
    class procedure FreeBuffer(PBuffer: PChar); override;
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetValue(PBuffer: PChar): Variant; override;
    class function GetVarType: Integer; override;
    class function IsString: Boolean; override;
    class procedure PrepareValueBuffer(var PBuffer: PChar); override;
  end;

  TcxSmallintValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxIntegerValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxWordValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxBooleanValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class function GetDefaultDisplayText(PBuffer: PChar): string; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxFloatValueType = class(TcxValueType) // TODO: Double or Extended?
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxCurrencyValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxDateTimeValueType = class(TcxValueType)
  private
    class function GetDateTime(PBuffer: PChar): TDateTime; 
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class function GetDefaultDisplayText(PBuffer: PChar): string; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

{$IFDEF DELPHI6}
  TcxLargeIntValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  {$IFNDEF NONDB}
  TcxFMTBcdValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class function GetDefaultDisplayText(PBuffer: PChar): string; override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;

  TcxSQLTimeStampValueType = class(TcxValueType)
  protected
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetVarType: Integer; override;
  end;
  {$ENDIF}
  {$ENDIF}

  TcxVariantValueType = class(TcxValueType)
  protected
    class function Compare(P1, P2: Pointer): Integer; override;
    class procedure FreeBuffer(PBuffer: PChar); override;
    class function GetDataSize: Integer; override;
    class function GetDataValue(PBuffer: PChar): Variant; override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
  public
    class function CompareValues(P1, P2: Pointer): Integer; override;
    class function GetValue(PBuffer: PChar): Variant; override;
    class procedure PrepareValueBuffer(var PBuffer: PChar); override;
  end;

  TcxObjectValueType = class(TcxIntegerValueType)
  protected
    class procedure FreeBuffer(PBuffer: PChar); override;
    class procedure ReadDataValue(PBuffer: PChar; AStream: TStream); override;
    class procedure SetDataValue(PBuffer: PChar; const Value: Variant); override;
    class procedure WriteDataValue(PBuffer: PChar; AStream: TStream); override;
  end;

  { TcxDataStorage }

  TcxDataStorage = class;
  TcxValueDefs = class;

  TcxValueDef = class
  private
    FBufferSize: Integer;
    FDataSize: Integer;
    FStored: Boolean;
    FLinkObject: TObject;
    FOffset: Integer;
    FStreamStored: Boolean;
    FTextStored: Boolean;
    FValueDefs: TcxValueDefs;
    FValueTypeClass: TcxValueTypeClass;
    function GetIsNeedConversion: Boolean;
    function GetTextStored: Boolean;
    procedure SetStored(Value: Boolean);
    procedure SetTextStored(Value: Boolean);
    procedure SetValueTypeClass(Value: TcxValueTypeClass);
  protected
    procedure Changed(AResyncNeeded: Boolean);
    function Compare(P1, P2: PChar): Integer;
    procedure FreeBuffer(PBuffer: PChar);
    procedure FreeTextBuffer(PBuffer: PChar);
    function GetDataValue(PBuffer: PChar): Variant;
    function GetDisplayText(PBuffer: PChar): string;
    function GetLinkObject: TObject; virtual;
    function GetStored: Boolean; virtual;
    procedure Init(var AOffset: Integer);
    function IsNullValue(PBuffer: PChar): Boolean;
    function IsNullValueEx(PBuffer: PChar; AOffset: Integer): Boolean;
    procedure ReadDataValue(PBuffer: PChar; AStream: TStream);
    procedure ReadDisplayText(PBuffer: PChar; AStream: TStream);
    procedure SetDataValue(PBuffer: PChar; const Value: Variant);
    procedure SetDisplayText(PBuffer: PChar; const DisplayText: string);
    procedure SetLinkObject(Value: TObject); virtual;
    procedure SetNull(PBuffer: PChar; IsNull: Boolean);
    procedure WriteDataValue(PBuffer: PChar; AStream: TStream);
    procedure WriteDisplayText(PBuffer: PChar; AStream: TStream);
    property BufferSize: Integer read FBufferSize;
    property DataSize: Integer read FDataSize;
    property Offset: Integer read FOffset;
    property ValueDefs: TcxValueDefs read FValueDefs;
  public
    constructor Create(AValueDefs: TcxValueDefs; AValueTypeClass: TcxValueTypeClass); virtual;
    destructor Destroy; override;
    procedure Assign(ASource: TcxValueDef); virtual;
    function CompareValues(AIsNull1, AIsNull2: Boolean; P1, P2: PChar): Integer;
    property IsNeedConversion: Boolean read GetIsNeedConversion;
    property LinkObject: TObject read GetLinkObject write SetLinkObject;
    property Stored: Boolean read GetStored write SetStored default True;
    property TextStored: Boolean read GetTextStored write SetTextStored default False;
    property ValueTypeClass: TcxValueTypeClass read FValueTypeClass write SetValueTypeClass;
    property StreamStored: Boolean read FStreamStored write FStreamStored default True;
  end;

  TcxValueDefClass = class of TcxValueDef;

  TcxValueDefs = class
  private
    FDataStorage: TcxDataStorage;
    FItems: TList;
    FRecordOffset: Integer;
    FRecordSize: Integer;
    function GetStoredCount: Integer;
    function GetCount: Integer;
    function GetItem(Index: Integer): TcxValueDef;
  protected
    procedure Changed(AValueDef: TcxValueDef; AResyncNeeded: Boolean); virtual;
    function GetValueDefClass: TcxValueDefClass; virtual;
    procedure Prepare(AStartOffset: Integer); virtual;
    procedure Remove(AItem: TcxValueDef);
    property DataStorage: TcxDataStorage read FDataStorage;
  public
    constructor Create(ADataStorage: TcxDataStorage); virtual;
    destructor Destroy; override;
    function Add(AValueTypeClass: TcxValueTypeClass; AStored, ATextStored: Boolean; ALinkObject: TObject): TcxValueDef;
    procedure Clear;
    property StoredCount: Integer read GetStoredCount;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TcxValueDef read GetItem; default;
    property RecordSize: Integer read FRecordSize;
  end;

  { internal value defs }

  TcxInternalValueDef = class(TcxValueDef)
  protected
    function GetLinkObject: TObject; override;
    function GetStored: Boolean; override;
  public
    function GetValueDef: TcxValueDef;
  end;

  TcxInternalValueDefs = class(TcxValueDefs)
  protected
    function GetValueDefClass: TcxValueDefClass; override;
  public
    function FindByLinkObject(ALinkObject: TObject): TcxValueDef;
    procedure RemoveByLinkObject(ALinkObject: TObject);
  end;

  TcxValueDefReader = class
  public
    constructor Create; virtual;
    function GetDisplayText(AValueDef: TcxValueDef): string; virtual;
    function GetValue(AValueDef: TcxValueDef): Variant; virtual;
    function IsInternal(AValueDef: TcxValueDef): Boolean; virtual;
  end;

  TcxValueDefReaderClass = class of TcxValueDefReader;

  TcxValueDefSetProc = procedure (AValueDef: TcxValueDef; AFromRecordIndex, AToRecordIndex: Integer;
    AValueDefReader: TcxValueDefReader) of object;

  TcxDataStorage = class
  private
    FDestroying: Boolean;
    FInternalRecordBuffers: TList;
    FInternalValueDefs: TcxInternalValueDefs;
    FStoredValuesOnly: Boolean;
    FRecordBuffers: TList;
    FRecordIDCounter: Integer;
    FUseRecordID: Boolean;
    FValueDefs: TcxValueDefs;
    FValueDefsList: TList;
//    FValueDefsChanged: Boolean;
    FOnClearInternalRecords: TNotifyEvent;
    function GetRecordBuffer(Index: Integer): PChar;
    function GetRecordCount: Integer;
    procedure SetStoredValuesOnly(Value: Boolean);
    procedure SetRecordBuffer(Index: Integer; Value: PChar);
    procedure SetRecordCount(Value: Integer);
    procedure SetUseRecordID(Value: Boolean);
  protected
    function AllocRecordBuffer(Index: Integer): PChar;
    function CalcRecordOffset: Integer;
    procedure ChangeRecordFlag(PBuffer: PChar; AFlag: Byte; ATurnOn: Boolean);
    procedure CheckRecordID(ARecordIndex: Integer);
    procedure CheckRecordIDCounter;
    procedure CheckRecordIDCounterAfterLoad(ALoadedID: Integer);
    function CheckValueDef(ARecordIndex: Integer; var AValueDef: TcxValueDef): Boolean;
    procedure DeleteInternalRecord(ARecordIndex: Integer);
    procedure FreeAndNilRecordBuffer(AIndex: Integer);
    procedure InitStructure(AValueDefs: TcxValueDefs); virtual;
    procedure InsertValueDef(AIndex: Integer; AValueDef: TcxValueDef);
    function IsRecordFlag(PBuffer: PChar; AFlag: Byte): Boolean;
    procedure RemoveValueDef(AValueDef: TcxValueDef);
    procedure ValueDefsChanged(AValueDef: TcxValueDef; AResyncNeeded: Boolean); virtual;
    function ValueDefsByRecordIndex(Index: Integer): TcxValueDefs; virtual;
    property InternalValueDefs: TcxInternalValueDefs read FInternalValueDefs;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function AddInternalRecord: Integer;
    function AppendRecord: Integer;
    procedure BeforeDestruction; override;
    procedure BeginLoad;
    procedure CheckStructure;
    procedure Clear(AWithoutInternal: Boolean);
    procedure ClearInternalRecords;
    procedure ClearRecords(AClearList: Boolean);
    function CompareRecords(ARecordIndex1, ARecordIndex2: Integer; AValueDef: TcxValueDef): Integer;
    procedure DeleteRecord(ARecordIndex: Integer);
    procedure EndLoad;
    function GetDisplayText(ARecordIndex: Integer; AValueDef: TcxValueDef): string;
    function GetCompareInfo(ARecordIndex: Integer; AValueDef: TcxValueDef; var P: PChar): Boolean;
    function GetRecordID(ARecordIndex: Integer): Integer;
    function GetValue(ARecordIndex: Integer; AValueDef: TcxValueDef): Variant;
    procedure InsertRecord(ARecordIndex: Integer);
    procedure ReadData(ARecordIndex: Integer; AStream: TStream);
    procedure ReadRecord(ARecordIndex: Integer; AValueDefReader: TcxValueDefReader);
    procedure ReadRecordFrom(AFromRecordIndex, AToRecordIndex: Integer; AValueDefReader: TcxValueDefReader; ASetProc: TcxValueDefSetProc);
    procedure SetDisplayText(ARecordIndex: Integer; AValueDef: TcxValueDef; const Value: string);
    procedure SetRecordID(ARecordIndex, AID: Integer);
    procedure SetValue(ARecordIndex: Integer; AValueDef: TcxValueDef; const Value: Variant);
    procedure WriteData(ARecordIndex: Integer; AStream: TStream);

    procedure BeginStreaming(ACompare: TListSortCompare);
    procedure EndStreaming;
    
    property StoredValuesOnly: Boolean read FStoredValuesOnly write SetStoredValuesOnly;
    property UseRecordID: Boolean read FUseRecordID write SetUseRecordID;
    property RecordBuffers[Index: Integer]: PChar read GetRecordBuffer write SetRecordBuffer;
    property RecordCount: Integer read GetRecordCount write SetRecordCount;
    property ValueDefs: TcxValueDefs read FValueDefs;
    property OnClearInternalRecords: TNotifyEvent read FOnClearInternalRecords write FOnClearInternalRecords;