📄 uaclientdataset.pas
字号:
aMasterDataSet.GetFieldList(lList,MasterFields);
for i := 0 to lList.Count -1 do
begin
aMasterLink := TMasterLinkParam.Create;
with TField(lList.Items[i]) do
begin
aMasterLink.MasterAliasTableName := TUAClientDataSet(aMasterDataSet).AliasTableName;
aMasterLink.MasterField := IndexFields[I].FieldName;
aMasterLink.DataType := IndexFields[I].DataType;
if not VarIsNull(Value) then
aMasterLink.MasterFieldValue := Value
else
aMasterLink.MasterFieldValue := Null;
end;
FMasterLinkList.Add(aMasterLink);
end;
DoRequest;
if Active then First;
except
on E:Exception do
begin
Showmessage('internal error at check detail records!'+#13+'Native Msg:'+E.Message);
end;
end;
finally
if Assigned(lList) then
FreeAndNil(lList);
end;
end;
end;
end;
procedure TUAClientDataSet.Loaded;
begin
inherited;
if (csLoading in ComponentState) then
//do otherting
end;
procedure TUAClientDataSet.InternalRefresh;
begin
// inherited;
end;
procedure TUAClientDataSet.SetUAOptions(const Value: TUAOptions);
begin
FUAOptions := Value;
end;
function TUAClientDataSet.CheckOperateState(const OperateIndex: integer):Boolean;
begin
Result := false;
// -1 代表数据请求申请；
// 1 代表数据更新申请；
try
case OperateIndex of
-1 :begin
if ooRequest in FOperateOptions then
begin
Exclude(FOperateOptions,ooRequest);
end;
if ooRequestNext in FOperateOptions then
begin
Exclude(FOperateOptions,ooRequestNext);
end;
if ooRequestCustom in FOperateOptions then
begin
Exclude(FOperateOptions,ooRequestCustom);
end;
end;
1: begin
if ooUpdateCustom in FOperateOptions then
begin
MergeAllChangeLog;
Exclude(FOperateOptions,ooUpdateCustom);
end;
if ooUpdate in FOperateOptions then
begin
MergeAllChangeLog;
Exclude(FOperateOptions,ooUpdate);
end;
end;
else
MessageDlg('can not support this operation!', mtWarning,[mbOk], 0);
end;
Result := true;
except
on E:Exception do
begin
Showmessage('UAClientDataSet internal error,please try again!');
end;
end;
end;
procedure TUAClientDataSet.MergeAllChangeLog;
var
lList:TList;
i:integer;
sErrorCode:string;
begin
lList := TList.Create;
try
try
case GetDataSetType of
dtDetail,dtSingle:
MergeChangeLog;
dtMaster,dtBoth:
begin
MergeChangeLog;
GetDetailDataSets(lList);
for i := 0 to lList.Count -1 do
begin
if not (TComponent(lList.Items[i]) is TUAClientDataSet) then Continue;
TUAClientDataSet(lList.Items[i]).MergeAllChangeLog;
end;
end;
end;
except
on E:Exception do
begin
sErrorCode := '-30007';
Showmessage('merge data error!'+#13+'error code is:'+sErrorCode
+#13#10+'native error information is:'+E.Message);
end;
end;
finally
lList.Free;
end;
end;
procedure TUAClientDataSet.InternalEdit;
begin
inherited;
end;
procedure TUAClientDataSet.InternalInsert;
begin
inherited;
end;
procedure TUAClientDataSet.InternalOpen;
begin
inherited;
end;
{-----------------------------------------------------------------------------
Procedure: TUAClientDataSet.GetMasterUAServiceClient
Author: vinson zeng
Date: 05-三月-2003
Arguments: None
Result: TUAServiceClient
-----------------------------------------------------------------------------}
function TUAClientDataSet.GetMasterUAServiceClient: TUAServiceClient;
var
aMaster:TUAClientDataSet;
DSMaster:TDataSource;
begin
if Assigned(FMasterUAServiceClient) then
begin
Result := FMasterUAServiceClient;
Exit;
end;
case DataSetType of
dtSingle,dtMaster:
if UAServiceClient <> nil then
begin
FMasterUAServiceClient := UAServiceClient;
Result := FMasterUAServiceClient;
end;
dtBoth,dtDetail:
begin
if MasterSource.DataSet is TUAClientDataSet then
begin
// modify by vinson zeng 2004-01-06
aMaster := TUAClientDataSet(MasterSource.DataSet);
//改进算法 vinson zeng
while (FMasterUAServiceClient = nil) and (Assigned(aMaster)) do
begin
if aMaster.MasterUAServiceClient <> nil then
begin
FMasterUAServiceClient := aMaster.MasterUAServiceClient;
Result := FMasterUAServiceClient;
end;
if (not Assigned(Result)) and (aMaster.MasterSource <> nil ) then
begin
DSMaster := aMaster.MasterSource;
aMaster := TUAClientDataSet(DSMaster.DataSet);
end
else
aMaster := nil;
end;
end;
end;
end;
end;
{-----------------------------------------------------------------------------
Procedure: TUAClientDataSet.CancelSubmitAllDelta
Author: vinson zeng
Date: 05-三月-2003
Arguments: None
Result: None
-----------------------------------------------------------------------------}
procedure TUAClientDataSet.CancelSubmitAllDelta;
var
lList:TList;
i:integer;
sErrorCode:string;
procedure CancelSubmitDetail(aDetail:TUAClientDataSet);
var
j:integer;
lList1:TList;
begin
with aDetail do
begin
CancelUpdates;
lList1 := TList.Create;
GetDetailDataSets(lList1);
try
for j := 0 to lList1.Count -1 do
CancelSubmitDetail(TUAClientDataSet(lList1.Items[j]));
finally
if Assigned(lList1) then
FreeAndNil(lList1);
end;
end;
end;
begin
lList := TList.Create;
try
try
case GetDataSetType of
dtDetail,dtSingle:
CancelUpdates;
dtMaster,dtBoth:
begin
CancelUpdates;
GetDetailDataSets(lList);
for i := 0 to lList.Count -1 do
CancelSubmitDetail(TUAClientDataSet(lList.Items[i]));
end;
end;
except
on E:Exception do
begin
sErrorCode := '-40001';
Showmessage('merge data error!'+#13+'error code is:'+sErrorCode
+#13#10+'native error information is:'+E.Message);
end;
end;
finally
if Assigned(lList) then
FreeAndNil(lList);
end;
end;
{-----------------------------------------------------------------------------
Procedure: TUAClientDataSet.BuildDeltaParam
Author: vinson zeng
Date: 05-三月-2003
Arguments: UAClientDataSet:TUAClientDataSet
Result: Boolean
-----------------------------------------------------------------------------}
function TUAClientDataSet.BuildDeltaParam(UAClientDataSet:TUAClientDataSet):Boolean;
var
aDelta:TDeltaParam;
aDetailDS:TUAClientDataSet;
lList:TList;
i:integer;
function BuildDetailDeltaPacket(UACds:TUAClientDataSet):Boolean;
var
i:integer;
lList1:TList;
aDetailDS1:TUAClientDataSet;
bSubDetail:Boolean;
begin
Result := true;
// bSubDetail := false;
lList1 := TList.Create;
try
try
with UACds do
begin
if ChangeCount <> 0 then //add Detail
begin
aDelta := TDeltaParam.Create;
aDelta.AliasTableName := AliasTableName;
aDelta.KeyFields := KeyFields + GetIndexFields(nil);
aDelta.Delta := Delta;
MasterUAServiceClient.UAUpdateDataInPacket.AddItemDelta(aDelta);
end;
GetDetailDataSets(lList1);
for i := 0 to lList1.Count -1 do
begin
aDetailDS1 := TUAClientDataSet(lList1.Items[i]);
case aDetailDS1.DataSetType of
dtDetail:
begin
if aDetailDS1.ChangeCount <> 0 then
begin
aDelta := TDeltaParam.Create;
aDelta.AliasTableName := aDetailDS1.AliasTableName;
aDelta.KeyFields := aDetailDS1.KeyFields + aDetailDS1.GetIndexFields(nil);;
aDelta.Delta := aDetailDS1.Delta;
MasterUAServiceClient.UAUpdateDataInPacket.AddItemDelta(aDelta);
end;
end;
dtBoth:
begin
bSubDetail := BuildDetailDeltaPacket(aDetailDS1);
Result := Result and bSubDetail;
end;
end;
end;
end;
except
on E:Exception do
begin
Result := false;
end;
end;
finally
if Assigned(lList1) then
FreeAndNil(lList1);
end;
end;
begin
// bug : for Master/Detail/SubDetail rela struc stack overflow :Loop error vinson zeng 2003-12-29
// fix : check GetDetailDataSets method
// modify by vinson zeng for Master/Detail Add Delta Seq
Result := true;
if not Assigned(UAClientDataSet) then
begin
Result := false;
Exit;
end;
if MasterUAServiceClient = nil then
begin
Result := false;
Exit;
end;
try
with MasterUAServiceClient do
begin
// if not FCurrentUpdate then //fix by vinson zeng for delete affect delta
UAUpdateDataInPacket.ClearAllUaData;
case UAClientDataSet.DataSetType of
dtMaster:
begin
lList := TList.Create;
try
if ChangeCount <> 0 then //Master Is First Add
begin
aDelta := TDeltaParam.Create;
aDelta.AliasTableName := AliasTableName;
aDelta.KeyFields := KeyFields + GetIndexFields(nil);
aDelta.Delta := Delta;
UAUpdateDataInPacket.AddItemDelta(aDelta);
end;
GetDetailDataSets(lList);
for i := 0 to lList.Count -1 do
begin
aDetailDS := TUAClientDataSet(lList.Items[i]);
Result := Result and BuildDetailDeltaPacket(aDetailDS); // modify by visnon zeng 2004-01-06
end;
finally
if Assigned(lList) then
FreeAndNil(lList);
end;
end;
dtSingle,dtDetail:
begin
if ChangeCount <> 0 then
begin
aDelta := TDeltaParam.Create;
aDelta.AliasTableName := AliasTableName;
aDelta.KeyFields := KeyFields + GetIndexFields(nil);
aDelta.Delta := Delta;
UAUpdateDataInPacket.AddItemDelta(aDelta);
end;
end;
end;
end;
except
Result := false;
end;
end;
procedure TUAClientDataSet.SetSqlScript(const Value: string);
begin
FSqlScript := Value;
end;
{-----------------------------------------------------------------------------
Procedure: TUAClientDataSet.BuildRequestDataParam
Author: vinson zeng
Date: 05-三月-2003
Arguments: Sender: TObject
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -