datadrivereh.pas

Ehlib.v3.4.for.Delphi5678.rar是DELPHI的三方控件源码.此控件适用于DELPHI5,6,7,8.

{$ENDIF}

var
  FDefaultSQLDataDriverResolver: TSQLDataDriverResolver;

function DefaultSQLDataDriverResolver: TSQLDataDriverResolver;
begin
  Result := FDefaultSQLDataDriverResolver;
end;

function RegisterDefaultSQLDataDriverResolver(ASQLDataDriverResolver: TSQLDataDriverResolver): TSQLDataDriverResolver;
begin
  Result := FDefaultSQLDataDriverResolver;
  FDefaultSQLDataDriverResolver := ASQLDataDriverResolver;
end;

{ TDataDriverEh }

function TDataDriverEh.ApplyUpdates(MemTableData: TMemTableDataEh): Integer;
var
  I: Integer;
  MemRec: TMemoryRecordEh;
  Action: TUpdateErrorActionEh;
//  UpdateKind: TUpdateKind;

  procedure ApplyUpdate;
  begin
    while True do
    begin
      try
        UpdateRecord(MemTableData, MemRec);
        Result := Result + 1;
      except
        on E: EDatabaseError do
        begin
          if Assigned(OnUpdateError)
            then OnUpdateError(MemRec.RecordsList.MemTableData, MemRec, Action)
            else DefaultUpdateError(MemRec.RecordsList.MemTableData, MemRec, Action);

          if Action = ueaBreakRaiseEh then
            raise
          else begin
            if MemRec.UpdateError <> nil then
              MemRec.UpdateError.Free;
            MemRec.UpdateError := TUpdateErrorEh.Create(E);
            if Action = ueaRetryEh
              then Continue
              else Break;
          end;
        end;
      end;
      Break;
    end;
  end;

begin
  Result := 0;
  for I := 0 to MemTableData.RecordsList.DeltaList.Count-1 do
  begin
    MemRec := TMemoryRecordEh(MemTableData.RecordsList.DeltaList[I]);
    if MemRec = nil then Continue;

{    case MemRec.UpdateStatus of
      usModified: UpdateKind := ukModify;
      usInserted: UpdateKind := ukInsert;
      usDeleted: UpdateKind := ukDelete;
    else
      raise Exception.Create('Attempt to update Unmodified record');
    end;}

    Action := ueaBreakRaiseEh;

    ApplyUpdate;

    if Action = ueaBreakAbortEh then
      Break;
//ueaBreakAbortEh, ueaBreakRaiseEh, ueaCountinueEh, ueaRetryEh
  end;

  MemTableData.RecordsList.CleanupChangedRecs;
end;

procedure TDataDriverEh.DefaultUpdateError(MemTableData: TMemTableDataEh;
  MemRec: TMemoryRecordEh; var Action: TUpdateErrorActionEh);
begin
  Action := ueaBreakRaiseEh;
end;

procedure TDataDriverEh.UpdateRecord(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh);
//var
//  UpdateAction: TMTUpdateActionEh;
begin
(*  Result := 1;
  UpdateAction := uaApplyEh;
  while True do
  begin
    UpdateAction := uaApplyEh;
//    if Assigned(OnUpdateRecord) then
//      OnUpdateRecord(DeltaDataSet, UpdateKind, UpdateAction);
    if UpdateAction <> uaRetryEh then Break;
  end;

  if UpdateAction in [uaAbortEh, uaSkipEh, uaAppliedEh] then Exit; { TODO : Support uaAbort in CachedUpdates mode }
  if UpdateAction = uaFailEh then
    DatabaseError('UpdateRecord is Fail');

  Result := DefaultUpdateRecord(MemRec);*)
  if Assigned(OnUpdateRecord)
    then OnUpdateRecord(MemTableData, MemRec)
    else DefaultUpdateRecord(MemTableData, MemRec);
end;

function TDataDriverEh.DefaultUpdateRecord(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh): Integer;
var
  vOldValues: Variant;
  i: Integer;
  KeyFound: Boolean;
  Bookmark: TBookmarkStr;
  ProviderField: TField;
begin
  Result := 0;
  if (ProviderDataSet <> nil) then
  begin
    Bookmark := ProviderDataSet.Bookmark;
    try

    if MemRec.UpdateStatus in [usModified, usDeleted] then
    begin
      vOldValues := MemRec.DataValues[KeyFields, dvvOldestValue];
      KeyFound := ProviderDataSet.Locate(KeyFields, vOldValues, []);
      if KeyFound then
      begin
        if (DataSetCompareBookmarks(ProviderDataSet,
          ProviderDataSet.Bookmark, Bookmark) = 0) and
          (MemRec.UpdateStatus = usDeleted)
        then // Will not go to the deleted bookmark
          Bookmark := '';
      end;
    end else
      KeyFound := True;

    if KeyFound then
    begin

      if MemRec.UpdateStatus = usModified then
        ProviderDataSet.Edit
      else if MemRec.UpdateStatus = usInserted then
        ProviderDataSet.Insert
      else
        ProviderDataSet.Delete;

      if MemRec.UpdateStatus in [usModified, usInserted] then
      begin
        try
          with MemRec do
            for i := 0 to DataStruct.Count-1 do
            begin
              ProviderField := ProviderDataSet.FindField(DataStruct[i].FieldName);
              if Assigned(ProviderField) and not ProviderField.ReadOnly then
                ProviderField.Value := Value[i, dvvValueEh];
            end;
          ProviderDataSet.Post;
        except
          on E: EDatabaseError do
          begin
            if ProviderDataSet.State in dsEditModes then
              ProviderDataSet.Cancel;
            raise;
          end;
        end;
//        if RefreshRecord then
//        begin
          MemRec.Edit;
          for i := 0 to MemRec.DataStruct.Count-1 do
            begin
              ProviderField := ProviderDataSet.FindField(MemRec.DataStruct[i].FieldName);
              if Assigned(ProviderField) and not ProviderField.ReadOnly then
                MemRec.Value[i, dvvValueEh] := ProviderField.Value;
            end;
          MemRec.Post;
//        end;
      end;

      Result := 1;
    end;
    finally
      if (Bookmark <> '') and DataSetBookmarkValid(ProviderDataSet, Bookmark) then
        ProviderDataSet.Bookmark := Bookmark;
    end;

    MemRec.MergeChanges;
  end;
end;

procedure TDataDriverEh.ConsumerClosed(ConsumerDataSet: TDataSet);
begin
  if (ProviderDataSet <> nil) then
    ProviderDataSet.Close;
  ProviderEOF := True;
end;

function TDataDriverEh.RefreshReaderParamsFromCursor(DataSet: TDataSet): Boolean;
var
  FParams: TParams;
  Field: TField;
  I: Integer;
begin
  Result := False;
  FParams := nil;
{$IFDEF EH_LIB_5}
  if (ProviderDataSet <> nil) then
    FParams := IProviderSupport(ProviderDataSet).PSGetParams();
  if FParams <> nil then
    for I := 0 to FParams.Count - 1 do
    begin
      Field := DataSet.FindField(FParams[I].Name);
      if (Field <> nil) and not VarEquals(Field.Value, FParams[I].Value) then
      begin
        Result := True;
        Break;
      end;
    end;
{$ENDIF}
end;

procedure TDataDriverEh.SetReaderParamsFromCursor(DataSet: TDataSet);
var
  I: Integer;
  FParams: TParams;
begin
  FParams := nil;
{$IFDEF EH_LIB_5}
  if (ProviderDataSet <> nil) then
    FParams := IProviderSupport(ProviderDataSet).PSGetParams();
  if FParams <> nil then
  begin
    DataSet.FieldDefs.Update;
    for I := 0 to FParams.Count - 1 do
      with FParams[I] do
        if not Bound then
        begin
          AssignField(DataSet.FieldByName(Name));
          Bound := False;
        end;
  end;
{$ENDIF}
end;

procedure TDataDriverEh.BuildDataStruct(DataStruct: TMTDataStructEh);
var
  DS: TDataSet;
begin
  if Assigned(FOnBuildDataStruct) then
    OnBuildDataStruct(DataStruct)
  else if Assigned(FOnProduceDataReader) then
  begin
    DS := GetDataReader;
    DataStruct.BuildStructFromFields(DS.Fields);
  end else
    DefaultBuildDataStruct(DataStruct);
end;

procedure TDataDriverEh.DefaultBuildDataStruct(DataStruct: TMTDataStructEh);
begin
  if (ReaderDataSet <> nil) then
  begin
    DataStruct.BuildStructFromFields(ReaderDataSet.Fields);
    SetAutoIncFields(ReaderDataSet.Fields, DataStruct);
  end else if (ProviderDataSet <> nil) then
  begin
    if ProviderDataSet.FieldCount > 0 then
      DataStruct.BuildStructFromFields(ProviderDataSet.Fields)
    else
    begin
      ProviderDataSet.Active := True;
      DataStruct.BuildStructFromFields(ProviderDataSet.Fields);
      ProviderDataSet.Active := False;
    end;
    SetAutoIncFields(ProviderDataSet.Fields, DataStruct);
  end;
end;

procedure TDataDriverEh.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
    if AComponent = FProviderDataSet then
      ProviderDataSet := nil;
  end;
end;

function TDataDriverEh.GetDataReader: TDataSet;
begin
  if FReaderDataSet <> nil then
    Result := FReaderDataSet
  else
  begin
    FReaderDataSetFreeOnEof := False;
    ProviderEOF := False;
    if Assigned(FOnProduceDataReader) then
      OnProduceDataReader(FReaderDataSet, FReaderDataSetFreeOnEof)
    else
      DefaultProduceDataReader(FReaderDataSet, FReaderDataSetFreeOnEof);
    Result := FReaderDataSet;
  end;
end;

procedure TDataDriverEh.DefaultProduceDataReader(var DataSet: TDataSet; var FreeOnEof: Boolean);
begin
  if (ProviderDataSet <> nil) then
  begin
    ProviderDataSet.Active := True;
    ProviderDataSet.First;
    FreeOnEof := False;
    DataSet := ProviderDataSet;
  end;
end;

function TDataDriverEh.ReadData(MemTableData: TMemTableDataEh; Count: Integer): Integer;
var
  Rec: TMemoryRecordEh;
  AProviderEOF: Boolean;
begin
  Result := 0;
  if ProviderEOF = True then Exit;
  while Count <> 0 do
  begin
    Rec := MemTableData.RecordsList.NewRecord;
    try
      if Assigned(OnReadRecord)
        then OnReadRecord(MemTableData, Rec, AProviderEOF)
        else DefaultReadRecord(MemTableData, Rec, AProviderEOF);
    except
      Rec.Free;
      raise;
    end;
    ProviderEOF := AProviderEOF;
    if ProviderEOF
      then Rec.Free
      else MemTableData.RecordsList.FetchRecord(Rec);

    Inc(Result);
    if ProviderEOF then Exit;
    Dec(Count);
  end;
end;

procedure TDataDriverEh.DefaultReadRecord(MemTableData: TMemTableDataEh;
  Rec: TMemoryRecordEh; var ProviderEOF: Boolean);
var
  i: Integer;
begin
  ProviderEOF := False;
  if (ReaderDataSet = nil) or
   ((ReaderDataSet <> nil) and not ReaderDataSet.Active) or
   ((ReaderDataSet <> nil) and ReaderDataSet.Active and ReaderDataSet.Eof)
  then
    ProviderEOF := True;
  if (ReaderDataSet = nil) or (ProviderEOF = True) then
    Exit;

  for i := 0 to Rec.DataStruct.Count-1 do
    AssignFieldValue(MemTableData, Rec, i, dvvValueEh, ReaderDataSet);

  ReaderDataSet.Next;
end;

procedure TDataDriverEh.AssignFieldValue(MemTableData: TMemTableDataEh;
  MemRec: TMemoryRecordEh; DataFieldIndex: Integer;
  DataValueVersion: TDataValueVersionEh; ReaderDataSet: TDataSet);
begin
  if Assigned(OnAssignFieldValue)
    then OnAssignFieldValue(MemTableData, MemRec, DataFieldIndex, DataValueVersion, ReaderDataSet)
    else DefaultAssignFieldValue(MemTableData, MemRec, DataFieldIndex, DataValueVersion, ReaderDataSet);
end;

procedure TDataDriverEh.DefaultAssignFieldValue(MemTableData: TMemTableDataEh;
  MemRec: TMemoryRecordEh; DataFieldIndex: Integer;
  DataValueVersion: TDataValueVersionEh; ReaderDataSet: TDataSet);
var
  Field: TField;
begin
  Field := ReaderDataSet.FindField(MemRec.DataStruct[DataFieldIndex].FieldName);
  if Field <> nil then
    MemRec.Value[DataFieldIndex, DataValueVersion] := Field.Value;
end;

procedure TDataDriverEh.DefaultRefreshRecord(MemRecord: TMemoryRecordEh);
var
  vValues: Variant;
  i: Integer;
  KeyFound: Boolean;
  Bookmark: TBookmarkStr;
//  DeltaDataSet: TMemTableDataEh;
//  DeltaRec: TMemoryRecordEh;
begin
  if (ProviderDataSet <> nil) then
  begin
//    DeltaDataSet := CreateDeltaData;
//    DeltaDataSet.DataStruct.Assign(MemRecord.DataStruct);
    try

//      DeltaRec := DeltaDataSet.RecordsList.NewRecord;