Universal Agent on demond SDK --uaSrvObj(0分)

  • 主题发起人 主题发起人 vinson_zeng
  • 开始时间 开始时间
V

vinson_zeng

Unregistered / Unconfirmed
GUEST, unregistred user!

{******************************************************************************************}
{ }
{ Universal Agent on demond SDK }
{ }
{ }
{ COPYRIGHT }
{ ========= }
{ The UA SDK (software) is Copyright (C) 2001-2003, by vinson zeng(曾胡龙). }
{ All rights reserved. }
{ The authors - vinson zeng (曾胡龙), }
{ exclusively own all copyrights to the Advanced Application }
{ Controls (AppControls) and all other products distributed by Utilmind Solutions(R). }
{ }
{ LIABILITY DISCLAIMER }
{ ==================== }
{ THIS SOFTWARE IS DISTRIBUTED "AS IS" AND WITHOUT WARRANTIES AS TO PERFORMANCE }
{ OF MERCHANTABILITY OR ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ YOU USE IT AT YOUR OWN RISK. THE AUTHOR WILL NOT BE LIABLE FOR DATA LOSS, }
{ DAMAGES, LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING OR MISUSING THIS SOFTWARE.}
{ }
{ RESTRICTIONS }
{ ============ }
{ You may not attempt to reverse compile, modify, }
{ translate or disassemble the software in whole or in part. }
{ You may not remove or modify any copyright notice or the method by which }
{ it may be invoked. }
{******************************************************************************************}
{-----------------------------------------------------------------------------
Unit Name: uaSrvObj
Author: vinson zeng
Purpose:
History:
-----------------------------------------------------------------------------}

/// Bug report...
// EnableBCD 错误
/// Modify History...
/// add UA Exception Degine 2003-12-4 9:30
/// can not support blob data field process 2003-12-4 9:31

unit uaSrvObj;
interface
uses
Windows, Messages, SysUtils, Classes, DataBkr,DBClient,
StdVcl,AdoDb,Contnrs,Variants,Provider,Forms,Db,SyncObjs,
uaSrvObjDbConn,UADataPacket,UAServiceObjectPool,UAUnits;
type
TuaServerObject = class(TComponent)
private
FPrepare:Boolean;
FOperationTypes:TOperationType;
FCurrServiceName:string;
FAliasSrvObjName: string;
FDBName:string;
// add by vinson zeng 2004-3-16
procedure SetPrepare(const Value: Boolean);
procedure SetOperationType(const Value: TOperationType);
procedure SetCurrServiceName(const Value: string);
function GetCurrServiceName: string;
procedure SetAliasSrvObjName(const Value: string);
procedure SetDBName(const Value: string);
protected
FUARequestDataInPacket:TUARequestDataInPacket;
FUARequestDataOutPacket:TUARequestDataOutPacket;
FUAUpdateDataInPacket:TUAUpdateDataInPacket;
FUAUpdateDataOutPacket:TUAUpdateDataOutPacket;
FUAExecuteDataInPacket:TUAExecuteDataInPacket;
FUAExecuteDataOutPacket:TUAExecuteDataOutPacket;

function SubmitDelta(lAdoConn:TAdoConnection;sTblName:string;cdsSrc:TClientDataSet;
lFieldKeys:array of string;UpdateType:TUAUpdateTypes;
iFailMax:integer;var uaOut:TUAUpdateDataOutPacket):integer;virtual;

//---------分析不好--------------------
procedure AfterTriggerForDataSet(TableName:string;SrcDS:TDataSet;DestDS:TDataSet;var bHandle:Boolean);virtual;
procedure BeforeTriggerForDataSet(TableName:string;SrcDS:TDataSet;DestDS:TDataSet;var bHandle:Boolean);virtual;
//---------%% end of %% --------------
procedure BeforeRequest(Sender:TObject;var bHandle:Boolean);virtual;
procedure AfterRequest(Sender:TObject;var bContinue:Boolean);virtual;
procedure BeforeUpdate(Sender:TObject;var bHandle:Boolean);virtual;
procedure AfterUpdate(Sender:TObject;var bContinue:Boolean);virtual;
procedure BeforeExecute(Sender:TObject;var bHandle:Boolean);virtual;
procedure AfterExecute(Sender:TObject;var bContinue:Boolean);virtual;
procedure StartSyncTrans;
procedure CommitSyncTrans;
procedure RollbackSyncTrans;
function InSyncTrans:Boolean;
procedure ExLockDbConnection;
// add by vinson zeng 2004-3-16
procedure ExUnlockDbConnection;
// add by vinson zeng 2004-3-16
function SubmitAllDelta(bStartTrans:Boolean;AllDelta:OleVariant):integer;
function BuildDeltaArray(aUAUpdateDataInPacket:TUAUpdateDataInPacket):Variant;
function GetAllRecCount(var TableName:string;const sWhere:string= ''):integer;
function RequestData(Sender:TObject;var vOutData:OleVariant):integer;
function GetTableStru(vDataIn:OleVariant;var vOutData:OleVariant):integer;
//fix by vinson zeng at 2003-10-03
function BuildMasterLinkSqlScript(aUARequestInPacket:TUARequestDataInPacket):string;
function BuildRowSheetSqlScript(aUARequestInPacket:TUARequestDataInPacket):string;
function ReleaseAllDS(adoDS:TAdoDataSet;Dsp:TDataSetProvider;Cds:TClientDataSet):integer;
function RefreshData(Sender:TObject;var vOutData:OleVariant):integer;
function QueryData(Sender:TObject;var vOutData:OleVariant):integer;
function OpenSrvData(adoDS:TAdoDataSet;Dsp:TDataSetProvider;Cds:TClientDataSet):integer;
function ExecAnySql(OperationType:TOperationType;sSql:string):integer;
function QueryViewData(sSqlScript:string;var vOutData:OleVariant):integer;
function ExecuteStoredProc(ProcName: string;VarValue: Variant;var VarReturn:Variant
;const bStartTrans: Boolean = false;const bReturnRecordSet:Boolean = false):integer;
virtual;
//add on 2003-10-16
function GetUAErrorCount(OperationType:TOperationType):integer;
function RequestCustomData(ServiceName:WideString;vcInData:OleVariant;var vcOutData:OleVariant):integer;virtual;abstract;
function UpdateCustomDelta(ServiceName:WideString;vcInData:OleVariant;var vcOutData:OleVariant):integer;virtual;abstract;
procedure InitForRequest(var DataIn:OleVariant;var DataOut:OleVariant);virtual;
procedure InitForUpdate (var DataIn:OleVariant;var DataOut:OleVariant);virtual;
procedure InitForExecute(var DataIn:OleVariant;var DataOut:OleVariant);virtual;

public
FSyncTransaction:Boolean;
DbConnection:TAdoConnection;

constructor Create;
virtual;
destructor Destroy;
override;
function MakeUAExceptionMsg(UAExcepions: TUAExcepions;EMsg:Exception;const ExtMsg:string =''):integer;
procedure Request(ServiceName: WideString;
DataIn: OleVariant;var DataOut: OleVariant);
virtual;
procedure Update (ServiceName: WideString;
DataIn: OleVariant;var DataOut: OleVariant);
virtual;
procedure Execute(ServiceName: WideString;
DataIn: OleVariant;var DataOut: OleVariant);
virtual;
property Prepare:Boolean read FPrepare write SetPrepare default false;
property OperationTypes:TOperationType read FOperationTypes write SetOperationType;
property CurrServiceName:string read GetCurrServiceName write SetCurrServiceName;
property AliasSrvObjName:string read FAliasSrvObjName write SetAliasSrvObjName;
property DBName:string read FDBName write SetDBName;
end;

function xStrSplit(str:string;
chars:CharSet;
tsStrs:TStrings;AutoClear: Boolean;
bTrim:Boolean):integer;

implementation
uses UASystem;


function xStrSplit(str:string;
chars:CharSet;
tsStrs:TStrings;AutoClear: Boolean;
bTrim:Boolean):integer;
var
n, i, k : integer;
s : string;
begin
Result := 0;
if chars=[] then
chars := [',',';'];
if tsStrs=nil then
Exit;
if AutoClear then
tsStrs.Clear;
k := Length(str);
if (k=0) then
Exit;
i := 1;
for n:=1 to kdo
if str[n] in chars then
begin
s := Copy(Str, i, n-i);
if bTrim then
s:=Trim(s);
tsStrs.Add(s);
i := n+1;
Inc(Result);
end;
if i<=k then
begin
s := Copy(Str, i, n-i);
if bTrim then
s:=Trim(s);
tsStrs.Add(s);
Inc(Result);
end;
end;



{ TuaServerObject }
procedure TuaServerObject.AfterExecute(Sender: TObject;var bContinue:Boolean);
begin

end;

procedure TuaServerObject.AfterRequest(Sender: TObject;var bContinue:Boolean);
begin

end;

procedure TuaServerObject.AfterUpdate(Sender: TObject;var bContinue:Boolean);
begin

end;

procedure TuaServerObject.BeforeExecute(Sender: TObject;
var bHandle: Boolean);
begin

end;

procedure TuaServerObject.BeforeRequest(Sender: TObject;
var bHandle: Boolean);
begin

end;

procedure TuaServerObject.BeforeUpdate(Sender: TObject;
var bHandle: Boolean);
begin

end;

function TuaServerObject.BuildDeltaArray(aUAUpdateDataInPacket: TUAUpdateDataInPacket): Variant;
var
i,iCount:integer;
aDeltaParam:TDeltaParam;
begin

if aUAUpdateDataInPacket = nil then
Exit;
iCount := aUAUpdateDataInPacket.CountItemDelta;
Result := VarArrayCreate([0,iCount-1], varVariant);
VarArrayLock(Result);
try
for i := 0 to iCount -1do
begin
aDeltaParam := aUAUpdateDataInPacket.GetItemDelta(i);
Result := aDeltaParam.UAData;
end;
finally
VarArrayUnlock(Result);
end;

end;

function TuaServerObject.BuildMasterLinkSqlScript(aUARequestInPacket: TUARequestDataInPacket): string;
var
i:integer;
aMasterLinkParam:TMasterLinkParam;
begin

Result := '';
if not Assigned(aUARequestInPacket) then
Exit;
for i := 0 to aUARequestInPacket.CountMasterLink -1do
begin
try
aMasterLinkParam := aUARequestInPacket.GetItemMasterLink(i);
if Trim(Result) <> '' then
Result := Result +' and ';
Result := Result + ' ('+ aMasterLinkParam.MasterField+'='+ FieldValueToSqlStr(aMasterLinkParam.DataType,aMasterLinkParam.MasterFieldValue)+' )';
finally
end;
end;

if Trim(Result) <> '' then
begin
Result := ' ('+ Result +' )';
end;

end;

function TuaServerObject.BuildRowSheetSqlScript(aUARequestInPacket: TUARequestDataInPacket): string;
var
i:integer;
aRowSheetParam:TRowSheetParam;
begin
Result := '';
if not Assigned(aUARequestInPacket) then
Exit;
for i := 0 to aUARequestInPacket.CountRowSheet -1do
begin
try
aRowSheetParam := aUARequestInPacket.GetItemRowSheet(i);
if Trim(Result) <> '' then
Result := Result +' and ';
Result := Result + ' ('+ aRowSheetParam.FieldName + '<>' + FieldValueToSqlStr(aRowSheetParam.FieldType,aRowSheetParam.CurrValue)+' )';
finally
end;
end;

if Trim(Result) <> '' then
begin
Result := ' ('+ Result +' )';
end;

end;

procedure TuaServerObject.CommitSyncTrans;
begin
if InSyncTrans and (not FSyncTransaction) then
begin
DbConnection.CommitTrans;
UADebugEx(ddCommitTrans,Now(),DbConnection,'Commit Transaction');
end;
end;

constructor TuaServerObject.Create;
begin

FSyncTransaction := false;
FUARequestDataInPacket := TUARequestDataInPacket.Create;
FUARequestDataOutPacket:= TUARequestDataOutPacket.Create;
FUAUpdateDataInPacket := TUAUpdateDataInPacket.Create;
FUAUpdateDataOutPacket:= TUAUpdateDataOutPacket.Create;
FUAExecuteDataInPacket:= TUAExecuteDataInPacket.Create;
FUAExecuteDataOutPacket:= TUAExecuteDataOutPacket.Create;

end;

destructor TuaServerObject.Destroy;
begin

FUAUpdateDataInPacket.Free;
FUAUpdateDataOutPacket.Free;
FUAExecuteDataInPacket.Free;
FUAExecuteDataOutPacket.Free;
Inherited;
end;

function TuaServerObject.ExecAnySql(OperationType:TOperationType;sSql: string):integer;
var
adoQry:TAdoQuery;
begin

Result := -1;
if trim(sSql) = '' then
Exit;
if DbConnection = nil then
Exit;
adoQry := TAdoQuery.Create(Self);
adoQry.Name := UniqueName(adoQry,'ado_Qry_Tmp',Self);
try
try
adoQry.Connection := DbConnection;
adoQry.Close;
adoQry.SQL.Clear;
adoQry.SQL.Add(sSql);
Result := adoQry.ExecSQL;
except
on E:Exceptiondo
begin
Result := MakeUAExceptionMsg(UA_E_EXEC_SQL_STATEMENTS,E);
end;
end;
finally
if Assigned(adoQry) then
FreeAndNil(adoQry);
end;

end;

procedure TuaServerObject.Execute(ServiceName: WideString;
DataIn: OleVariant;
var DataOut: OleVariant);
begin

InitForExecute(DataIn,DataOut);
CurrServiceName := Trim(ServiceName);
OperationTypes := otExecute;
end;

function TuaServerObject.GetAllRecCount(var TableName:string;const sWhere:string= ''): integer;
var
adoDS:TAdoDataSet;
sSql:string;
begin

Result := 0;
if not Assigned(DbConnection) then
Exit;
if trim(TableName) <> '' then
begin
adoDS := TAdoDataSet.Create(Self);
adoDS.Connection := DbConnection;
adoDS.Name := UniqueName(adoDS,'GetRecCount_adoDS',Self);
try
try
sSql := Format('select count(*) from %s ',[TableName]);
if Trim(sWhere) <> '' then
sSql := sSql + ' where ' +sWhere;
adoDS.CommandText := sSql;
adoDS.Open;
Result := adoDS.Fields[0].AsInteger;
except //do not catch error
on E:Exceptiondo
begin
MakeUAExceptionMsg(UA_E_PHY_RECCOUNT,E);
end;
end;
finally
if Assigned(adoDS) then
FreeAndNil(adoDS);
end;
end;

end;

procedure TuaServerObject.InitForExecute(var DataIn, DataOut: OleVariant);
begin

FUAExecuteDataInPacket.ClearAllUaData;
FUAExecuteDataOutPacket.ClearAllUaData;
FUAExecuteDataInPacket.UAData := DataIn;
FDBName := FUAExecuteDataInPacket.DBConnTag // add by vinson zeng 2004-3-16;

end;

procedure TuaServerObject.InitForRequest(var DataIn, DataOut: OleVariant);
begin

FUARequestDataInPacket.ClearAllUaData;
FUARequestDataOutPacket.ClearAllUaData;
FUARequestDataInPacket.UAData := DataIn;
FDBName := FUARequestDataInPacket.DBConnTag;
// add by vinson zeng 2004-3-16
end;

procedure TuaServerObject.InitForUpdate(var DataIn, DataOut: OleVariant);
begin

FUAUpdateDataInPacket.ClearAllUaData;
FUAUpdateDataOutPacket.ClearAllUaData;
FUAUpdateDataInPacket.UAData := DataIn;
FDBName := FUAUpdateDataInPacket.DBConnTag;
// add by vinson zeng 2004-3-16

end;

function TuaServerObject.InSyncTrans: Boolean;
begin
Result := DbConnection.InTransaction;
end;

function TuaServerObject.QueryData(Sender: TObject;var vOutData: OleVariant): integer;
var
sSql,sTableName,sKeys,sParams,
sMasterLink,sRowSheet:string;
j,iAllCount,iCurrCount,iRequestCount,iOpenCount:integer;
aDataRequestParam:TDataRequestParam;
aDataReturnParam:TDataReturnParam;
aRowSheetParam:TRowSheetParam;
sKeyList:TStringList;
//------%% begin
declare %%--------
adoQuery:TAdoDataSet;
dspQuery:TDataSetProvider;
cdsQuery:TClientDataSet;
//----------%% end of %%-----------
aTmpOut:TUARequestDataOutPacket;
begin

Result := 0;
with FUARequestDataInPacketdo
begin

adoQuery := TAdoDataSet.Create(Self);
adoQuery.EnableBCD := true;
adoQuery.Name := UniqueName(adoQuery,'adoQuery',Self);
dspQuery := TDataSetProvider.Create(Self);
dspQuery.Name := UniqueName(dspQuery,'dspQuery',Self);
cdsQuery := TClientDataSet.Create(Self);
cdsQuery.Name := UniqueName(cdsQuery,'cdsQuery',Self);

aDataRequestParam := TDataRequestParam.Create;
aDataReturnParam := TDataReturnParam.Create;
aTmpOut := TUARequestDataOutPacket.Create;
try
try
if CountMasterLink <> 0 then
sMasterLink := BuildMasterLinkSqlScript(FUARequestDataInPacket);
if CountRowSheet <> 0 then
sRowSheet := BuildRowSheetSqlScript(FUARequestDataInPacket);
aDataRequestParam := GetItemRequestData(0);
sTableName := aDataRequestParam.AliasTableName;
iRequestCount := aDataRequestParam.RequestRecCount;
iCurrCount := aDataRequestParam.CurrRecCount;
sKeys := aDataRequestParam.KeyFields;
sParams := aDataRequestParam.SqlParams;
if MustGetRecCount = 0 then
// modify by vinson zeng
begin
if trim(sMasterLink) <> '' then
//2004-03-28 will be modify
begin
// if trim(sParams) <> '' then
// iAllCount := GetAllRecCount(sTableName,sMasterLink + ' and '+sParams )
// else
iAllCount := GetAllRecCount(sTableName,sMasterLink);
end
else
begin
//2004-03-28
// if trim(sParams) <> '' then
// iAllCount := GetAllRecCount(sTableName,sParams )
// else
iAllCount := GetAllRecCount(sTableName,'');
end;
end;

sSql := Format('select * from %s ',[sTableName]);
if Trim(sMasterLink) <>'' then
begin
sSql := sSql + ' where '+ sMasterLink;
if Trim(sParams) <> '' then
sSql := sSql + ' and ' + sParams
end
else
begin
if Trim(sParams) <> '' then
sSql := sSql + ' where ' + sParams ;
end;

if Trim(sKeys) <> '' then
sSql := sSql + ' order by ' + sKeys;

// if iRequestCount <> -1 then
// adoRequest.MaxRecords := iRequestCount;
UADebugEx(ddRequest,Now(),Self,sSql);
adoQuery.Connection := DbConnection;
adoQuery.CommandText := sSql;
iOpenCount := OpenSrvData(adoQuery,dspQuery,cdsQuery);
except
Result := -1;
end;

finally
//-------%%begin
build ReturnDataPacket %%----------
if Result = 0 then
begin
//当iRequestCount = -1 时候，代表是下载全部数据！
if (iRequestCount <> -1) {or (CountRowSheet = 0)}then
begin
if iAllCount > (iOpenCount + iCurrCount) then
begin
// begin
build Tag
if cdsQuery.Active then
begin
sKeyList := TStringList.Create;
xStrSplit(sKeys,[','],sKeyList,true,true);
try
cdsQuery.DisableControls;
while not cdsQuery.Eofdo
begin
for j := 0 to sKeyList.Count -1do
begin
aRowSheetParam := TRowSheetParam.Create;
aRowSheetParam.AliasTableName := sTableName;
aRowSheetParam.FieldName := sKeyList.Strings[j];
aRowSheetParam.FieldType := cdsQuery.FindField(sKeyList.Strings[j]).DataType;
aRowSheetParam.CurrValue := cdsQuery.FindField(sKeyList.Strings[j]).Value;
aTmpOut.AddItemRowSheet(aRowSheetParam);
end;
cdsQuery.Next;
end;
finally
cdsQuery.EnableControls;
if Assigned(sKeyList) then
FreeAndNil(sKeyList);
end;
end;
end;
end;
if cdsQuery.Active then
begin
aDataReturnParam.AllRecCount := iAllCount;
aDataReturnParam.Data := cdsQuery.Data;
aDataReturnParam.CurrRecCount := iOpenCount + iCurrCount;
aTmpOut.AddItemReturnData(aDataReturnParam);
end;
vOutData := aTmpOut.UAData;
end;
//-------%% end of %%-------------------------------
if Assigned(aTmpOut) then
FreeAndNil(aTmpOut);
ReleaseAllDS(adoQuery,dspQuery,cdsQuery);
end;
end;

end;

function TuaServerObject.OpenSrvData(adoDS: TAdoDataSet;Dsp: TDataSetProvider;
Cds: TClientDataSet):integer;
begin

Result := 0;
if (not Assigned(adoDS)) or (not Assigned(Dsp)) or (not Assigned(Cds)) then
Exit;
try
adoDS.Close;
Dsp.DataSet := nil ;
Cds.ProviderName :='';
Cds.close;
adoDS.Open;
Dsp.DataSet := adoDS;
Cds.ProviderName := Dsp.Name;
Cds.Open;
Dsp.Options := Dsp.Options + [poIncFieldProps];
Result := Cds.RecordCount;
except
on E:Exceptiondo
begin
Result := -1;
MakeUAExceptionMsg(UA_E_OPEN_TABLE,E);
end;
end;

end;

function TuaServerObject.RefreshData(Sender: TObject;
var vOutData: OleVariant): integer;
var
sSql,sTableName,sKeys,sParams:string;
j,iAllCount,iCurrCount,iRequestCount,iOpenCount:integer;
aDataRequestParam:TDataRequestParam;
aDataReturnParam:TDataReturnParam;
// sKeyList:TStringList;
//------%% begin
declare %%--------
adoRefresh:TAdoDataSet;
dspRefresh:TDataSetProvider;
cdsRefresh:TClientDataSet;
//----------%% end of %%-----------
aTmpOut:TUARequestDataOutPacket;
begin

Result := 0;
with FUARequestDataInPacketdo
begin

adoRefresh := TAdoDataSet.Create(Self);
adoRefresh.EnableBCD := true;
adoRefresh.Name := UniqueName(adoRefresh,'adoRefresh',Self);
dspRefresh := TDataSetProvider.Create(Self);
dspRefresh.Name := UniqueName(dspRefresh,'dspRefresh',Self);
cdsRefresh := TClientDataSet.Create(Self);
cdsRefresh.Name := UniqueName(cdsRefresh,'cdsRefresh',Self);

aDataRequestParam := TDataRequestParam.Create;
aDataReturnParam := TDataReturnParam.Create;
aTmpOut := TUARequestDataOutPacket.Create;
try
try
aDataRequestParam := GetItemRequestData(0);
sTableName := aDataRequestParam.AliasTableName;
iRequestCount := aDataRequestParam.RequestRecCount;
iCurrCount := aDataRequestParam.CurrRecCount;
sKeys := aDataRequestParam.KeyFields;
sParams := aDataRequestParam.SqlParams;
if MustGetRecCount = 0 then
iAllCount := GetAllRecCount(sTableName,'');
//2004-03-28
sSql := Format('select * from %s ',[sTableName]);
if Trim(sParams) <> '' then
sSql := sSql + ' where ' + sParams ;
if Trim(sKeys) <> '' then
sSql := sSql + ' order by ' + sKeys;

UADebugEx(ddRequest,Now(),Self,sSql);
adoRefresh.Connection := DbConnection;
adoRefresh.CommandText := sSql;
iOpenCount := OpenSrvData(adoRefresh,dspRefresh,cdsRefresh);
except
Result := -1;
end;

finally
//-------%%begin
build ReturnDataPacket %%----------
if Result = 0 then
begin
if cdsRefresh.Active then
begin
aDataReturnParam.AllRecCount := iAllCount;
aDataReturnParam.Data := cdsRefresh.Data;
aDataReturnParam.CurrRecCount := iOpenCount + iCurrCount;
aTmpOut.AddItemReturnData(aDataReturnParam);
end;
vOutData := aTmpOut.UAData;
end;
//-------%% end of %%-------------------------------
if Assigned(aTmpOut) then
FreeAndNil(aTmpOut);
ReleaseAllDS(adoRefresh,dspRefresh,cdsRefresh);
end;
end;

end;

function TuaServerObject.ReleaseAllDS(adoDS: TAdoDataSet;
Dsp: TDataSetProvider;
Cds: TClientDataSet): integer;
begin

Result := 0;
if (not Assigned(adoDS)) or (not Assigned(Dsp)) or (not Assigned(Cds)) then
Exit;
try
adoDS.Close;
Dsp.DataSet := nil ;
Cds.ProviderName :='';
Cds.close;
FreeAndNil(adoDS);
FreeAndNil(dsp);
FreeAndNil(cds);
except
Result := -1;
end;

end;

procedure TuaServerObject.Request(ServiceName: WideString;
DataIn: OleVariant;
var DataOut: OleVariant);
var
bHandle:Boolean;
bContinue:Boolean;
aOut:OleVariant;
iMaxError:integer;
begin

bContinue := true;
bHandle := true;
InitForRequest(DataIn,DataOut);
CurrServiceName := Trim(ServiceName);
OperationTypes := otRequest;
try
try
ExLockDbConnection;
BeforeRequest(Self,bHandle);
if bHandle then
begin
if LowerCase(ServiceName) ='requestalldata' then
begin
RequestData(Self,aOut);
end
else
if LowerCase(ServiceName) ='refreshdata' then
begin
RefreshData(Self,aOut);
end
else
if LowerCase(ServiceName)='querydata' then
begin
QueryData(Self,aOut)
end
else
begin
RequestCustomData(ServiceName,DataIn,aOut);
end;
end
else
begin

end;
except
on E:Exceptiondo
begin
iMaxError := MakeUAExceptionMsg(UA_E_FATUALERROR,E,ServiceName);
end;
end;
finally
AfterRequest(Self,bContinue);
ExUnlockDbConnection;
if (not VarIsEmpty(aOut)) and (VarIsArray(aOut)) and
(VarCompareValue(aOut,Unassigned)<> vrEqual) and bContinue then
begin
if FUARequestDataOutPacket.CountErrorParam = 0 then
FUARequestDataOutPacket.UAData := aOut;
end
else
begin

end;
DataOut := FUARequestDataOutPacket.UAData;
end;

end;

function TuaServerObject.RequestData(Sender: TObject;var vOutData:OleVariant): integer;
var
sSql,sTableName,sKeys,sParams,sTmpSql,
sMasterLink,sRowSheet:string;
j,k,iAllCount,iCurrCount,iRequestCount,iOpenCount:integer;
aDataRequestParam:TDataRequestParam;
aDataReturnParam:TDataReturnParam;
aDataSheetParam:TDataSheetParam;
sKeyList:TStringList;
//------%% begin
declare %%--------
adoRequest:TAdoDataSet;
dspRequest:TDataSetProvider;
cdsRequest:TClientDataSet;
//----------%% end of %%-----------
aTmpOut:TUARequestDataOutPacket;
// sErrorMsg:string;
// sErrorContext:string;
begin

Result := 0;
with FUARequestDataInPacketdo
begin

adoRequest := TAdoDataSet.Create(Self);
adoRequest.EnableBCD := true;
// fix by vinson zeng
adoRequest.Name := UniqueName(adoRequest,'adoRequest',Self);
dspRequest := TDataSetProvider.Create(Self);
dspRequest.Name := UniqueName(dspRequest,'dspRequest',Self);
cdsRequest := TClientDataSet.Create(Self);
cdsRequest.Name := UniqueName(cdsRequest,'cdsRequest',Self);

aDataRequestParam := TDataRequestParam.Create;
aDataReturnParam := TDataReturnParam.Create;
aTmpOut := TUARequestDataOutPacket.Create;
try
try
if CountMasterLink <> 0 then
sMasterLink := BuildMasterLinkSqlScript(FUARequestDataInPacket);
if CountRowSheet <> 0 then
sRowSheet := BuildRowSheetSqlScript(FUARequestDataInPacket);
aDataRequestParam := GetItemRequestData(0);
sTableName := aDataRequestParam.AliasTableName;
iRequestCount := aDataRequestParam.RequestRecCount;
iCurrCount := aDataRequestParam.CurrRecCount;
sKeys := aDataRequestParam.KeyFields;
sParams := aDataRequestParam.SqlParams;
if MustGetRecCount = 0 then
begin
if trim(sMasterLink) <> '' then
//2004-03-28
begin
// if trim(sParams) <> '' then
// iAllCount := GetAllRecCount(sTableName,sMasterLink + ' and '+sParams )
// else
iAllCount := GetAllRecCount(sTableName,sMasterLink);
end
else
begin
//2004-03-28
// if trim(sParams) <> '' then
// iAllCount := GetAllRecCount(sTableName,sParams )
// else
iAllCount := GetAllRecCount(sTableName,'');
end;
end;

case RequestType of
-1: begin
sSql := Format('select * from %s ',[sTableName]);
if Trim(sMasterLink) <>'' then
begin
sSql := sSql + ' where '+ sMasterLink;
if Trim(sParams) <> '' then
sSql := sSql + ' and ' + sParams
end
else
begin
if Trim(sParams) <> '' then
sSql := sSql + ' where ' + sParams ;
end;

if Trim(sKeys) <> '' then
sSql := sSql + ' order by ' + sKeys;
end;
1: begin

sTmpSql := '';
sSql := Format('select * from %s ',[sTableName]);
for k := 0 to FUARequestDataInPacket.CountDataSheet -1do
begin
if Trim(sTmpSql) <> '' then
sTmpSql := sTmpSql + 'and ';
sTmpSql := sTmpSql + '( '+ GetItemDataSheet(k).FieldName
+ GetItemDataSheet(k).RelSymbol + FieldValueToSqlStr(GetItemDataSheet(k).FieldType,GetItemDataSheet(k).LastValue)
+' )';
end;
if Trim(sTmpSql) <> '' then
sTmpSql := '( '+sTmpSql+' )';

if Trim(sMasterLink) <>'' then
begin
sSql := sSql + ' where '+ sMasterLink;
if Trim(sParams) <> '' then
sSql := sSql + ' and ' + sParams ;
if Trim(sTmpSql) <> '' then
sSql := sSql + ' and ' +sTmpSql;
if Trim(sRowSheet) <> '' then
sSql := sSql + ' and ' +sRowSheet;
end
else
begin
if trim(sTmpSql) <> '' then
sSql := sSql + ' where '+ sTmpSql ;
if Trim(sParams) <> '' then
begin
if trim(sTmpSql) <> '' then
sSql := sSql + ' and ' + sParams
else
sSql := sSql + ' where '+ sParams;
end;
//fix bug 2003-10-31 vinson zeng
if Trim(sRowSheet) <> '' then
begin
if (trim(sParams) <> '') or (trim(sTmpSql) <> '') then
sSql := sSql + ' and '+ sRowSheet
else
sSql := sSql + ' where '+ sRowSheet;
end;
end;

if Trim(sKeys) <> '' then
sSql := sSql + ' order by ' + sKeys;
end;

end;

if iRequestCount <> -1 then
adoRequest.MaxRecords := iRequestCount;
UADebugEx(ddRequest,Now(),Self,sSql);
adoRequest.Connection := DbConnection;
adoRequest.CommandText := sSql;
iOpenCount := OpenSrvData(adoRequest,dspRequest,cdsRequest);
except //do not catch error
on E:Exceptiondo
begin
Result := -1;
MakeUAExceptionMsg(UA_E_DB_CONNECT,E);
end;
end;
finally
//-------%%begin
build ReturnDataPacket %%----------
if Result = 0 then
begin
if iRequestCount <> -1 then
begin
if iAllCount > (iOpenCount + iCurrCount) then
begin
// begin
build Tag
if cdsRequest.Active then
begin
sKeyList := TStringList.Create;
xStrSplit(sKeys,[','],sKeyList,true,true);
try
cdsRequest.DisableControls;
cdsRequest.Last;
for j := 0 to sKeyList.Count -1do
begin
aDataSheetParam := TDataSheetParam.Create;
aDataSheetParam.AliasTableName := sTableName;
aDataSheetParam.FieldName := sKeyList.Strings[j];
aDataSheetParam.RelSymbol := '>';
aDataSheetParam.FieldType := cdsRequest.FindField(sKeyList.Strings[j]).DataType;
aDataSheetParam.LastValue := cdsRequest.FindField(sKeyList.Strings[j]).Value;
aTmpOut.AddItemDataSheet(aDataSheetParam);
end;
finally
cdsRequest.EnableControls;
if Assigned(sKeyList) then
FreeAndNil(sKeyList);
end;
end;

end;
end;
if cdsRequest.Active then
begin
aDataReturnParam.AllRecCount := iAllCount;
aDataReturnParam.Data := cdsRequest.Data;
aDataReturnParam.CurrRecCount := iOpenCount + iCurrCount;
aTmpOut.AddItemReturnData(aDataReturnParam);
end;
vOutData := aTmpOut.UAData;
end;
//-------%% end of %%-------------------------------
if Assigned(aTmpOut) then
FreeAndNil(aTmpOut);
ReleaseAllDS(adoRequest,dspRequest,cdsRequest);
end;
end;
end;

procedure TuaServerObject.RollbackSyncTrans;
begin
if InSyncTrans and (not FSyncTransaction) then
begin
DbConnection.RollbackTrans;
UADebugEx(ddRollbackTrans,Now(),DbConnection,'RollBack Transaction');
end;
end;

procedure TuaServerObject.SetOperationType(const Value: TOperationType);
begin
FOperationTypes := Value;
end;

procedure TuaServerObject.SetPrepare(const Value: Boolean);
begin

if Value then
begin
if not FPrepare then
begin

end;
FPrepare := Value;
end
else
begin
if FPrePare then
begin

end;
FPrepare := Value;
end;

end;

procedure TuaServerObject.StartSyncTrans;
begin

if InSyncTrans then
RollbackSyncTrans;
if not FSyncTransaction then
begin
DbConnection.begin
Trans;
UADebugEx(ddStartTrans,Now(),DbConnection,'Start Transaction On :');
end;

end;

{-----------------------------------------------------------------------------
Procedure: TuaServerObject.SubmitAllDelta
Author: vinson zeng
Date: 04-三月-2004
Arguments: bStartTrans: Boolean;AllDelta: OleVariant
Result: integer
-----------------------------------------------------------------------------}
function TuaServerObject.SubmitAllDelta(bStartTrans: Boolean;AllDelta: OleVariant):integer;
var
i,j,iResult,iError:integer;
lStrList:TStringList;
aDeltaParam:TDeltaParam;
aTmpCDS:TClientDataSet;
FKeyFields: array of string;
begin

iResult := 0;
// 使用等待信号灯锁，目的是为了提高并发效率，降低（消除）DBMS死锁
// if WaitForSingleObject(FSemaphore, 2000) = WAIT_FAILED then
// wait 2 second
if bStartTrans then
StartSyncTrans;
try
for i := VarArrayHighBound(AllDelta,1)do
wnto VarArrayLowBound(AllDelta,1)do
// for i := VarArrayLowBound(AllDelta,1) to VarArrayHighBound(AllDelta,1)do
begin

lStrList := TStringList.Create;
iError := 0;
aTmpCDS := TClientDataSet.Create(Self);
aTmpCDS.Name := UniqueName(aTmpCDS,'SubmitDelta_TmpCds',Self);
aDeltaParam := TDeltaParam.Create;
aDeltaParam.UAData := AllDelta;
try
with aDeltaParamdo
begin
if (Trim(AliasTableName) = '') or (Trim(KeyFields) = '') then
begin
Inc(iResult);
Continue;
end;
xStrSplit(KeyFields,[','],lStrList,true,true);
SetLength(FKeyFields,lStrList.Count);
for j := 0 to lStrList.Count -1do
FKeyFields[j] := lStrList.Strings[j];
aTmpCDS.Data := Delta;
iError := SubmitDelta(DbConnection,AliasTableName,aTmpCDS,FKeyFields, // error message must return
[upModifyOne, upInsert, upDeleteOne], 0,FUAUpdateDataOutPacket);
if iError <> 0 then
Inc(iResult);
end;
finally
if Assigned(lStrList) then
FreeAndNil(lStrList);
if Assigned(aDeltaParam) then
FreeAndNil(aDeltaParam);
if Assigned(aTmpCDS) then
FreeAndNil(aTmpCDS);
end;
end;
except
end;

if iResult <> 0 then
begin
if bStartTrans then
RollbackSyncTrans;
end
else
begin
if bStartTrans then
CommitSyncTrans;
end;

Result := iResult ;

end;

procedure TuaServerObject.Update(ServiceName: WideString;
DataIn: OleVariant;var DataOut: OleVariant);
var
bContinue:Boolean;
bHandle:Boolean;
vDelta:Variant;
iSubmitError:integer;
iMaxError:integer;
aOut:OleVariant;
begin

bContinue := true;
bHandle := true;
InitForUpdate(DataIn,DataOut);
CurrServiceName := Trim(ServiceName);
OperationTypes := otUpdate;
try
try
ExLockDbConnection;
BeforeUpdate(Self,bHandle);
// can Start transaction begin
here
if bHandle then
begin
if LowerCase(ServiceName) ='submitalldelta' then
begin
if FUAUpdateDataInPacket.UpdateIndex = -1 then
begin
vDelta := BuildDeltaArray(FUAUpdateDataInPacket);
if not FSyncTransaction then
iSubmitError := SubmitAllDelta(true,vDelta)
else
iSubmitError := SubmitAllDelta(false,vDelta);
end;
end
else
begin
UpdateCustomDelta(ServiceName,DataIn,aOut);
end;
end
else
begin
// catch error
end;
except
on E:Exceptiondo
begin
iMaxError := MakeUAExceptionMsg(UA_E_FATUALERROR,E,ServiceName);
end;
end;
finally
AfterUpdate(Self,bContinue);
//must handle at here // can commit or rollback transaction in here
ExUnlockDbConnection;
FUAUpdateDataOutPacket.ResultCode := iSubmitError;
DataOut := FUAUpdateDataOutPacket.UAData;
end;

end;

procedure TuaServerObject.SetCurrServiceName(const Value: string);
begin
FCurrServiceName := Value;
end;


function TuaServerObject.GetCurrServiceName: string;
begin
Result := FCurrServiceName;
end;

function TuaServerObject.GetTableStru(vDataIn:OleVariant;var vOutData: OleVariant): integer;
var
FAdoDsDesign:TAdoDataSet;
FdspDesign:TDataSetProvider;
FcdsDesign:TClientDataSet;
sSql:string;
begin

FAdoDsDesign := TAdoDataSet.Create(Application);
FAdoDsDesign.EnableBCD := true;
FAdoDsDesign.Name := UniqueName(FAdoDsDesign,'adodsdesign',nil);
FdspDesign := TDataSetProvider.Create(Application);
FdspDesign.Name := UniqueName(FdspDesign,'dspdesign',nil);
FcdsDesign := TClientDataSet.Create(Application);
FcdsDesign.Name := UniqueName(FcdsDesign,'cdsdesign',nil);
try
try
sSql := Format('select top 0 * from %s',[VarToStr(vDataIn)]);
if trim(sSql)<> '' then
begin
FAdoDsDesign.Connection := DbConnection;
FAdoDsDesign.CommandText := sSql;
if OpenSrvData(FAdoDsDesign,FdspDesign,FcdsDesign) <> -1 then
begin
if FcdsDesign.Active then
vOutData := FcdsDesign.Data;
end;
end;
except
on E:Exceptiondo
begin
//catch AppServer Error Message
end;
end;
finally
if Assigned( FAdoDsDesign) then
FreeAndNil( FAdoDsDesign);
if Assigned(FdspDesign) then
FreeAndNil(FdspDesign);
if Assigned(FcdsDesign) then
FreeAndNil(FcdsDesign);
end;

end;

function TuaServerObject.GetUAErrorCount(OperationType: TOperationType): integer;
begin

case OperationType of
otRequest : Result := FUARequestDataOutPacket.CountErrorParam;
otUpdate : Result := FUAUpdateDataOutPacket.CountErrorParam;
otExecute : Result := FUAExecuteDataOutPacket.CountErrorParam;
end;

end;

{-----------------------------------------------------------------------------
Procedure: TuaServerObject.SubmitDelta
Author: vinson zeng
Date: 04-三月-2004
Arguments: lAdoConn:TAdoConnection;sTblName:string;cdsSrc:TClientDataSet;
lFieldKeys:array of string;UpdateType:TUAUpdateTypes;
iFailMax:integer;var uaOut:TUAUpdateDataOutPacket
Result: integer
-----------------------------------------------------------------------------}
//未对Blob 字段进行处理
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:integer;
lField:TField;
sSql,s1,sSqlSelect:string;
v1:variant;
adoU:TAdoCommand;
bContinue:Boolean;
cdsDest:TClientDataSet;
adoSelect:TAdoDataSet;
UpdateError:TUAUpdateErrorCode;
aErrorCDS:TClientDataSet;
bAtHandle,bBtHandle:Boolean;
begin

bAtHandle := false;
bBtHandle := false;
Result := 0;
adoU := nil;
adoU := TAdoCommand.Create(Self);
adoU.Name := UniqueName(adoU,'SubmitDelta_TmpAdoComm',Self);
cdsDest := nil;
cdsDest := TClientDataSet.Create(Self);
cdsDest.Name := UniqueName(cdsDest,'SubmitDelta_CdsDest',Self);
aErrorCDS := TClientDataSet.Create(Self);
aErrorCDS.Name := UniqueName(aErrorCDS,'SubmitDelta_ErrorCds',Self);
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
while (not cdsSrc.Eof) and bContinue and (not bAtHandle) and (not bBtHandle)do
begin
cdsDest.Insert;
for i :=0 to cdsSrc.FieldCount -1do
cdsDest.Fields.Value := cdsSrc.Fields.Value;
{ begin
//2004-4-9 add by vinson zeng for Blob &amp;
Int64
case cdsDest.Fields.DataType of
ftString..ftDateTime: cdsDest.Fields.Value := cdsSrc.Fields.Value;
ftLargeint : cdsDest.Fields.AsString := cdsSrc.Fields.AsString;
ftFixedChar, ftWideString: cdsDest.Fields.Value := cdsSrc.Fields.Value;
ftBlob, ftMemo, ftGraphic: cdsDest.Fields.Value := cdsSrc.Fields.Value;
end;
end;
}
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
UADebugEx(ddUpdate,Now(),Self,sSqlSelect);
adoSelect.Connection := lAdoConn;
adoSelect.CommandText := sSqlSelect;
adoSelect.Open;
except
on E:Exceptiondo
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
UpDateError := ueModChanged;
inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
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:Exceptiondo
begin
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
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:Exceptiondo
begin
Inc(Result);
if (iFailMax>0) and (Result >= iFailMax) then
bContinue := false;
UpdateError := ueModManySql;
end;
end;
end;
end;
end;
if UpdateError <>ueOk then
begin

//修改数据不成功，返回调用异常
//异常消息+数据包
MakeUAExceptionMsg(UA_E_EXEC_MODIFY_SQL,nil,TUAUpdateErrorMsg[Ord((updateError))] +#13#10+ 'Sql Script Is:' + sSql );
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
UADebugEx(ddUpdate,Now(),Self,sSqlSelect);
adoSelect.Connection := lAdoConn;
adoSelect.CommandText := sSqlSelect;
adoSelect.Open;
except
on E:Exceptiondo
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:Exceptiondo
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 -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
UADebugEx(ddUpdate,Now(),Self,sSqlSelect);
adoSelect.Connection := lAdoConn;
adoSelect.CommandText := sSqlSelect;
adoSelect.Open;
except
on E:Exceptiondo
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:Exceptiondo
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:Exceptiondo
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 -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;

procedure TuaServerObject.AfterTriggerForDataSet(TableName: string;SrcDS:TDataSet;DestDS:TDataSet;var bHandle:Boolean);
begin
//Case SrcDS .UpdateStatus Todo
//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);
VarReturn := cdsRecordSet.Data;
end;
end
else
begin
Result := -1;
end;
except
on E:Exceptiondo
begin
iMaxError := MakeUAExceptionMsg(UA_E_EXEC_STPREDPROC,E,ProcName);
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;

function TuaServerObject.QueryViewData(sSqlScript: string;
var vOutData: OleVariant): integer;
var
//------%% begin
declare %%--------
adoQryViewData:TAdoDataSet;
dspQryViewData:TDataSetProvider;
cdsQryViewData:TClientDataSet;
//----------%% end of %%-----------
iOpenCount:integer;
begin

if trim(sSqlScript) = '' then
begin
VarClear(vOutData);
Exit;
end;
try
VarClear(vOutData);
adoQryViewData := TAdoDataSet.Create(Self);
adoQryViewData.EnableBCD := true;
// fix by vinson zeng
adoQryViewData.Name := UniqueName(adoQryViewData,'adoQryViewData',Self);
dspQryViewData := TDataSetProvider.Create(Self);
dspQryViewData.Name := UniqueName(dspQryViewData,'dspQryViewData',Self);
cdsQryViewData := TClientDataSet.Create(Self);
cdsQryViewData.Name := UniqueName(cdsQryViewData,'cdsQryViewData',Self);
adoQryViewData.Connection := DbConnection;
adoQryViewData.CommandText := sSqlScript;
iOpenCount := OpenSrvData(adoQryViewData,dspQryViewData,cdsQryViewData);
finally
if iOpenCount > 0 then
vOutData := cdsQryViewData.Data;
ReleaseAllDS(adoQryViewData,dspQryViewData,cdsQryViewData);
end;

end;

procedure TuaServerObject.ExLockDbConnection;
begin

try
if (not Assigned(DbConnection)) and (not FSyncTransaction) then
DbConnection := G_UASystem.LockDbConn(DBName);
except
on E:Exceptiondo
begin
MakeUAExceptionMsg(UA_E_DB_CONNECT,E);
end;
end;

end;

procedure TuaServerObject.ExUnlockDbConnection;
begin

try
if (Assigned(DbConnection)) and (not FSyncTransaction)then
begin
G_UASystem.UnLockDbConn(DBName,DbConnection);
DbConnection := nil;
end;
except
on E:Exceptiondo
begin
MakeUAExceptionMsg(UA_E_DB_DISCONNECT,E);
end;

end;
end;

procedure TuaServerObject.SetDBName(const Value: string);
begin
FDBName := Value;
end;

initialization
finalization

end.
 
您必须登录或注册才可回复。

Similar threads

I
填充页面上的Form
回复
0
查看
529
import
I
I
如何取得局域网内的计算机名？
回复
0
查看
537
import
I
I
建议收录
回复
0
查看
630
import
I
I
图像旋转控件
回复
0
查看
625
import
I
I
去掉代码中的注释
回复
0
查看
671
import
I
后退
顶部