kbmmembinarystreamformat.pas

kbmMemTable v5.50 (Dec. 12 2005)内存表控件

unit kbmMemBinaryStreamFormat;

interface

{$include kbmMemTable.inc}

// =========================================================================
// Binary stream format for kbmMemTable v. 3.xx+
//
// Copyright 1999-2005 Kim Bo Madsen/Optical Services - Scandinavia
// All rights reserved.
//
// LICENSE AGREEMENT
// PLEASE NOTE THAT THE LICENSE AGREEMENT HAS CHANGED!!! 16. Feb. 2000
//
// You are allowed to use this component in any project for free.
// You are NOT allowed to claim that you have created this component or to
// copy its code into your own component and claim that it was your idea.
//
// -----------------------------------------------------------------------------------
// IM OFFERING THIS FOR FREE FOR YOUR CONVINIENCE, BUT
// YOU ARE REQUIRED TO SEND AN E-MAIL ABOUT WHAT PROJECT THIS COMPONENT (OR DERIVED VERSIONS)
// IS USED FOR !
// -----------------------------------------------------------------------------------
//
// -----------------------------------------------------------------------------------
// PLEASE NOTE THE FOLLOWING ADDITION TO THE LICENSE AGREEMENT:
// If you choose to use this component for generating middleware libraries (with similar
// functionality as dbOvernet, Midas, Asta etc.), those libraries MUST be released as
// Open Source and Freeware!
// -----------------------------------------------------------------------------------
//
// You dont need to state my name in your software, although it would be
// appreciated if you do.
//
// If you find bugs or alter the component (f.ex. see suggested enhancements
// further down), please DONT just send the corrected/new code out on the internet,
// but instead send it to me, so I can put it into the official version. You will
// be acredited if you do so.
//
//
// DISCLAIMER
// By using this component or parts theirof you are accepting the full
// responsibility of the use. You are understanding that the author cant be
// made responsible in any way for any problems occuring using this component.
// You also recognize the author as the creator of this component and agrees
// not to claim otherwize!
//
// Please forward corrected versions (source code ONLY!), comments,
// and emails saying you are using it for this or that project to:
//            [e-mail]
//
// Latest version can be found at:
//            http://www.onelist.com/community/memtable

//=============================================================================
// Remove the remark on the next lines if to keep binary file compatibility
// between different versions of TkbmMemTable.
//{$define BINARY_FILE_230_COMPATIBILITY}
//{$define BINARY_FILE_200_COMPATIBILITY}
//{$define BINARY_FILE_1XX_COMPATIBILITY}
//=============================================================================

// History.
// Per v. 3.00, the stream formats will each have their own history.
//
// 3.00a alpha
//       Initial v. 3.00 binary stream format release based on the sources of v. 2.53b.
//
// 3.00b beta
//       Fixed Floating point error in calculation of progress.
//       Bug reported by Fred Schetterer ([e-mail])
//
// 3.00c beta
//       Fixed bug not setting record flag to record being part of table.
//       This would result in massive memory leaks.
//
// 3.00  Final
//       Added BufferSize property (default 16384) which controls the internal
//       read and write buffer size. Suggested by Ken Schafer ([e-mail])

uses
  kbmMemTable,Classes,DB,
{$include kbmMemRes.inc}
{$IFDEF DOTNET}
  System.Runtime.InteropServices,
{$ENDIF}
  SysUtils;

type
  TkbmStreamFlagUsingIndex  = (sfSaveUsingIndex);
  TkbmStreamFlagUsingIndexs = set of TkbmStreamFlagUsingIndex;

  TkbmStreamFlagDataTypeHeader = (sfSaveDataTypeHeader,sfLoadDataTypeHeader);
  TkbmStreamFlagDataTypeHeaders = set of TkbmStreamFlagDataTypeHeader;

  TkbmCustomBinaryStreamFormat = class(TkbmCustomStreamFormat)
  private
     Writer:TWriter;
     Reader:TReader;

     FUsingIndex:TkbmStreamFlagUsingIndexs;
     FDataTypeHeader:TkbmStreamFlagDataTypeHeaders;
     FBuffSize:LongInt;

     FileVersion:integer;
     InitIndexDef:boolean;

     ProgressCnt:integer;
     StreamSize:longint;
     procedure SetBuffSize(ABuffSize:LongInt);
  protected
     function GetVersion:string; override;

     procedure BeforeSave(ADataset:TkbmCustomMemTable); override;
     procedure SaveDef(ADataset:TkbmCustomMemTable); override;
     procedure SaveData(ADataset:TkbmCustomMemTable); override;
     procedure AfterSave(ADataset:TkbmCustomMemTable); override;

     procedure BeforeLoad(ADataset:TkbmCustomMemTable); override;
     procedure LoadDef(ADataset:TkbmCustomMemTable); override;
     procedure LoadData(ADataset:TkbmCustomMemTable); override;
     procedure AfterLoad(ADataset:TkbmCustomMemTable); override;

     procedure DetermineLoadFieldIndex(ADataset:TkbmCustomMemTable; ID:string; FieldCount:integer; OrigIndex:integer; var NewIndex:integer; Situation:TkbmDetermineLoadFieldsSituation); override;
     
     property sfUsingIndex:TkbmStreamFlagUsingIndexs read FUsingIndex write FUsingIndex;
     property sfDataTypeHeader:TkbmStreamFlagDataTypeHeaders read FDataTypeHeader write FDataTypeHeader;
     property BufferSize:LongInt read FBuffSize write SetBuffSize;
  public
     constructor Create(AOwner:TComponent); override;
  end;

  TkbmBinaryStreamFormat = class(TkbmCustomBinaryStreamFormat)
  published
     property Version;
     property sfUsingIndex;
     property sfData;
     property sfCalculated;
     property sfLookup;
     property sfNonVisible;
     property sfBlobs;
     property sfDef;
     property sfIndexDef;
     property sfFiltered;
     property sfIgnoreRange;
     property sfIgnoreMasterDetail;
     property sfDeltas;
     property sfDontFilterDeltas;
     property sfAppend;
     property sfFieldKind;
     property sfFromStart;
     property sfDataTypeHeader;

     property OnBeforeLoad;
     property OnAfterLoad;
     property OnBeforeSave;
     property OnAfterSave;
     property OnCompress;
     property OnDeCompress;

     property BufferSize;
  end;

{$ifdef LEVEL3}
procedure Register;
{$endif}

implementation

const
  // Binary file magic word.
  kbmBinaryMagic = '@@BINARY@@';

  // Current file versions. V. 1.xx file versions are considered 100, 2.xx are considered 2xx etc.
  kbmBinaryFileVersion = 251;
  kbmDeltaVersion = 200;

type
  TkbmProtCustomMemTable = class(TkbmCustomMemTable);
  TkbmProtCommon = class(TkbmCommon);

function TkbmCustomBinaryStreamFormat.GetVersion:string;
begin
     Result:='3.00';
end;

constructor TkbmCustomBinaryStreamFormat.Create(AOwner:TComponent);
begin
     inherited;
     FUsingIndex:=[sfSaveUsingIndex];
     FDataTypeHeader:=[sfSaveDataTypeHeader,sfLoadDataTypeHeader];
     FBuffSize:=16384;
end;

procedure TkbmCustomBinaryStreamFormat.SetBuffSize(ABuffSize:LongInt);
begin
     if ABuffSize<16384 then ABuffSize:=16384;
     FBuffSize:=ABuffSize;
end;

procedure TkbmCustomBinaryStreamFormat.BeforeSave(ADataset:TkbmCustomMemTable);
begin
     inherited;

     Writer:=TWriter.Create(WorkStream,FBuffSize);
     Writer.WriteSignature;

{$IFNDEF BINARY_FILE_1XX_COMPATIBILITY}
     Writer.WriteInteger(kbmBinaryFileVersion);
{$ENDIF}
end;

procedure TkbmCustomBinaryStreamFormat.AfterSave(ADataset:TkbmCustomMemTable);
begin
     Writer.FlushBuffer;
     Writer.Free;
     Writer:=nil;
     ADataset.OverrideActiveRecordBuffer:=nil;
     inherited;
end;

procedure TkbmCustomBinaryStreamFormat.SaveDef(ADataset:TkbmCustomMemTable);
var
   i:integer;
   nf:integer;
begin
     // Write fielddefinitions.
     nf:=ADataSet.FieldCount;

     Writer.WriteListBegin;
     if (sfSaveDef in sfDef) then
     begin
          for i:=0 to nf-1 do
          begin
               if SaveFields[i]>=0 then
               begin
                    Writer.WriteString(ADataSet.Fields[i].FieldName);
                    Writer.WriteString(FieldTypeNames[ADataSet.Fields[i].DataType]);
                    Writer.WriteInteger(ADataSet.Fields[i].Size);
                    Writer.WriteString(ADataSet.Fields[i].DisplayName);
{$IFDEF DOTNET}
                    if ADataSet.Fields[i].EditMask = nil then
                       Writer.WriteString('')
                    else
{$ENDIF}
                        Writer.WriteString(ADataSet.Fields[i].EditMask);
                    Writer.WriteInteger(ADataSet.Fields[i].DisplayWidth);
                    Writer.WriteBoolean(ADataSet.Fields[i].Required);
                    Writer.WriteBoolean(ADataSet.Fields[i].ReadOnly);

                    // New for 2.50i BinaryFileVersion 250
                    if sfSaveFieldKind in sfFieldKind then
                       Writer.WriteString(FieldKindNames[ord(ADataSet.Fields[i].FieldKind)])
                    else
                        Writer.WriteString(FieldKindNames[0]); //fkData.

                    // New for 2.50o2 BinaryFileVersion 251
{$IFDEF LEVEL4}
 {$IFDEF DOTNET}
                    if ADataSet.Fields[i].DefaultExpression = nil then
                       Writer.WriteString('')
                    else
 {$ENDIF}
                        Writer.WriteString(ADataSet.Fields[i].DefaultExpression);
{$ELSE}
                    Writer.WriteString('');
{$ENDIF}
               end;
          end;
     end;
     Writer.WriteListEnd;

{$IFNDEF BINARY_FILE_1XX_COMPATIBILITY}
     // Save index definitions.
     Writer.WriteListBegin;
     if sfSaveIndexDef in sfIndexDef then
     begin
          for i:=0 to ADataSet.IndexDefs.Count-1 do
              with ADataSet.IndexDefs.Items[i] do
              begin
                   Writer.WriteString(Name);
                   Writer.WriteString(Fields);
 {$IFNDEF LEVEL3}
                   Writer.WriteString(DisplayName);
 {$ELSE}
                   Writer.WriteString(Name);
 {$ENDIF}
                   Writer.WriteBoolean(ixDescending in Options);
                   Writer.WriteBoolean(ixCaseInSensitive in Options);
 {$IFNDEF LEVEL3}
                   Writer.WriteBoolean(ixNonMaintained in Options);
 {$ELSE}
                   Writer.WriteBoolean(false);
 {$ENDIF}
                   Writer.WriteBoolean(ixUnique in Options);
              end;
     end;
     Writer.WriteListEnd;
{$ENDIF}
end;

procedure TkbmCustomBinaryStreamFormat.SaveData(ADataset:TkbmCustomMemTable);
var
   i,j,cnt:integer;
   nf:integer;
   Accept:boolean;
   NewestVersion:boolean;
   pRec:PkbmRecord;
   UsingIndex:boolean;
{$IFDEF DOTNET}
   ARec,Rec:TKbmRecord;
{$ENDIF}
begin
     // Write fielddefinitions.
     nf:=ADataSet.FieldCount;

     // Write datatypes as a kind of header.
     if sfSaveDataTypeHeader in sfDataTypeHeader then
     begin