dxmdaset.pas

在Dephi中用于文件的输出

  if (SortOptions <>  Value) then
  begin
    FSortOptions :=  Value;
    IsDirty := True;
  end;
end;

procedure TdxMemIndex.SetFieldNameAfterMemdataLoaded;
begin
  if (fLoadedFieldName <> '') then
    FieldName := fLoadedFieldName;
end;

function TdxMemIndex.GetMemData: TdxMemData;
begin
  Result := TdxMemIndexes(Collection).fMemData;
end;

{TdxMemIndexes}
function TdxMemIndexes.GetOwner: TPersistent;
begin
  Result := fMemData;
end;

procedure TdxMemIndexes.SetIsDirty;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    TdxMemIndex(Items[i]).IsDirty := True;
end;

procedure TdxMemIndexes.DeleteRecord(pRecord: TRecordBuffer);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    TdxMemIndex(Items[i]).DeleteRecord(pRecord);
end;

procedure TdxMemIndexes.UpdateRecord(pRecord: TRecordBuffer);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    TdxMemIndex(Items[i]).UpdateRecord(pRecord);
end;

procedure TdxMemIndexes.RemoveField(AField: TField);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    if(TdxMemIndex(Items[i]).fField = AField) then
    begin
      TdxMemIndex(Items[i]).fField := nil;
      TdxMemIndex(Items[i]).IsDirty := True;
    end;
end;

procedure TdxMemIndexes.CheckFields;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
  begin
    TdxMemIndex(Items[i]).fField := fMemData.FindField(TdxMemIndex(Items[i]).FieldName);
    TdxMemIndex(Items[i]).IsDirty := True;
  end;
end;

procedure TdxMemIndexes.AfterMemdataLoaded;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    TdxMemIndex(Items[i]).SetFieldNameAfterMemdataLoaded;
end;

function TdxMemIndexes.Add: TdxMemIndex;
begin
  Result := TdxMemIndex(inherited Add);
end;

function TdxMemIndexes.GetIndexByField(AField: TField): TdxMemIndex;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do
    if(TdxMemIndex(Items[i]).fField = AField) then
    begin
      Result := TdxMemIndex(Items[i]);
      break;
    end;
end;

{ TdxMemData }
constructor TdxMemData.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FData := TdxMemFields.Create(self);
  FData.FDataSet := self;
  FBookMarks := TList.Create;
  FBlobList := TList.Create;
  FFilterList := TList.Create;
  FDelimiterChar := Char(VK_TAB);

  FGotoNearestMin := -1;
  FGotoNearestMax := -1;
  
  fIndexes := TdxMemIndexes.Create(TdxMemIndex);
  fIndexes.fMemData := self;
  fPersistent := TdxMemPersistent.Create(self);

  CreateRecIDField;
end;

destructor TdxMemData.Destroy;
begin
  fIndexes.Free;
  BlobClear;
  FBlobList.Free;
  FBlobList := nil;
  FBookMarks.Free;
  FFilterList.Free;
  FData.Free;
  FData := nil;
  FActive := False;
  fPersistent.Free;
  
  inherited Destroy;
end;

procedure TdxMemData.CreateRecIDField;
begin
  if (FRecIdField <> nil) then exit;
  FRecIdField := TIntegerField.Create(self);
  with FRecIdField do
  begin
    FieldName := 'RecId';
    DataSet := self;
    Name := self.Name + FieldName;
    Calculated := True;
    Visible := False;
  end;
end;

procedure TdxMemData.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if Active and not (csLoading in ComponentState) and not (csDestroying in ComponentState) then
  begin
    if (AComponent is TField) and (TField(AComponent).DataSet = self) then
    begin
      if(Operation = opInsert) then
        FData.AddField(AComponent as TField)
      else
      begin
        if (FRecIdField = AComponent) then
          FRecIdField := nil;
        FData.RemoveField(AComponent as TField);
        Indexes.RemoveField(AComponent as TField);
      end;
    end;
  end;
  inherited Notification(AComponent, Operation);
end;

function TdxMemData.BookmarkValid(Bookmark: TBookmark): Boolean;
var
  Index : Integer;
begin
  Result := (Bookmark <> nil);
  if(Result) then
  begin
    Index := FBookMarks.IndexOf(TObject(PInteger(Bookmark)^));
    Result := (Index > -1) and (Index < Data.RecordCount);
    if  FIsFiltered then
      Result := FFilterList.IndexOf(TValueBuffer(Index + 1)) > -1;
  end;
end;

function TdxMemData.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
const
  RetCodes: array[Boolean, Boolean] of ShortInt = ((2, -1), (1, 0));
var
  r1, r2 : Integer;
begin
  Result := RetCodes[Bookmark1 = nil, Bookmark2 = nil];
  if(Result = 2) then
  begin
    r1 := ReadInteger(Bookmark1);
    r2 := ReadInteger(Bookmark2);
    if(r1 = r2) then
       Result := 0
    else begin
      if FSortedField <> nil then
      begin
        r1 := FBookMarks.IndexOf(TObject(r1));
        r2 := FBookMarks.IndexOf(TObject(r2));
      end;
      if(r1 > r2) then
        Result := 1
      else Result := -1;
    end;
  end;
end;

procedure TdxMemData.CheckFields(FieldsName: string);
var
  AFieldList: TObjectList;
  i: Integer;
begin
  AFieldList := TObjectList.Create(False);
  try
    GetFieldList(AFieldList, FieldsName);
    if AFieldList.Count = 0 then
      Exception.CreateFmt(SFieldNotFound, [FieldsName]);
    for i := 0 to AFieldList.Count - 1 do
      if AFieldList[i] = nil then
        raise Exception.CreateFmt(SFieldNotFound, [FieldsName])
      else
        if FData.IndexOf(TField(AFieldList[i])) = nil then
          DatabaseErrorFmt(SBadFieldType, [TField(AFieldList[i]).FieldName]);
  finally
    AFieldList.Free;
  end;
end;

function TdxMemData.GetStringLength(AFieldType: TFieldType; const ABuffer: Pointer): Integer;
begin
  Result := 0;
  if ABuffer <> nil then
    case AFieldType of
      ftString, ftWideString, ftGuid:
        Result := StrLen(ABuffer, AFieldType);
    end;
end;

function TdxMemData.InternalLocate(const KeyFields: string; const KeyValues: Variant;
           Options: TLocateOptions): Integer;

  function CompareLocate_SortCaseSensitive: Boolean;
  begin
    Result := ((loCaseInsensitive in Options) and (soCaseInsensitive in SortOptions))
     or ( not (loCaseInsensitive in Options) and not (soCaseInsensitive in SortOptions))
  end;

  function AllocBufferByVariant(AValue: Variant; AField: TField): Pointer;
  begin
    if VarIsNull(AValue) then
      Result := nil
    else
      Result := AllocBufferForField(AField);
  end;

  function CompareLocStr(AmField: TdxMemField; buf1, buf2 : TRecordBuffer; AStSize: Integer) : Integer;
  var
    ATempBuffer: Pointer;
    fStr2Len : Integer;
  begin
    Result := -1;
    fStr2Len := GetStringLength(AmField.FDataType, buf2);
    if fStr2Len = AStSize then
      Result := InternalCompareValues(buf1, buf2, AmField, loCaseInsensitive in Options)
    else
      if (loPartialKey in Options) and (fStr2Len > AStSize) and (AStSize > 0) then
      begin
        ATempBuffer := AllocBuferForString(AStSize, AmField.FDataType);
        CopyChars(buf2, ATempBuffer, AStSize, AmField.FDataType);
        Result := InternalCompareValues(buf1, ATempBuffer, AmField, loCaseInsensitive in Options);
        FreeMem(ATempBuffer);
      end;
  end;

  function LocateByIndexField(AIndex: TdxMemIndex; AField: TField; AValue: Variant) : Integer;
  var
    FStSize : Integer;
    mField: TdxMemField;
    ABuf: TRecordBuffer;
  begin
    ABuf := AllocBufferByVariant(AValue, AField);
    try
      VariantToMemDataValue(AValue, ABuf, AField);
      if AIndex = nil then
      begin
        if not GotoNearest(ABuf, SortOptions, Result) and
        not (loPartialKey in Options) then
          Result := -1;
      end else
      begin
        if not AIndex.GotoNearest(ABuf, Result) then
           Result := -1;
      end;

      if (Result > -1) then
      begin
        mField := FData.IndexOf(AField);
        if AField.DataType in ftStrings then
        begin
          FStSize := GetStringLength(AField.DataType, ABuf);
          if CompareLocStr(mField, ABuf, mField.Values[Result], FStSize) <> 0 then
            Result := -1;
        end
        else
        begin
          if (InternalCompareValues(ABuf, mField.Values[Result], mField, False) <> 0) then
            Result := -1;
        end;
      end;
    finally
      FreeMem(ABuf);
    end;
 end;

 procedure PrepareLocate;
 begin
   CheckBrowseMode;
   CursorPosChanged;
   UpdateCursorPos;
 end;

 function GetLocateValue(AKeyValues: Variant; AIndex: Integer): Variant;
 begin
   if VarIsArray(AKeyValues) then
     Result := AKeyValues[AIndex]
   else Result := AKeyValues;
 end;

 function IsSortedByField(AField: TField): Boolean;
 begin
   Result := (AField = FSortedField) or (Indexes.GetIndexByField(AField) <> nil);
 end;

 function GetIndexBySortedField(AField: TField; AKeyValues: Variant): Integer;
 begin
    if (AField = FSortedField) then
      Result := LocateByIndexField(nil, AField, AKeyValues)
    else
      Result := LocateByIndexField(Indexes.GetIndexByField(AField), AField, AKeyValues);
 end;

var
  buf : TRecordBuffer;
  AValueList, AmFieldList : TList;
  AFieldList: TObjectList;
  StartId : Integer;
  AField : TField;
  i, j, k, RealRec, RealRecordCount : Integer;
  StSize : Integer;
  IsIndexed  : Boolean;
  AKeyValues, AValue: Variant;
begin
  Result := -1;
  PrepareLocate;
  CheckFields(KeyFields);
  if (RecordCount = 0) then exit;

  AField := FindField(KeyFields);

  if (AField = nil) and not VarIsArray(KeyValues) then
    exit;

  if (AField <> nil) and VarIsArray(KeyValues) then
    AKeyValues := KeyValues[0]
  else AKeyValues := KeyValues;

  if (AField <> nil) and not FIsFiltered and CompareLocate_SortCaseSensitive and IsSortedByField(AField) then
  begin
    Result := GetIndexBySortedField(AField, AKeyValues);
    exit;
  end;

  AFieldList := TObjectList.Create(False);
  AValueList := TList.Create;
  AmFieldList := TList.Create;
  try
    GetFieldList(AFieldList, KeyFields);
    try
      for i := 0 to AFieldList.Count - 1 do
      begin
        AField := TField(AFieldList[i]);
        AValue := GetLocateValue(AKeyValues, i);
        Buf := AllocBufferByVariant(AValue, AField);
        AValueList.Add(buf);
        VariantToMemDataValue(AValue, Buf, AField);
        AmFieldList.Add(FData.IndexOf(AField));
      end;

      StartId := 0;
      IsIndexed := False;
      if not FIsFiltered then
      begin
        RealRecordCount := FData.RecordCount - 1;
        if CompareLocate_SortCaseSensitive and not VarIsArray(KeyValues) and IsSortedByField(TField(AFieldList[0])) then
        begin
          StartID := GetIndexBySortedField(TField(AFieldList[0]), AKeyValues);
          IsIndexed := True;
        end;
      end else RealRecordCount := FFilterList.Count - 1;

      if StartId > -1 then
      begin
        for i := StartId to RealRecordCount do
        begin
          if not FIsFiltered then
            RealRec := i
          else
            RealRec := Integer(TValueBuffer(FFilterList[i])) - 1;
          j := 0;
          for k := 0 to AFieldList.Count - 1 do
            if (TField(AFieldList[k]) <> nil) then
            begin
              if (AValueList[k] = nil) then
              begin
                if TdxMemField(AmFieldList[k]).HasValue[RealRec] then
                  j := -1;
              end
              else
              begin
                if (TField(AFieldList[k]).DataType in ftStrings) and (Options <> []) then
                begin
                  StSize := GetStringLength(TField(AFieldList[k]).DataType, TRecordBuffer(AValueList[k]));
                  j := CompareLocStr(TdxMemField(AmFieldList[k]),
                      TRecordBuffer(AValueList[k]), TdxMemField(AmFieldList[k]).Values[RealRec], StSize)
                end
                else
                  j := InternalCompareValues(TRecordBuffer(AValueList[k]), TdxMemField(AmFieldList[k]).Values[RealRec], TdxMemField(AmFieldList[k]), loCaseInsensitive in Options);
              end;
              if IsIndexed and (k = 0) and (j <> 0) then
              begin
               RealRec := -1;
               break;