datadrivereh.pas

最新的 DBGRIDEH4.0

  FDesignDataBase := nil;
  FreeAndNil(FSpecParams);
  inherited Destroy;
end;

procedure TCustomSQLDataDriverEh.SetSelectCommand(const Value: TCustomSQLCommandEh);
begin
  FSelectCommand.Assign(Value);
end;

procedure TCustomSQLDataDriverEh.SetDeleteCommand(const Value: TCustomSQLCommandEh);
begin
  FDeleteCommand.Assign(Value);
end;

procedure TCustomSQLDataDriverEh.SetInsertCommand(const Value: TCustomSQLCommandEh);
begin
  FInsertCommand.Assign(Value);
end;

procedure TCustomSQLDataDriverEh.SetGetrecCommand(const Value: TCustomSQLCommandEh);
begin
  FGetrecCommand.Assign(Value);
end;

procedure TCustomSQLDataDriverEh.SetUpdateCommand(const Value: TCustomSQLCommandEh);
begin
  FUpdateCommand.Assign(Value);
end;

procedure TCustomSQLDataDriverEh.DefaultProduceDataReader(var DataSet: TDataSet; var FreeOnEof: Boolean);
begin
  if ProviderDataSet <> nil
    then inherited DefaultProduceDataReader(DataSet, FreeOnEof)
    else ExecuteCommand(SelectCommand, DataSet, FreeOnEof);
end;

procedure TCustomSQLDataDriverEh.DefaultBuildDataStruct(DataStruct: TMTDataStructEh);
var
  AReaderDS: TDataSet;
  AFreeOnEof: Boolean;
begin
  if (ReaderDataSet <> nil) or (ProviderDataSet <> nil) then
    inherited DefaultBuildDataStruct(DataStruct)
  else
  begin
//    if AReaderDS = nil then
      ExecuteCommand(SelectCommand, AReaderDS, AFreeOnEof);
    if AReaderDS = nil then
      raise Exception.Create('SelectCommand.Execute does not get DataSet');
    AReaderDS.Active := True;
    DataStruct.BuildStructFromFields(AReaderDS.Fields);
    AReaderDS.Active := False;
    if AFreeOnEof then
      AReaderDS.Free;
  end;
end;

function TCustomSQLDataDriverEh.DefaultExecuteCommand(Command: TCustomSQLCommandEh;
  var Cursor: TDataSet; var FreeOnEof: Boolean): Integer;
var
  Processed: Boolean;
  DesignDataBaseIntf: IDesignDataBaseEh;
begin
//  ShowMessage('DefaultExecuteCommand 1');

  { TODO : Is it valid technology? }
  if HaveDataConnection then
    Result := Command.Execute(Cursor, FreeOnEof)
  else
  begin
//    ShowMessage('DefaultExecuteCommand 2');
    Result := -1;
    Processed := False;
    if (csDesigning in ComponentState) and
       (GetDesignDataBase <> nil) and
       (Supports(DesignDataBase, IDesignDataBaseEh, DesignDataBaseIntf)) then
    begin
      DesignDataBaseIntf.Execute(Command, Cursor, FreeOnEof);
      Processed := True;
    end else
    begin
      if Assigned(FDefaultSQLDataDriverResolver) then
        Result := FDefaultSQLDataDriverResolver.ExecuteCommand(Self, Command, Cursor, FreeOnEof, Processed);
      if not Processed then
        Result := Command.Execute(Cursor, FreeOnEof);
    end;
  end;
end;

function TCustomSQLDataDriverEh.ExecuteCommand(Command: TCustomSQLCommandEh;
  var Cursor: TDataSet; var FreeOnEof: Boolean): Integer;
begin
  if Assigned(OnExecuteCommand)
    then Result := OnExecuteCommand(Self, Command, Cursor, FreeOnEof)
    else Result := DefaultExecuteCommand(Command, Cursor, FreeOnEof);
end;

procedure TCustomSQLDataDriverEh.DefaultRefreshRecord(MemRecord: TMemoryRecordEh);
var
  i: Integer;
  RecDataSet: TDataSet;
  AFreeOnEof: Boolean;
begin
  if ResolveToDataSet then
    inherited RefreshRecord(MemRecord)
  else
  begin
    GetrecCommand.RefreshParams(MemRecord, dvvOldestValue);
    ExecuteCommand(GetrecCommand, RecDataSet, AFreeOnEof);
    try
      if RecDataSet.IsEmpty then
        raise Exception.Create('There are no fresh record on server');

      for i := 0 to MemRecord.DataStruct.Count-1 do
        AssignFieldValue(MemRecord.DataStruct.MemTableData, MemRecord, i,
          dvvOldestValue, RecDataSet)
{      begin
        Field := RecDataSet.FindField(MemRecord.DataStruct[i].FieldName);
        if Field <> nil then
          MemRecord.Value[i, dvtOldestValue] := Field.Value;
      end;}

    finally
      if AFreeOnEof then
        RecDataSet.Free;
    end;
  end;
end;

function TCustomSQLDataDriverEh.DoUpdateRecord(MemTableData: TMemTableDataEh; MemRec: TMemoryRecordEh): Integer;
var
  Command: TCustomSQLCommandEh;
  ResDataSet: TDataSet;
  AFreeOnEof: Boolean;
begin
  Result := 0;
  if ResolveToDataSet then
    Result := inherited DefaultUpdateRecord(MemTableData, MemRec)
  else
  begin
    Command := nil;
    if  ((MemRec.UpdateStatus = usModified) and (dsoDynamicSQLUpdateEh in DynaSQLParams.Options))
     or ((MemRec.UpdateStatus = usInserted) and (dsoDynamicSQLInsertEh in DynaSQLParams.Options))
     or ((MemRec.UpdateStatus = usDeleted) and (dsoDynamicSQLDeleteEh in DynaSQLParams.Options)) then
    begin
      GenerateDynamicSQLCommand(MemRec, ServiceCommand);
      Command := ServiceCommand;
    end else
      case MemRec.UpdateStatus of
        usModified: Command := UpdateCommand;
        usInserted: Command := InsertCommand;
        usDeleted: Command := DeleteCommand;
      end;
    if Command = nil then Exit;
    Command.RefreshParams(MemRec, dvvValueEh);
    Result := ExecuteCommand(Command, ResDataSet, AFreeOnEof);
    GetBackUpdatedValues(MemRec, Command, ResDataSet);
    if AFreeOnEof then
      ResDataSet.Free;
//    MemRec.MergeChanges;
  end
end;

function TCustomSQLDataDriverEh.DefaultUpdateRecord(MemTableData: TMemTableDataEh;
  MemRec: TMemoryRecordEh): Integer;
var
  Processed: Boolean;
begin
  Result := 0;
  Processed := False;
  if Assigned(FDefaultSQLDataDriverResolver) then
    FDefaultSQLDataDriverResolver.UpdateRecord(Self, MemTableData, MemRec, Processed);
  if not Processed then
  begin
    if InternalGetServerSpecOperations <> nil
      then Result := InternalGetServerSpecOperations.UpdateRecord(Self, MemTableData, MemRec)
      else Result := DoUpdateRecord(MemTableData, MemRec);
  end;
end;

procedure TCustomSQLDataDriverEh.GetBackUpdatedValues(MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet);
begin
  if Assigned(FOnGetBackUpdatedValues)
    then OnGetBackUpdatedValues(Self, MemRec, Command, ResDataSet)
    else DefaultGetUpdatedServerValues(MemRec, Command, ResDataSet);
end;

procedure TCustomSQLDataDriverEh.DefaultGetUpdatedServerValues(
  MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet);
var
  Processed: Boolean;
begin
  Processed := False;
  if Assigned(FDefaultSQLDataDriverResolver) then
    FDefaultSQLDataDriverResolver.GetBackUpdatedValues(Self, MemRec, Command, ResDataSet, Processed);
  if not Processed and (InternalGetServerSpecOperations <> nil) then
    InternalGetServerSpecOperations.GetBackUpdatedValues(MemRec, Command, ResDataSet);
end;

function TCustomSQLDataDriverEh.CreateDeleteCommand: TCustomSQLCommandEh;
begin
  Result := CreateCommand;
end;

function TCustomSQLDataDriverEh.CreateInsertCommand: TCustomSQLCommandEh;
begin
  Result := CreateCommand;
end;

function TCustomSQLDataDriverEh.CreateSelectCommand: TCustomSQLCommandEh;
begin
  Result := CreateCommand;
end;

function TCustomSQLDataDriverEh.CreateGetrecCommand: TCustomSQLCommandEh;
begin
  Result := CreateCommand;
end;

function TCustomSQLDataDriverEh.CreateUpdateCommand: TCustomSQLCommandEh;
begin
  Result := CreateCommand;
end;

{
function TCustomSQLDataDriverEh.GetReaderDataSet: TDataSet;
begin
  if ProviderDataSet <> nil
    then Result := inherited GetReaderDataSet
    else Result := FReaderDataSet;
end;
}

function TCustomSQLDataDriverEh.GetDefaultCommandTypeFor(Command: TCustomSQLCommandEh): TSQLCommandTypeEh;
begin
  if (Command = SelectCommand) or (Command = GetrecCommand)
    then Result := cthSelectQuery
    else Result := cthUpdateQuery;
end;

procedure RegisterDesignDataBuilderProcEh(DataDriverClass: TSQLDataDriverEhClass;
  DesignDataBaseProc: TSetDesignDataBaseProcEh);
var
  ExistsIdx: Integer;
begin
  if DesignDataBuilderClasses = nil then
  begin
    DesignDataBuilderClasses := TList.Create;
    DesignDataBuilderProcs := TList.Create;
  end;
  ExistsIdx := DesignDataBuilderClasses.IndexOf(TObject(DataDriverClass));
  if ExistsIdx >= 0 then
    DesignDataBuilderProcs[ExistsIdx] := @DesignDataBaseProc
  else
  begin
    DesignDataBuilderClasses.Add(TObject(DataDriverClass));
    DesignDataBuilderProcs.Add(@DesignDataBaseProc);
  end;
end;

procedure UnregisterDesignDataBuilderProcEh(DataDriverClass: TSQLDataDriverEhClass);
var
  ExistsIdx: Integer;
begin
  if DesignDataBuilderClasses = nil then Exit;
  ExistsIdx := DesignDataBuilderClasses.IndexOf(TObject(DataDriverClass));
  if ExistsIdx >= 0 then
  begin
    DesignDataBuilderClasses.Delete(ExistsIdx);
    DesignDataBuilderProcs.Delete(ExistsIdx);
  end;
end;

function GetDesignDataBuilderProcEh(DataDriverClass: TSQLDataDriverEhClass):
  TSetDesignDataBaseProcEh;

  function GetDatasetFeaturesDeep(ARootClass, AClass: TClass): Integer;
  begin
    Result := 0;
    while True do
    begin
      if ARootClass = AClass then
        Exit;
      Inc(Result);
      AClass := AClass.ClassParent;
      if AClass = nil then
      begin
        Result := MAXINT;
        Exit;
      end;
    end;
  end;

var
  Deep, MeenDeep, i: Integer;
  TargetClass: TSQLDataDriverEhClass;
begin
  Result := nil;
  if DesignDataBuilderClasses = nil then Exit;
  MeenDeep := MAXINT;
  for i := 0 to DesignDataBuilderClasses.Count - 1 do
  begin
    if DataDriverClass.InheritsFrom(TSQLDataDriverEhClass(DesignDataBuilderClasses[i])) then
    begin
      TargetClass := TSQLDataDriverEhClass(DesignDataBuilderClasses[i]);
      Deep := GetDatasetFeaturesDeep(TargetClass, DataDriverClass);
      if Deep < MeenDeep then
      begin
        MeenDeep := Deep;
        Result := TSetDesignDataBaseProcEh(DesignDataBuilderProcs[i]);
      end;
    end;
  end;
end;

function TCustomSQLDataDriverEh.CreateDesignDataBase: TComponent;
begin
  Result := nil;
end;

procedure TCustomSQLDataDriverEh.AssignFromDesignDriver(DesignDataDriver: TCustomSQLDataDriverEh);
begin
  SelectCommand := DesignDataDriver.SelectCommand;
  UpdateCommand := DesignDataDriver.UpdateCommand;
  InsertCommand := DesignDataDriver.InsertCommand;
  DeleteCommand := DesignDataDriver.DeleteCommand;
  GetrecCommand := DesignDataDriver.GetrecCommand;
end;

function TCustomSQLDataDriverEh.CreateDesignCopy: TCustomSQLDataDriverEh;
begin
  Result := TCustomSQLDataDriverEh.Create(nil);
  Result.SelectCommand := SelectCommand;
  Result.UpdateCommand := UpdateCommand;
  Result.InsertCommand := InsertCommand;
  Result.DeleteCommand := DeleteCommand;
  Result.GetrecCommand := GetrecCommand;
end;


function TCustomSQLDataDriverEh.GetSelectSQL: TStrings;
begin
  Result := SelectCommand.CommandText;
end;

procedure TCustomSQLDataDriverEh.SetSelectSQL(const Value: TStrings);
begin
  SelectCommand.CommandText := Value;
end;

function TCustomSQLDataDriverEh.GetDeleteSQL: TStrings;
begin
  Result := DeleteCommand.CommandText;
end;

procedure TCustomSQLDataDriverEh.SetDeleteSQL(