Delphi Locate函数[2]

Delphi Locate函数[2] - 查询、定位（TCustomADODataSet、TCustomClientDataSet）功能源码

1、单元：ADODB

原型：

function TCustomADODataSet.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  DoBeforeScroll;
  Result := LocateRecord(KeyFields, KeyValues, Options, True);
  if Result then
  begin
    Resync([rmExact, rmCenter]);
    DoAfterScroll;
  end;
end;

TCustomADODataSet.LocateRecord

function TCustomADODataSet.LocateRecord(const KeyFields: string;
  const KeyValues: OleVariant; Options: TLocateOptions;
  SyncCursor: Boolean): Boolean;
var
  Fields: TList;
  Buffer: PChar;
  I, FieldCount: Integer;
  Partial: Boolean;
  SortList, FieldExpr, LocateFilter: string;
begin
  CheckBrowseMode;
  UpdateCursorPos;
  CursorPosChanged;
  Buffer := TempBuffer;
  Partial := loPartialKey in Options;
  Fields := TList.Create;
  DoBeforeScroll;
  try
    try
      GetFieldList(Fields, KeyFields);
      if not Assigned(FLookupCursor) then
        FLookupCursor := Recordset.Clone(adLockReadOnly);
      if CursorLocation = clUseClient then
      begin
        for I := 0 to Fields.Count - 1 do
          with TField(Fields[I]) do
            if Pos(' ', FieldName) > 0 then
            SortList := Format('%s[%s],', [SortList, FieldName]) else
            SortList := Format('%s%s,', [SortList, FieldName]);
        SetLength(SortList, Length(SortList)-1);
        if FLookupCursor.Sort <> SortList then
          FLookupCursor.Sort := SortList;
      end;
      FLookupCursor.Filter := '';
      FFilterBuffer := Buffer;
      SetTempState(dsFilter);
      try
        InitRecord(Buffer);
        FieldCount := Fields.Count;
        if FieldCount = 1 then
          FLookupCursor.Find(GetFilterStr(FieldByName(KeyFields), KeyValues, Partial), 0,
           adSearchForward, EmptyParam)
        else
        begin
          for I := 0 to FieldCount - 1 do
          begin
            FieldExpr := GetFilterStr(Fields[I], KeyValues[I], (Partial and (I = FieldCount-1)));
            if LocateFilter <> '' then
               LocateFilter := LocateFilter + ' AND ' + FieldExpr else    { Do not localize }
               LocateFilter := FieldExpr;
          end;
          FLookupCursor.Filter := LocateFilter;
        end;
      finally
        RestoreState(dsBrowse);
      end;
    finally
      Fields.Free;
    end;
    Result := not FLookupCursor.EOF;
    if Result then
      if SyncCursor then
      begin
        Recordset.Bookmark := FLookupCursor.Bookmark;
        if Recordset.EOF or Recordset.BOF then
        begin
          Result := False;
          CursorPosChanged;
        end
      end
      else
        { For lookups, read all field values into the temp buffer }
        for I := 0 to Self.Fields.Count - 1 do
         with Self.Fields[I] do
          if FieldKind = fkData then
            PVariantList(Buffer+SizeOf(TRecInfo))[Index] := FLookupCursor.Fields[FieldNo-1].Value;
  except
    Result := False;
  end;
end;

　　

2、单元：DBClient

原型：

function TCustomClientDataSet.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  DoBeforeScroll;
  Result := LocateRecord(KeyFields, KeyValues, Options, True);
  if Result then
  begin
    Resync([rmExact, rmCenter]);
    DoAfterScroll;
  end;
end;

 TCustomClientDataSet.LocateRecord

function TCustomClientDataSet.LocateRecord(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions;
  SyncCursor: Boolean): Boolean;
var
  Fields: TList;
  I: Integer;
  Status: DBResult;
  FilterOptions: TFilterOptions;
  ExprParser: TExprParser;
  ValStr, Expr: string;
  Value: Variant;
begin
  CheckBrowseMode;
  UpdateCursorPos;
  CursorPosChanged;
  CheckProviderEOF;
  Fields := TList.Create;
  try
    GetFieldList(Fields, KeyFields);
    Expr := '';
    for i := 0 to Fields.Count - 1 do
    begin
      if (Fields.Count = 1) and not VarIsArray(KeyValues) then
        Value := KeyValues else
        Value := KeyValues[i];
      case TField(Fields[i]).DataType of
        ftString, ftFixedChar, ftWideString, ftGUID:
          if (i = Fields.Count - 1) and (loPartialKey in Options) then
            ValStr := QuotedStr(VarToStr(Value) + '*') else
            ValStr := QuotedStr(VarToStr(Value));          
        ftDate, ftTime, ftDateTime, ftTimeStamp:
          ValStr := Format('''%s''',[VarToStr(Value)]);
        ftSmallint, ftInteger, ftWord, ftAutoInc, ftBoolean, ftFloat, ftCurrency, ftBCD, ftLargeInt, ftFMTBcd:
          ValStr := VarToStr(Value);
      else
        DatabaseErrorFmt(SBadFieldType, [TField(Fields[i]).FieldName]);
      end;
      if Expr <> '' then
        Expr := Expr + ' and ';    { Do not localize }
      if VarIsNull(Value) then
        Expr := Expr + Format('[%s] IS NULL',[TField(Fields[i]).FieldName])  { Do not localize }
      else
        Expr := Expr + Format('[%s]=%s',[TField(Fields[i]).FieldName, ValStr]);
    end;
    FilterOptions := [];
    if loCaseInsensitive in Options then
      FilterOptions := [foCaseInsensitive];
    if not (loPartialKey in Options) then
      Include(FilterOptions, foNoPartialCompare);
    ExprParser := TExprParser.Create(Self, Expr, FilterOptions, [], '', nil, FieldTypeMap);
    try
      FDSCursor.MoveToBOF;
      Status := FDSCursor.LocateWithFilter(ExprParser.FilterData, ExprParser.DataSize);
      if Status = DBERR_NONE then
        FDSCursor.GetCurrentRecord(TempBuffer);
    finally
      ExprParser.Free;
    end;
  finally
    Fields.Free;
  end;
  Result := Status = DBERR_NONE;
end;

　　

3、单元：DB

function TDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
  Options: TLocateOptions): Boolean;
begin
  Result := False;
end;

TDataSet.Resync

procedure TDataSet.Resync(Mode: TResyncMode);
var
  Count: Integer;
begin
  if not IsUniDirectional then
  begin
    if rmExact in Mode then
    begin
      CursorPosChanged;
      if GetRecord(FBuffers[FRecordCount], gmCurrent, True) <> grOK then
        DatabaseError(SRecordNotFound, Self);
    end else
      if (GetRecord(FBuffers[FRecordCount], gmCurrent, False) <> grOK) and
        (GetRecord(FBuffers[FRecordCount], gmNext, False) <> grOK) and
        (GetRecord(FBuffers[FRecordCount], gmPrior, False) <> grOK) then
      begin
        ClearBuffers;
        DataEvent(deDataSetChange, 0);
        Exit;
      end;
    if rmCenter in Mode then
      Count := (FBufferCount - 1) div 2 else
      Count := FActiveRecord;
    MoveBuffer(FRecordCount, 0);
    ActivateBuffers;
    try
      while (Count > 0) and GetPriorRecord do Dec(Count);
      GetNextRecords;
      GetPriorRecords;
    finally
      DataEvent(deDataSetChange, 0);
    end;
  end;
end;

　　

　　

创建时间：2021.01.29　　更新时间：2021.02.22