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

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

1、单元：ADODB

原型：

?

1 2 3 4 5 6 7 8 9 10 11

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

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80

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

原型：

?

1 2 3 4 5 6 7 8 9 10 11

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

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63

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

?

1 2 3 4 5

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

TDataSet.Resync

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34

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