📄 uasrvobj.~pas
字号:
UpdateError := ueOk;
adoSelect := TAdoDataSet.Create(nil);
try
UADebugEx(ddUpdate,Now(),Self,sSqlSelect);
adoSelect.Connection := lAdoConn;
adoSelect.CommandText := sSqlSelect;
adoSelect.Open;
except
on E:Exception do
begin
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
UADebugEx(ddUpdate,Now(),Self,sSql);
adoU.CommandText := sSql;
BeforeTriggerForDataSet(sTblName,cdsSrc,cdsDest,bBtHandle);
adoU.Execute;
AfterTriggerForDataSet(sTblName,cdsSrc,cdsDest,bAtHandle);
except
on E:Exception do
begin
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
//新增数据不成功，返回调用异常
//异常消息+数据包
MakeUAExceptionMsg(UA_E_EXEC_INSERT_SQL,nil,TUAUpdateErrorMsg[Ord((updateError))] +#13#10+ 'Sql Script Is:' + sSql );
cdsDest.Append;
for j :=0 to cdsDest.Fields.Count -1 do
cdsDest.Fields[j].Value := adoSelect.fieldByName(cdsDest.Fields[j].FieldName).value;
cdsDest.Append;
for j := 0 to cdsDest.Fields.Count -1 do
cdsDest.Fields[j].Value := cdsSrc.Fields[j].Value;
aErrorCDS.AppendData(cdsDest.Data,false);
end;
FreeAndNil(adoSelect);
cdsDest.first;
for j := 1 to cdsDest.RecordCount do
cdsDest.Delete;
end;
end;
usDeleted:
begin
sSql := 'delete '+ sTblName+' where ';
for j :=0 to cdsSrc.Fields.Count -1 do
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
UADebugEx(ddUpdate,Now(),Self,sSqlSelect);
adoSelect.Connection := lAdoConn;
adoSelect.CommandText := sSqlSelect;
adoSelect.Open;
except
on E:Exception do
begin
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
UADebugEx(ddUpdate,Now(),Self,sSql);
adoU.CommandText := sSql;
BeforeTriggerForDataSet(sTblName,cdsSrc,cdsDest,bBtHandle);
adoU.Execute;
AfterTriggerForDataSet(sTblName,cdsSrc,cdsDest,bAtHandle);
UpDateError := ueOK;
except
on E:Exception do
begin
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
UADebugEx(ddUpdate,Now(),Self,sSql);
adoU.CommandText := sSql;
BeforeTriggerForDataSet(sTblName,adoSelect,cdsDest,bBtHandle);
adoU.Execute;
AfterTriggerForDataSet(sTblName,adoSelect,cdsDest,bAtHandle);
UpDateError := ueOK;
except
on E:Exception do
begin
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then bContinue := false;
UpDateError := ueDelManySql;
end;
end;
end;
end;
end;
if UpdateError <>ueOk then
begin
//删除数据不成功，返回调用异常
//异常消息+数据包
MakeUAExceptionMsg(UA_E_EXEC_DELETE_SQL,nil,TUAUpdateErrorMsg[Ord((updateError))] +#13#10+ 'Sql Script Is:' + sSql );
cdsDest.Append;
for j :=0 to cdsDest.Fields.Count -1 do
cdsDest.Fields[j].Value := adoSelect.fieldByName(cdsDest.Fields[j].FieldName).value;
cdsDest.Append;
for j := 0 to cdsDest.Fields.Count -1 do
cdsDest.Fields[j].Value := cdsSrc.Fields[j].Value;
aErrorCDS.AppendData(cdsDest.Data,false);
end;
FreeAndNil(adoSelect);
cdsDest.first;
for j := 1 to cdsDest.RecordCount do
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;
procedure TuaServerObject.AfterTriggerForDataSet(TableName: string;SrcDS:TDataSet;DestDS:TDataSet;var bHandle:Boolean);
begin
//Case SrcDS .UpdateStatus To Do
//usUnmodified : SrcDS 的行数据是修改过后的，DestDS 的行数据是原始状态的
// usInsert :只有SrcDS 的行数据是最新的
// usDelete :只有SrcDS 的行数据是最新的
end;
procedure TuaServerObject.BeforeTriggerForDataSet(TableName: string;SrcDS:TDataSet;DestDS:TDataSet;var bHandle:Boolean);
begin
end;
procedure TuaServerObject.SetAliasSrvObjName(const Value: string);
begin
FAliasSrvObjName := Value;
end;
function TuaServerObject.ExecuteStoredProc(ProcName: string;VarValue: Variant;
var VarReturn:Variant;const bStartTrans: Boolean = false
;const bReturnRecordSet:Boolean = false):integer;
var
//-------catch all exception -----
iMaxError:integer;
//-------%% end of %% ------------
adoComm :TAdoCommand;
bLockDb:Boolean;
lParams:TParams;
//----------------Return RecordSet-----
adoRecordSet:TAdoDataSet;
dspRecordSet:TDataSetProvider;
cdsRecordSet:TClientDataSet;
//-------------------------------------
begin
iMaxError := 0;
VarReturn := Null;
if trim(ProcName) = '' then
begin
Result := -9;
Exit;
end;
bLockDb := (DbConnection = nil); //???
if bLockDb then
ExLockDbConnection;
if bStartTrans then
StartSyncTrans;
if bReturnRecordSet then
begin
adoRecordSet := TAdoDataSet.Create(Self);
adoRecordSet.Name := UniqueName(adoRecordSet,'ado_Record_Set_Tmp',Self);
dspRecordSet := TDataSetProvider.Create(Self);
dspRecordSet.Name := UniqueName(dspRecordSet,'dsp_Record_Set_Tmp',Self);
cdsRecordSet := TClientDataSet.Create(Self);
cdsRecordSet.Name := UniqueName(cdsRecordSet,'cds_Record_Set_Tmp',Self);
end;
adoComm := TAdoCommand.Create(Self);
adoComm.Name := UniqueName(adoComm,'ado_Stored_Proc_Tmp',Self);
adoComm.Connection := DbConnection;
adoComm.CommandType := cmdStoredProc;
adoComm.CommandText := ProcName;
lParams := TParams.Create;
try
try
if adoComm.Parameters.Refresh then
VariantToStoredProcParams(VarValue,lParams);
ParamsAssignedToParameters(lParams,adoComm.Parameters);
if adoComm.Parameters.Count <> 0 then
begin
adoComm.Prepared := true;
if not bReturnRecordSet then
begin
adoComm.Execute;
ParametersAssignedToParams(adoComm.Parameters,lParams);
VarReturn := StoredProcParamsToVariant(lParams);
end
else
begin
// must be returned all effect recordset
adoRecordSet.Recordset := adoComm.Execute;
//OpenSrvData(adoRecordSet,dspRecordSet,cdsRecordSet);
// if not adoRecordSet.Active then
// adoRecordSet.Open;
{ dspRecordSet.DataSet := adoRecordSet;
cdsRecordSet.ProviderName := dspRecordSet.Name;
cdsRecordSet.Open;
dspRecordSet.Options := dspRecordSet.Options + [poIncFieldProps];
}
VarReturn := cdsRecordSet.Data;
end;
end
else
begin
Result := -1;
end;
except
on E:Exception do
begin
iMaxError := MakeUAExceptionMsg(UA_E_EXEC_STPREDPROC,E,ProcName + #13+GetMsSqlLastError );
case OperationTypes of
otRequest:
begin
end;
otUpdate:
begin
end;
otExecute:
FUAExecuteDataOutPacket.ResultCode := iMaxError;
end;
if bStartTrans and InSyncTrans then
RollbackSyncTrans;
end;
end;
finally
if bStartTrans and InSyncTrans then
CommitSyncTrans;
if Assigned(adoComm) then
begin
adoComm.Connection := nil;
FreeAndNil(adoComm);
end;
if bLockDb then
begin
ExUnlockDbConnection;
end;
if bReturnRecordSet then
ReleaseAllDS(adoRecordSet,dspRecordSet,cdsRecordSet);
if Assigned(lParams) then
FreeAndNil(lParams);
Result := iMaxError;
end;
end;
function TuaServerObject.MakeUAExceptionMsg(UAExcepions: TUAExcepions;EMsg: Exception;const ExtMsg:string = ''): integer;
var
aErrorParam :TErrorParam;
begin
Result := 0;
case OperationTypes of
otRequest:
begin
aErrorParam := TErrorParam.Create;
aErrorParam.ErrorMask := $0F;
aErrorParam.ErrorCode := TUAExceptionCode[Ord(UAExcepions)];
aErrorParam.ErrorContext := TUAExceptionMsg[Ord(UAExcepions)] + #13#10 + ExtMsg;
if EMsg <> nil then
aErrorParam.ErrorMsg := '[Native Error Information:' + EMsg.Message +']';
FUARequestDataOutPacket.AddItemErrorParam(aErrorParam);
Result := TUAExceptionCode[Ord(UAExcepions)];
FUARequestDataOutPacket.ResultCode := Result ;
UADebugEx(ddCatchException,Now(),Self,
'Error Code:'+IntToStr(aErrorParam.ErrorCode)+#13#10+
'Error Context:'+ aErrorParam.ErrorContext +#13#10+
'Error Message:'+ aErrorParam.ErrorMsg+#13#10);
end;
otUpdate:
begin
aErrorParam := TErrorParam.Create;
aErrorParam.ErrorCode := TUAExceptionCode[Ord(UAExcepions)];
aErrorParam.ErrorMask := $1F;
aErrorParam.ErrorContext := TUAExceptionMsg[Ord(UAExcepions)] + #13#10 + ExtMsg;
if EMsg <> nil then
aErrorParam.ErrorMsg := '[Native Error Information:' + EMsg.Message +']';
FUAUpdateDataOutPacket.AddItemErrorParam(aErrorParam);
Result := TUAExceptionCode[Ord(UAExcepions)];
FUAUpdateDataOutPacket.ResultCode := Result ;
UADebugEx(ddCatchException,Now(),Self,
'Error Code:'+IntToStr(aErrorParam.ErrorCode)+#13#10+
'Error Context:'+ aErrorParam.ErrorContext +#13#10+
'Error Message:'+ aErrorParam.ErrorMsg+#13#10);
end;
otExecute:
begin
aErrorParam := TErrorParam.Create;
aErrorParam.ErrorMask := $2F;
aErrorParam.ErrorCode := TUAExceptionCode[Ord(UAExcepions)];
aErrorParam.ErrorContext := TUAExceptionMsg[Ord(UAExcepions)] + #13#10 + ExtMsg;
if EMsg <> nil then
aErrorParam.ErrorMsg := '[Native Error Information:' + EMsg.Message +']';
FUAExecuteDataOutPacket.AddItemErrorParam(aErrorParam);
Result := TUAExceptionCode[Ord(UAExcepions)];
FUAExecuteDataOutPacket.ResultCode := Result ;
UADebugEx(ddCatchException,Now(),Self,
'Error Code:'+IntToStr(aErrorParam.ErrorCode)+#13#10+
'Error Context:'+ aErrorParam.ErrorContext +#13#10+
'Error Message:'+ aErrorParam.ErrorMsg+#13#10);
end;
end;
end;
fu⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -