datadrivereh.pas

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

end;

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

procedure TCustomSQLDataDriverEh.DefaultGetUpdatedServerValues(
  MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh; ResDataSet: TDataSet);
begin

end;

function TCustomSQLDataDriverEh.CreateDeleteCommand: TCustomSQLCommandEh;
begin
  Result := TCustomSQLCommandEh.Create(Self);
end;

function TCustomSQLDataDriverEh.CreateInsertCommand: TCustomSQLCommandEh;
begin
  Result := TCustomSQLCommandEh.Create(Self);
end;

function TCustomSQLDataDriverEh.CreateSelectCommand: TCustomSQLCommandEh;
begin
  Result := TCustomSQLCommandEh.Create(Self);
end;

function TCustomSQLDataDriverEh.CreateGetrecCommand: TCustomSQLCommandEh;
begin
  Result := TCustomSQLCommandEh.Create(Self);
end;

function TCustomSQLDataDriverEh.CreateUpdateCommand: TCustomSQLCommandEh;
begin
  Result := TCustomSQLCommandEh.Create(Self);
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;

var
  DesignDataBuilderClasses: TList;
  DesignDataBuilderProcs: TList;

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: IInterface;
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(const Value: TStrings);
begin
  DeleteCommand.CommandText := Value;
end;

function TCustomSQLDataDriverEh.GetGetrecSQL: TStrings;
begin
  Result := GetrecCommand.CommandText;
end;

procedure TCustomSQLDataDriverEh.SetGetrecSQL(const Value: TStrings);
begin
  GetrecCommand.CommandText := Value;
end;

function TCustomSQLDataDriverEh.GetInsertSQL: TStrings;
begin
  Result := InsertCommand.CommandText;
end;

procedure TCustomSQLDataDriverEh.SetInsertSQL(const Value: TStrings);
begin
  InsertCommand.CommandText := Value;
end;

function TCustomSQLDataDriverEh.GetUpdateSQL: TStrings;
begin
  Result := UpdateCommand.CommandText;
end;

procedure TCustomSQLDataDriverEh.SetUpdateSQL(const Value: TStrings);
begin
  UpdateCommand.CommandText := Value;
end;

{ TBaseSQLDataDriverEh }

procedure TBaseSQLDataDriverEh.AssignCommandParam(
  Command: TBaseSQLCommandEh; MemRecord: TMemoryRecordEh;
  DataValueVersion: TDataValueVersionEh; Param: TParam);
begin
  if Assigned(OnAssignCommandParam)
    then OnAssignCommandParam(Command, MemRecord, DataValueVersion, Param)
    else DefaultAssignCommandParam(Command, MemRecord, DataValueVersion, Param);
end;


function TBaseSQLDataDriverEh.CreateDeleteCommand: TCustomSQLCommandEh;
begin
  Result := TBaseSQLCommandEh.Create(Self);
end;

function TBaseSQLDataDriverEh.CreateInsertCommand: TCustomSQLCommandEh;
begin
  Result := TBaseSQLCommandEh.Create(Self);
end;

function TBaseSQLDataDriverEh.CreateSelectCommand: TCustomSQLCommandEh;
begin
  Result := TBaseSQLCommandEh.Create(Self);
end;

function TBaseSQLDataDriverEh.CreateGetrecCommand: TCustomSQLCommandEh;
begin
  Result := TBaseSQLCommandEh.Create(Self);
end;

function TBaseSQLDataDriverEh.CreateUpdateCommand: TCustomSQLCommandEh;
begin
  Result := TBaseSQLCommandEh.Create(Self);
end;

procedure TBaseSQLDataDriverEh.DefaultAssignCommandParam(
  Command: TBaseSQLCommandEh; MemRecord: TMemoryRecordEh;
  DataValueVersion: TDataValueVersionEh; Param: TParam);
var
  FIndex: Integer;
begin
  FIndex := MemRecord.DataStruct.FieldIndex(Param.Name);
  if FIndex >= 0 then
  begin
    { TODO : Check DataType as in TParam.AssignFieldValue }
    if Command.ParamCheck then
      Param.DataType := MemRecord.DataStruct[FIndex].DataType;
    Param.Value := MemRecord.DataValues[Param.Name, DataValueVersion];
  end
  else if (UpperCase(Copy(Param.Name,1, Length('OLD_'))) = 'OLD_') then
  begin
    FIndex := MemRecord.DataStruct.FieldIndex(Copy(Param.Name, 5, 255));
    if FIndex >= 0 then
    begin
      if Command.ParamCheck then
        Param.DataType := MemRecord.DataStruct[FIndex].DataType;
      Param.Value := MemRecord.DataValues[Copy(Param.Name, 5, 255), dvvOldestValue];
    end
  end;
end;


procedure TBaseSQLDataDriverEh.DefaultGetUpdatedServerValues(
  MemRec: TMemoryRecordEh; Command: TCustomSQLCommandEh;
  ResDataSet: TDataSet);
var
  i: Integer;
  DataField: TMTDataFieldEh;
  ACommand: TBaseSQLCommandEh;
begin
  ACommand := TBaseSQLCommandEh(Command);
  // Use params
  for i := 0 to ACommand.Params.Count-1 do
  begin
    DataField := nil;
    if ACommand.Params[i].ParamType in [ptOutput, ptInputOutput, ptResult] then
      DataField := MemRec.DataStruct.FindField(ACommand.Params[i].Name);
    if DataField <> nil then
    { TODO : Assign server values in future }
      MemRec.DataValues[ACommand.Params[i].Name, dvvValueEh] := ACommand.Params[i].Value;
  end;

  // Use result dataset
  if (ResDataSet <> nil) and not ResDataSet.IsEmpty then
    for i := 0 to ResDataSet.FieldCount-1 do
    begin
      DataField := MemRec.DataStruct.FindField(ResDataSet.Fields[i].FieldName);
      if DataField <> nil then
      { TODO : Assign server values in future }
        MemRec.DataValues[ResDataSet.Fields[i].FieldName, dvvValueEh] := ResDataSet.Fields[i].Value;
    end;
end;

function TBaseSQLDataDriverEh.GetDeleteCommand: TBaseSQLCommandEh;
begin
  Result := TBaseSQLCommandEh(inherited DeleteCommand);
end;

procedure TBaseSQLDataDriverEh.SetDeleteCommand(const Value: TBaseSQLCommandEh);
begin
  inherited DeleteCommand := Value;
end;

function TBaseSQLDataDriverEh.GetInsertCommand: TBaseSQLCommandEh;
begin
  Result := TBaseSQLCommandEh(inherited InsertCommand);
end;

procedure TBaseSQLDataDriverEh.SetInsertCommand(const Value: TBaseSQLCommandEh);
begin
  inherited InsertCommand := Value;
end;

function TBaseSQLDataDriverEh.GetSelectCommand: TBaseSQLCommandEh;
begin
  Result := TBaseSQLCommandEh(inherited SelectCommand);
end;

procedure TBaseSQLDataDriverEh.SetSelectCommand(const Value: TBaseSQLCommandEh);
begin
  inherited SelectCommand := Value;
end;

function TBaseSQLDataDriverEh.GetGetrecCommand: TBaseSQLCommandEh;
begin
  Result := TBaseSQLCommandEh(inherited GetrecCommand);
end;

procedure TBaseSQLDataDriverEh.SetGetrecCommand(const Value: TBaseSQLCommandEh);
begin
  inherited GetrecCommand := Value;
end;

function TBaseSQLDataDriverEh.GetUpdateCommand: TBaseSQLCommandEh;
begin
  Result := TBaseSQLCommandEh(inherited UpdateCommand);
end;

procedure TBaseSQLDataDriverEh.SetUpdateCommand(const Value: TBaseSQLCommandEh);
begin
  inherited UpdateCommand := Value;
end;

{ TSQLDataDriverEh }

function TSQLDataDriverEh.CreateDeleteCommand: TCustomSQLCommandEh;
begin
  Result := TSQLCommandEh.Create(Self);
end;

function TSQLDataDriverEh.CreateGetrecCommand: TCustomSQLCommandEh;
begin
  Result := TSQLCommandEh.Create(Self);
end;

function TSQLDataDriverEh.CreateInsertCommand: TCustomSQLCommandEh;
begin
  Result := TSQLCommandEh.Create(Self);
end;

function TSQLDataDriverEh.CreateSelectCommand: TCustomSQLCommandEh;
begin
  Result := TSQLCommandEh.Create(Self);
end;

function TSQLDataDriverEh.CreateUpdateCommand: TCustomSQLCommandEh;
begin
  Result := TSQLCommandEh.Create(Self);
end;

{ TSQLDataDriverResolver }

function TSQLDataDriverResolver.ExecuteCommand(
  SQLDataDriver: TCustomSQLDataDriverEh; Command: TCustomSQLCommandEh;
  var Cursor: TDataSet; var FreeOnEof: Boolean; var Processed: Boolean): Integer;
begin
  Result := -1;
  if Assigned(OnExecuteCommand)
    then Result := OnExecuteCommand(SQLDataDriver, Command, Cursor, FreeOnEof, Processed)
    else Processed := False;
end;

initialization
  RegisterDefaultSQLDataDriverResolver(TSQLDataDriverResolver.Create);
finalization
  FDefaultSQLDataDriverResolver.Free;
  FDefaultSQLDataDriverResolver := nil;
  DesignDataBuilderClasses.Free;
  DesignDataBuilderClasses := nil;
  DesignDataBuilderProcs.Free;
  DesignDataBuilderProcs := nil;
end.