如果我说你看看源码吧,你肯定不满意.
如果我把VCL源码都贴出来,肯定有人要骂娘
我自己都还没搞清楚,我也记不清李维的书上是怎么写的了.
可是,李维的书是怎么写出来的,还不是看源码,调试源码摸出来的
(当然啦他也可能利用自己特使身份从INPRISE那搞点内幕也不无可能)
我也不是写书的,现在也没这么多时间把他搞得很清楚,
当然啦,可能给我时间我也搞不清楚.
你看看下面有关VCL源码,看完之后,有时间接着讨论.
/////////////////////////////////////////////////////////////////////////////
{TDataSetProvider }
/////////////////////////////////////////////////////////////////////////////
function TDataSetProvider.InternalApplyUpdates(const Delta: OleVariant;
MaxErrors: Integer;
out ErrorCount: Integer): OleVariant;
var
TransactionStarted: Boolean;
begin
CheckDataSet;
TransactionStarted := not IProviderSupport(DataSet).PSInTransaction;
if TransactionStarted then
IProviderSupport(DataSet).PSStartTransaction;
try
CheckResolver;
Resolver.FUpdateTree.InitData(DataSet);
try
Result := inherited InternalApplyUpdates(Delta, MaxErrors, ErrorCount);
finally
Resolver.FUpdateTree.InitData(nil);
end;
finally
if TransactionStarted then
IProviderSupport(DataSet).PSEndTransaction((ErrorCount <= MaxErrors) or (MaxErrors = -1));
end;
end;
procedure TDataSetProvider.SetResolveToDataSet(Value: Boolean);
begin
if (Value <> FResolveToDataSet) and Assigned(Resolver) then
FreeResolver;
FResolveToDataSet := Value;
end;
function TDataSetProvider.CreateResolver: TCustomResolver;
begin
if ResolveToDataSet then
Result := TDataSetResolver.Create(Self) else
Result := TSQLResolver.Create(Self);
end;
procedure TDataSetProvider.CheckDataSet;
begin
if not Assigned(DataSet) then
DatabaseError(SMissingDataSet);
end;
/////////////////////////////////////////////////////////////////////////////
{ TDataSetResolver }
/////////////////////////////////////////////////////////////////////////////
constructor TDataSetResolver.Create(AProvider: TDataSetProvider);
begin
inherited Create(AProvider);
FOpened := False;
end;
function TDataSetResolver.GetProvider: TDataSetProvider;
begin
Result := TDataSetProvider(inherited Provider);
end;
procedure TDataSetResolver.begin
Update;
begin
FOpened := not Provider.DataSet.Active;
if FOpened then
begin
Provider.DataSet.Open;
FBookmark := '';
end else
FBookmark := Provider.DataSet.Bookmark;
end;
procedure TDataSetResolver.EndUpdate;
begin
if FOpened then
begin
Provider.DataSet.Close;
FOpened := False;
end else
begin
if (Length(FBookmark) > 0) and
Provider.DataSet.BookmarkValid(@FBookmark[1]) then
Provider.DataSet.Bookmark := FBookmark;
end;
end;
procedure TDataSetResolver.InitializeConflictBuffer(Tree: TUpdateTree);
begin
{ Set the conflict buffer to the current values of the data }
if Provider.FindRecord(Tree.Source, Tree.Delta, upWhereKeyOnly) then
Tree.Delta.AssignCurValues(Tree.Source);
end;
procedure TDataSetResolver.InternalBeforeResolve(Tree: TUpdateTree);
begin
Provider.FindRecord(Tree.Source, Tree.Delta, Provider.UpdateMode);
end;
procedure TDataSetResolver.PutRecord(Tree: TUpdateTree);
procedure PutField(Src, Dest: TField);
forward;
procedure PutObjectField(Src, Dest: TObjectField);
var
i: Integer;
begin
if VarIsNull(Src.NewValue) then
Dest.Clear else
for i := 0 to Src.FieldCount - 1do
if (not VarIsEmpty(Src.Fields.NewValue)) and
(pfInUpdate in Src.Fields.ProviderFlags) then
PutField(Src.Fields, Dest.Fields);
end;
procedure PutField(Src, Dest: TField);
begin
if (Src.DataType in [ftArray, ftADT]) then
PutObjectField(TObjectField(Src), TObjectField(Dest)) else
if (Src.DataType in [ftDataSet, ftReference]) then
raise Exception.CreateRes(@SNoDataSets) else
if (not VarIsEmpty(Src.NewValue)) and
(pfInUpdate in Src.ProviderFlags) then
Dest.Assign(Src);
end;
var
i: Integer;
Field: TField;
begin
with Treedo
try
for i := 0 to Delta.FieldCount - 1do
begin
Field := Source.FindField(Delta.Fields.FieldName);
if (Field <> nil) then
PutField(Delta.Fields, Field);
end;
Source.Post;
except
Source.Cancel;
raise;
end;
end;
procedure TDataSetResolver.DoUpdate(Tree: TUpdateTree);
begin
with Treedo
begin
if not Provider.FindRecord(Source, Delta, Provider.UpdateMode) then
DatabaseError(SRecordChanged);
Source.Edit;
PutRecord(Tree);
end;
end;
procedure TDataSetResolver.DoDelete(Tree: TUpdateTree);
begin
with Treedo
begin
if Provider.FindRecord(Tree.Source, Tree.Delta, Provider.UpdateMode) then
Source.Delete else
DatabaseError(SRecordChanged);
end;
end;
procedure TDataSetResolver.DoInsert(Tree: TUpdateTree);
begin
Tree.Source.Append;
PutRecord(Tree);
end;
/////////////////////////////////////////////////////////////////////////////
{ TSQLResolver }
/////////////////////////////////////////////////////////////////////////////
type
PSQLInfo = ^TSQLInfo;
TSQLInfo = record
IsSQLBased: Boolean;
QuoteChar: string;
QuotedTable: string;
QuotedTableDot: string;
Opened: Boolean;
HasObjects: Boolean;
end;
constructor TSQLResolver.Create(AProvider: TDataSetProvider);
begin
inherited Create(AProvider);
FSQL := TStringList.Create;
FParams := TParams.Create(nil);
end;
destructor TSQLResolver.Destroy;
begin
FSQL.Free;
FParams.Free;
inherited Destroy;
end;
function TSQLResolver.GetProvider: TDataSetProvider;
begin
Result := TDataSetProvider(inherited Provider);
end;
procedure TSQLResolver.DoExecSQL(SQL: TStringList;
Params: TParams);
var
RowsAffected: Integer;
begin
RowsAffected := IProviderSupport(Provider.DataSet).PSExecuteStatement(SQL.Text, Params);
if not (poAllowMultiRecordUpdates in Provider.Options) and (RowsAffected > 1) then
DatabaseError(STooManyRecordsModified);
if RowsAffected < 1 then
DatabaseError(SRecordChanged);
end;
procedure TSQLResolver.DoGetValues(SQL: TStringList;
Params: TParams;
DataSet: TDataSet);
var
DS: TDataSet;
begin
DS := nil;
IProviderSupport(Provider.DataSet).PSExecuteStatement(SQL.Text, Params, @DS);
if Assigned(DS) then
try
TPacketDataSet(DataSet).AssignCurValues(DS)
finally
DS.Free;
end;
end;
procedure TSQLResolver.InternalDoUpdate(Tree: TUpdateTree;
UpdateKind: TUpdateKind);
var
Alias: string;
begin
if not IProviderSupport(Tree.Source).PSUpdateRecord(UpdateKind, Tree.Delta) then
begin
if (PSQLInfo(Tree.Data)^.QuotedTable = '') and not Tree.IsNested then
DatabaseError(SNoTableName);
if PSQLInfo(Tree.Data)^.HasObjects then
Alias := DefAlias else
Alias := '';
FSQL.Clear;
FParams.Clear;
case UpdateKind of
ukModify: GenUpdateSQL(Tree, FSQL, FParams, Alias);
ukInsert: GenInsertSQL(Tree, FSQL, FParams);
ukDelete: GenDeleteSQL(Tree, FSQL, FParams, Alias);
end;
do
ExecSQL(FSQL, FParams);
end;
end;
procedure TSQLResolver.DoUpdate(Tree: TUpdateTree);
begin
InternalDoUpdate(Tree, ukModify);
end;
procedure TSQLResolver.DoDelete(Tree: TUpdateTree);
begin
InternalDoUpdate(Tree, ukDelete);
end;
procedure TSQLResolver.DoInsert(Tree: TUpdateTree);
begin
InternalDoUpdate(Tree, ukInsert);
end;
