function TuaServerObject.SubmitDelta(lAdoConn:TAdoConnection;sTblName:string;cdsSrc:TClientDataSet;
lFieldKeys:array of string;UpdateType:TUAUpdateTypes;
iFailMax:integer;var uaOut:TUAUpdateDataOutPacket):integer;
var
i,j,iOrgCount,iNpOutIndex:integer;
lField:TField;
sSql,s1,sSqlSelect:string;
v1:variant;
adoU:TAdoCommand;
bContinue:Boolean;
cdsDest:TClientDataSet;
adoSelect:TAdoDataSet;
UpdateError:TUAUpdateErrorCode;
aErrorParam:TErrorParam;
sErrorMsg:string;
sErrorContext:string;
aErrorCDS:TClientDataSet;
sNativeErrorMsg:string;
bAtHandle,bBtHandle:Boolean;
begin
sNativeErrorMsg := 'Native Error Information Is :';
bAtHandle := false;
bBtHandle := false;
Result := 0;
adoU := nil;
adoU := TAdoCommand.Create(nil);
cdsDest := nil;
cdsDest := TClientDataSet.Create(nil);
aErrorCDS := TClientDataSet.Create(nil);
try
cdsDest.FieldDefs.Clear;
for i :=0 to cdsSrc.FieldDefs.Count -1do
begin
with cdsDest.FieldDefs.AddFieldDefdo
begin
Name := cdsSrc.FieldDefs.Name;
DataType := cdsSrc.FieldDefs.DataType;
Size := cdsSrc.FieldDefs.Size;
Precision := cdsSrc.FieldDefs.Size;
Attributes := cdsSrc.FieldDefs.Attributes;
Required := cdsSrc.FieldDefs.Required;
end;
end;
cdsDest.CreateDataSet;
adoU.Connection := lAdoConn;
adoU.CommandText :='';
bContinue := true;
cdsSrc.First;
while (not cdsSrc.Eof) and bContinuedo
begin
if trim(sNativeErrorMsg) <> '' then
sNativeErrorMsg := sNativeErrorMsg + #13;
cdsDest.Insert;
for i :=0 to cdsSrc.FieldCount -1do
cdsDest.Fields.Value := cdsSrc.Fields.Value;
case cdsSrc.UpdateStatus of
usUnmodified:
begin
cdsSrc.Next;
sSql := ' Update '+sTblName+' Set ';
s1 := '';
for j := 0 to cdsSrc.FieldCount -1do
begin
v1 := cdsSrc.Fields[j].Value;
if not VarIsNull(v1) then
begin
if s1<>'' then
s1 := s1 +',';
s1 := s1 + cdsSrc.Fields[j].FieldName+ ' = ';
s1 := s1 + FieldValueToSqlStr(cdsSrc.Fields[j].DataType,v1);
end;
end;
sSql := sSql +' '+s1 + ' Where ';
for j := 0 to cdsDest.FieldCount -1do
begin
v1 := cdsDest.Fields[j].Value;
if j>0 then
sSql := sSql +' and ';
if not VarIsNull(v1) then
begin
sSql := sSql + cdsDest.Fields[j].FieldName+ ' = ';
sSql := sSql + FieldValueToSqlStr(cdsDest.Fields[j].DataType,v1);
sSql := sSql +' ';
end else
begin
sSql := sSql + cdsDest.Fields[j].FieldName + ' Is Null ';
end;
end;
sSqlSelect := GenSelectDS(sTblName,cdsDest,lFieldKeys);
UpdateError := ueOk;
adoSelect := TAdoDataSet.Create(nil);
try
adoSelect.Connection := lAdoConn;
adoSelect.CommandText := sSqlSelect;
adoSelect.Open;
except
on E:Exceptiondo
begin
sNativeErrorMsg := sNativeErrorMsg +E.Message;
Inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpdateError := ueSelectSql;
end;
end;
iOrgCount := adoSelect.RecordCount;
if UpdateError = ueOk then
begin
if iOrgCount =0 then
begin
UpDateError := ueModChanged;
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
end
else
if iOrgCount=1 then
begin
try
adoU.CommandText := sSql;
BeforeTriggerForDataSet(sTblName,adoSelect,cdsDest,bBtHandle);
adoU.Execute;
AfterTriggerForDataSet(sTblName,adoSelect,cdsDest,bAtHandle);
UpDateError := ueOk;
except
on E:Exceptiondo
begin
sNativeErrorMsg := sNativeErrorMsg +E.Message;
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpDateError := ueModOneSql;
end;
end;
end
else
begin
if upModifyOne in UpdateType then
begin
Inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpDateError := ueModOneButMany;
end
else
begin
try
adoU.CommandText := sSql;
BeforeTriggerForDataSet(sTblName,adoSelect,cdsDest,bBtHandle);
///???
adoU.Execute;
AfterTriggerForDataSet(sTblName,adoSelect,cdsDest,bAtHandle);
UpDateError :=ueOk;
except
on E:Exceptiondo
begin
sNativeErrorMsg := sNativeErrorMsg +E.Message;
Inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpdateError := ueModManySql;
end;
end;
end;
end;
end;
if UpdateError <>ueOk then
begin
//修改数据不成功,返回调用异常
//异常消息+数据包
aErrorParam := TErrorParam.Create;
aErrorParam.ErrorCode := $FA01;
{$ifdef CHNDEBUG}
sErrorMsg := '修改数据库记录发生错误!';
{$else
}
sErrorMsg := 'error on modify record!';
{$endif}
aErrorParam.ErrorMsg := sErrorMsg + #13#10 + sNativeErrorMsg;
aErrorParam.ErrorContext := TUAUpdateErrorMsg[Ord((updateError))] +#13#10+ 'Sql Script Is:' + sSql ;
uaOut.AddItemErrorParam(aErrorParam);
cdsDest.Append;
for j :=0 to cdsDest.Fields.Count -1do
cdsDest.Fields[j].Value := adoSelect.fieldByName(cdsDest.Fields[j].FieldName).value;
cdsDest.Append;
for j := 0 to cdsDest.Fields.Count -1do
cdsDest.Fields[j].Value := cdsSrc.Fields[j].Value;
aErrorCDS.AppendData(cdsDest.Data,false);
end;
FreeAndNil(adoSelect);
cdsDest.first;
for j := 1 to cdsDest.RecordCountdo
cdsDest.Delete;
end;
usInserted:
begin
sSql := 'insert into '+ sTblName+'(';
s1 :='';
for j := 0 to cdsSrc.Fields.Count -1do
begin
v1 := cdsSrc.Fields[j].Value;
if not VarIsNull(v1) then
begin
if s1<>'' then
begin
sSql := sSql+',';
s1 := s1 +',';
end;
sSql := sSql +cdsSrc.Fields[j].FieldName;
s1 := s1 + FieldValueToSqlStr(cdsSrc.Fields[j].DataType,v1);
end;
end;
if s1<>'' then
begin
sSql := sSql +')';
s1 := s1 +')';
sSql := sSql+ ' values (' +s1;
sSqlSelect := GenSelectDS(sTblName,cdsDest,lFieldKeys);
UpdateError := ueOk;
adoSelect := TAdoDataSet.Create(nil);
try
adoSelect.Connection := lAdoConn;
adoSelect.CommandText := sSqlSelect;
adoSelect.Open;
except
on E:Exceptiondo
begin
sNativeErrorMsg := sNativeErrorMsg +E.Message;
Inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpdateError := ueSelectSql;
end;
end;
iOrgCount := adoSelect.RecordCount;
if UpdateError = ueOk then
begin
if iOrgCount =0 then
begin
try
adoU.CommandText := sSql;
BeforeTriggerForDataSet(sTblName,adoSelect,cdsDest,bBtHandle);
adoU.Execute;
AfterTriggerForDataSet(sTblName,adoSelect,cdsDest,bAtHandle);
except
on E:Exceptiondo
begin
sNativeErrorMsg := sNativeErrorMsg +E.Message;
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpDateError := ueInsSql;
end;
end;
end
else
if iOrgCount>=1 then
begin
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpDateError := ueInsExit;
end;
end;
if UpdateError <>ueOk then
begin
//新增数据不成功,返回调用异常
//异常消息+数据包
aErrorParam := TErrorParam.Create;
aErrorParam.ErrorCode := $FA02;
{$ifdef CHNDEBUG}
sErrorMsg := '新增数据库记录发生错误!';
{$else
}
sErrorMsg := 'error on insert record to table!';
{$endif}
aErrorParam.ErrorMsg := sErrorMsg + #13#10 + sNativeErrorMsg;
aErrorParam.ErrorContext := TUAUpdateErrorMsg[Ord((updateError))] +#13#10+ 'Sql Script Is:' + sSql;
uaOut.AddItemErrorParam(aErrorParam);
cdsDest.Append;
for j :=0 to cdsDest.Fields.Count -1do
cdsDest.Fields[j].Value := adoSelect.fieldByName(cdsDest.Fields[j].FieldName).value;
cdsDest.Append;
for j := 0 to cdsDest.Fields.Count -1do
cdsDest.Fields[j].Value := cdsSrc.Fields[j].Value;
aErrorCDS.AppendData(cdsDest.Data,false);
end;
FreeAndNil(adoSelect);
cdsDest.first;
for j := 1 to cdsDest.RecordCountdo
cdsDest.Delete;
end;
end;
usDeleted:
begin
sSql := 'delete '+ sTblName+' where ';
for j :=0 to cdsSrc.Fields.Count -1do
begin
v1 := cdsSrc.Fields[j].Value;
if j >0 then
sSql := sSql +' and ';
if not VarIsNull(v1) then
begin
sSql := sSql +cdsSrc.Fields[j].FieldName +' = ';
sSql := sSql +FieldValueToSqlStr(cdsSrc.Fields[j].datatype,v1);
end
else
begin
sSql := sSql +cdsSrc.Fields[j].FieldName + ' Is Null ';
end;
end;
UpdateError := ueOk;
sSqlSelect := GenSelectDS(sTblName,cdsDest,lFieldKeys);
adoSelect := TAdoDataSet.Create(nil);
try
adoSelect.Connection := lAdoConn;
adoSelect.CommandText := sSqlSelect;
adoSelect.Open;
except
on E:Exceptiondo
begin
sNativeErrorMsg := sNativeErrorMsg +E.Message;
Inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpdateError := ueSelectSql;
end;
end;
iOrgCount := adoSelect.RecordCount;
if UpdateError = ueOk then
begin
if iOrgCount =0 then
begin
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpDateError := ueDelNonExit;
end
else
if iOrgCount=1 then
begin
try
adoU.CommandText := sSql;
BeforeTriggerForDataSet(sTblName,adoSelect,cdsDest,bBtHandle);
adoU.Execute;
AfterTriggerForDataSet(sTblName,adoSelect,cdsDest,bAtHandle);
UpDateError := ueOK;
except
on E:Exceptiondo
begin
sNativeErrorMsg := sNativeErrorMsg +E.Message;
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpDateError := ueDelOneSql;
end;
end;
end
else
begin
if upDeleteOne in UpdateType then
begin
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpDateError := ueDelOneButMany;
end
else
begin
try
adoU.CommandText := sSql;
BeforeTriggerForDataSet(sTblName,adoSelect,cdsDest,bBtHandle);
adoU.Execute;
AfterTriggerForDataSet(sTblName,adoSelect,cdsDest,bAtHandle);
UpDateError := ueOK;
except
on E:Exceptiondo
begin
sNativeErrorMsg := sNativeErrorMsg +E.Message;
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpDateError := ueDelManySql;
end;
end;
end;
end;
end;
if UpdateError <>ueOk then
begin
//删除数据不成功,返回调用异常
//异常消息+数据包
aErrorParam := TErrorParam.Create;
aErrorParam.ErrorCode := $FA03;
{$ifdef CHNDEBUG}
sErrorMsg := '删除数据库记录发生错误!';
{$else
}
sErrorMsg := 'error on delete record from table!';
{$endif}
aErrorParam.ErrorMsg := sErrorMsg + #13#10 + sNativeErrorMsg;
aErrorParam.ErrorContext := TUAUpdateErrorMsg[Ord((updateError))] +#13#10+ 'Sql Script Is:' + sSql;
uaOut.AddItemErrorParam(aErrorParam);
cdsDest.Append;
for j :=0 to cdsDest.Fields.Count -1do
cdsDest.Fields[j].Value := adoSelect.fieldByName(cdsDest.Fields[j].FieldName).value;
cdsDest.Append;
for j := 0 to cdsDest.Fields.Count -1do
cdsDest.Fields[j].Value := cdsSrc.Fields[j].Value;
aErrorCDS.AppendData(cdsDest.Data,false);
end;
FreeAndNil(adoSelect);
cdsDest.first;
for j := 1 to cdsDest.RecordCountdo
cdsDest.Delete;
end;
end;
cdsSrc.Next;
end;
finally
if Assigned(adoU) then
FreeAndNil(adoU);
if Assigned(cdsDest) then
FreeAndNil(cdsDest);
if Assigned(aErrorCDS) then
FreeAndNil(aErrorCDS);
end;
end;