dxmdaset.pas

在Dephi中用于文件的输出

    //FilterList made public - so we can set the list of filtered records
    //when ProgrammedFilter is True, the developer is responsible to set the list
    property FilterList: TList read FFilterList;
    //ProgrammedFilter - for faster setting of the filers. This avoids calling OnFilterRecord
    property ProgrammedFilter: Boolean read FProgrammedFilter write FProgrammedFilter;

    property RecIdField : TField read FRecIdField;
    property IsLoading : Boolean read FLoadFlag write FLoadFlag;
    property Data : TdxMemFields read FData;
    property DelimiterChar : Char read FDelimiterChar write FDelimiterChar;
    property Filter;
  published
    property Active;
    property Indexes: TdxMemIndexes read fIndexes write SetIndexes;
    property Persistent: TdxMemPersistent read fPersistent write SetPersistent;
    property ReadOnly : Boolean read FReadOnly write FReadOnly default False;
    property SortOptions : TdxSortOptions read GetSortOptions write SetSortOptions;
    property SortedField : String read FSortedFieldName write SetSortedField;

    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnNewRecord;
    property OnPostError;

    property OnFilterRecord;
  end;

procedure FillZeroData(ADestination: Pointer; ACount: Integer);
function ReadBufferFromStream(AStream: TStream; Dest: Pointer; Count: Integer): Boolean;

function ReadBoolean(ASource: Pointer; AOffset: Integer = 0): WordBool;
function ReadByte(ASource: Pointer; AOffset: Integer = 0): Byte;
function ReadInteger(ASource: Pointer; AOffset: Integer = 0): Integer;
function ReadWord(ASource: Pointer; AOffset: Integer = 0): Word;
procedure WriteBoolean(ADest: Pointer; AValue: WordBool; AOffset: Integer = 0);
procedure WriteByte(ADest: Pointer; AValue: Byte; AOffset: Integer = 0);
procedure WriteInteger(ADest: Pointer; AValue: Integer; AOffset: Integer = 0);
procedure WriteWord(ADest: Pointer; AValue: Word; AOffset: Integer = 0);

function WriteCharToStream(AStream: TStream; AValue: Char): Longint; overload;
function WriteDoubleToStream(AStream: TStream; AValue: Double): Longint; overload;
function WriteIntegerToStream(AStream: TStream; AValue: Integer): Longint; overload;
function WriteSmallIntToStream(AStream: TStream; AValue: SmallInt): Longint; overload;
function WriteStringToStream(AStream: TStream; AValue: string): Longint; overload;
function WriteBufferToStream(AStream: TStream; Buffer: Pointer; Count: Longint): Longint; overload;

procedure CopyData(Source, Dest: Pointer; Count: Integer); overload;
procedure CopyData(Source, Dest: Pointer; ASourceOffSet, ADestOffSet, Count: Integer); overload;
procedure DateTimeToMemDataValue(Value : TDateTime; pt : TRecordBuffer; Field : TField);
function VariantToMemDataValue(AValue: Variant; AMemDataValue: Pointer; AField: TField) : Boolean;

const
  MemDataVer = 1.91;

implementation

uses
{$IFDEF DELPHI6}
  Variants, FmtBcd,
{$ELSE}
  Forms,
{$ENDIF}
  ActiveX,
  Windows, DbConsts, DBCommon, Contnrs, Math;

const
  IncorrectedData = 'The data is incorrect';
  ftStrings = [ftString, ftWideString, ftGuid];

function GetNoByFieldType(FieldType : TFieldType) : Integer; forward;

procedure FillZeroData(ADestination: Pointer; ACount: Integer);
begin
  ZeroMemory(ADestination, ACount);
end;

function AllocMem(Size: Cardinal): Pointer;
begin
  Result := GetMemory(Size);
  FillZeroData(Result, Size);
end;

procedure FreeMem(P: Pointer);
begin
  FreeMemory(P);
end;

function ReadBufferFromStream(AStream: TStream; Dest: Pointer; Count: Integer): Boolean;
begin
  Result := AStream.Read(Dest^, Count) = Count;
end;

function ReadBoolean(ASource: Pointer; AOffset: Integer = 0): WordBool;
begin
  CopyData(ASource, @Result, AOffset, 0, SizeOf(WordBool));
end;

function ReadByte(ASource: Pointer; AOffset: Integer = 0): Byte;
begin
  CopyData(ASource, @Result, AOffset, 0, SizeOf(Byte));
end;

function ReadInteger(ASource: Pointer; AOffset: Integer = 0): Integer;
begin
  CopyData(ASource, @Result, AOffset, 0, SizeOf(Integer));
end;

function ReadPointer(ASource: Pointer): Pointer;
begin
  Result := Pointer(ASource^);
end;

function ReadWord(ASource: Pointer; AOffset: Integer = 0): Word;
begin
  CopyData(ASource, @Result, AOffset, 0, SizeOf(Word));
end;

procedure WriteBoolean(ADest: Pointer; AValue: WordBool; AOffset: Integer = 0);
begin
  CopyData(@AValue, ADest, 0, AOffset, SizeOf(WordBool));
end;

procedure WriteByte(ADest: Pointer; AValue: Byte; AOffset: Integer = 0);
begin
  CopyData(@AValue, ADest, 0, AOffset, SizeOf(Byte));
end;

procedure WriteInteger(ADest: Pointer; AValue: Integer; AOffset: Integer = 0);
begin
  CopyData(@AValue, ADest, 0, AOffset, SizeOf(Integer));
end;

procedure WritePointer(ADest: Pointer; AValue: Pointer);
begin
  Pointer(ADest^) := AValue;
end;

procedure WriteWord(ADest: Pointer; AValue: Word; AOffset: Integer = 0);
begin
  CopyData(@AValue, ADest, 0, AOffset, SizeOf(Word));
end;

function WriteCharToStream(AStream: TStream; AValue: Char): Longint;
begin
  Result := AStream.Write(AValue, 1);
end;

function WriteDoubleToStream(AStream: TStream; AValue: Double): Longint;
begin
  Result := AStream.Write(AValue, SizeOf(Double));
end;

function WriteIntegerToStream(AStream: TStream; AValue: Integer): Longint;
begin
  Result := AStream.Write(AValue, SizeOf(Integer));
end;

function WriteSmallIntToStream(AStream: TStream; AValue: SmallInt): Longint;
begin
  Result := AStream.Write(AValue, SizeOf(SmallInt));
end;

function WriteStringToStream(AStream: TStream; AValue: string): Longint;
begin
  Result := AStream.Write(PChar(AValue)^, Length(AValue));
end;

function WriteBufferToStream(AStream: TStream; Buffer: Pointer; Count: Longint): Longint;
var
  AData: TBytes;
begin
  SetLength(AData, Count);
  if Buffer <> nil then
    CopyData(Buffer, AData, Count);

  Result := AStream.Write(AData[0], Count);
end;

function GetFieldValue(AField: TField): Variant;
begin
  if AField.IsNull then
    Result := Null
  else
    case AField.DataType of
      ftWideString: Result := AField.AsString; // Borland bug with WideString
    else
      Result := AField.Value;
    end;
end;

procedure SetFieldValue(ASrcField, ADestField: TField);
begin
  if ASrcField.IsNull then
    ADestField.Value := Null
  else
    case ASrcField.DataType of
      ftLargeInt: TLargeintField(ADestField).Value := TLargeintField(ASrcField).Value;
    else
      ADestField.Value := ASrcField.Value;
    end;
end;

procedure Shift(var P: Pointer; AOffset: Integer);
begin
  P := Pointer(Integer(P) + AOffset);
end;

function GetCharSize(AFieldType: TFieldType): Integer;
begin
  case AFieldType of
    ftString, ftGuid: Result := 1;
    ftWideString: Result := 2;
  else
    Result := 0;
  end;
end;

function GetDataSize(AField: TField): Integer;
begin
  if AField.DataType in ftStrings then
    Result := (AField.Size + 1) * GetCharSize(AField.DataType)
  else
    Result := AField.DataSize;
end;

function StrLen(const S: Pointer; AFieldType: TFieldType): Integer;
begin
  Result := 0;
  case AFieldType of
    ftWideString:
      while (ReadWord(S, Result * GetCharSize(AFieldType)) <> 0) do
        Inc(Result);
    ftString, ftGuid:
      while (ReadByte(S, Result * GetCharSize(AFieldType)) <> 0) do
        Inc(Result);
  end;
end;

function AllocBuferForString(ALength: Integer; AFieldType: TFieldType): Pointer;
begin
  Result := AllocMem((ALength + 1) * GetCharSize(AFieldType));
end;

procedure CopyData(Source, Dest: Pointer; Count: Integer);
begin
  Move(Source^, Dest^, Count);
end;

procedure CopyData(Source, Dest: Pointer; ASourceOffSet, ADestOffSet, Count: Integer); overload;
begin
  if ASourceOffSet > 0 then
    Source := Pointer(Integer(Source) + ASourceOffSet);
  if ADestOffSet > 0 then
    Dest := Pointer(Integer(Dest) + ADestOffSet);
  CopyData(Source, Dest, Count);
end;

procedure CopyChars(ASource, ADest: Pointer; AMaxCharCount: Integer; AFieldType: TFieldType);
var
  ACharCount: Integer;
begin
  ACharCount := StrLen(ASource, AFieldType);
  if ACharCount > AMaxCharCount then
    ACharCount := AMaxCharCount;
  CopyData(ASource, ADest, ACharCount * GetCharSize(AFieldType));
  Shift(ADest, ACharCount * GetCharSize(AFieldType));
  FillZeroData(ADest, GetCharSize(AFieldType));
end;

procedure DateTimeToMemDataValue(Value : TDateTime; pt : TRecordBuffer; Field : TField);
var
  TimeStamp: TTimeStamp;
  Data: TDateTimeRec;
  DataSize : Integer;
begin
  TimeStamp := DateTimeToTimeStamp(Value);
  DataSize := 4;
  case Field.DataType of
    ftDate: Data.Date := TimeStamp.Date;
    ftTime: Data.Time := TimeStamp.Time;
  else
    begin
      Data.DateTime := TimeStampToMSecs(TimeStamp);
      DataSize := 8;
    end;
  end;
  Move(Data, pt^, DataSize);
end;

function VariantToMemDataValue(AValue: Variant; AMemDataValue: Pointer; AField : TField): Boolean;
var
  aString: string;
  wString : WideString;
  dbl : Double; //TFloatField
  bcd : System.Currency; //TBCDField
  bcdvalue: TBCD;
  Int64_ : Int64;
begin
  Result := AMemDataValue <> nil;
  if Result then
    case AField.DataType of
      ftString, ftGuid:
        begin
          aString := AValue;
          CopyChars(PChar(aString), AMemDataValue, AField.Size, AField.DataType);
        end;
        ftWideString:
        begin
          wString := AValue;
          CopyChars(PWideChar(wString), AMemDataValue, AField.Size, AField.DataType);
        end;
      ftDate, ftTime, ftDateTime: DateTimeToMemDataValue(AValue, AMemDataValue, AField);
      ftSmallint: WriteWord(AMemDataValue, AValue);
      ftInteger, ftAutoInc: WriteInteger(AMemDataValue, AValue);
      ftWord: WriteWord(AMemDataValue, AValue);
      ftBoolean: WriteBoolean(AMemDataValue, AValue);
      ftFloat, ftCurrency:
        begin
          dbl := AValue;
          Move(dbl, AMemDataValue^, AField.DataSize);
        end;
      ftBCD:
        begin
          bcd := AValue;
          CurrToBCD(bcd, bcdvalue);
          Move(bcdvalue, AMemDataValue^, SizeOf(TBCD));
        end;
      ftLargeInt:
        begin
        {$IFDEF DELPHI6}
          Int64_ := AValue;
        {$ELSE}
          Int64_ := LongInt(AValue);
        {$ENDIF}
          Move(Int64_, AMemDataValue^, AField.DataSize);
        end;
    else
      Result := False;
    end;
end;

procedure HandleException(ASender: TObject);
begin
{$IFDEF DELPHI6}
  if Assigned(ApplicationHandleException) then
    ApplicationHandleException(ASender);
{$ELSE}
  Application.HandleException(ASender);
{$ENDIF}
end;

{TdxMemField}

constructor TdxMemField.Create(AOwner : TdxMemFields);
begin
  inherited Create;
  FOwner := AOwner;
  FIndex := FOwner.FItems.Count;
end;

procedure TdxMemField.CreateField(Field : TField);
var
  i : Integer;
  mField : TdxMemField;
begin
  FField := Field;
  FDataType := Field.DataType;
  FDataSize := GetDataSize(Field);
  FIsRecId := UpperCase(Field.FieldName) = 'RECID';
  FIsNeedAutoInc := FIsRecId or (FDataType = ftAutoInc);
  if FIsNeedAutoInc then
    FOwner.FIsNeedAutoIncList.Add(self);
  if FIndex = 0 then
  begin
    FOffSet := 0;
    fOwner.FValuesSize := 0;
  end else begin
    mField := TdxMemField(FOwner.FItems[FIndex - 1]);
    FOffSet := mField.FOffSet + mField.FDataSize + 1;
  end;
  FValueOffSet := FOffSet + 1;
  Inc(FOwner.FValuesSize, FDataSize + 1);
  FMaxIncValue := 0;
  for i := 0 to DataSet.RecordCount - 1 do
    AddValue(nil);
end;

function TdxMemField.GetActiveBuffer(AActiveBuffer, ABuffer: TRecordBuffer): Boolean;
var
  AData: Pointer;
begin
  AData := GetDataFromBuffer(AActiveBuffer);
  Result := ReadByte(AData) <> 0;
  Shift(AData, SizeOf(Byte));
  if (ABuffer <> nil) and Result then
  begin
    if Field.DataType in ftStrings then
      CopyChars(AData, ABuffer, FDataSize, FDataType)
    else
      CopyData(AData, ABuffer, FDataSize);
  end;
end;

procedure TdxMemField.SetActiveBuffer(AActiveBuffer, ABuffer: TRecordBuffer);

  function GetDataBuffer(ABuffer: Pointer): Pointer;
  begin
  {$IFNDEF DELPHI10}
    if Field.DataType = ftWideString then
      Result := PWideChar(PWideString(ABuffer)^)
    else
  {$ENDIF}
    Result := ABuffer;
  end;

var