Page 1 of 1

Performance issue upgrading to ODDAC 6.90 from ODAC 5.55

Posted: Tue 12 Oct 2010 08:38
by sondei
Hi,

I recently upgraded a long time running Delphi 7 program to ODAC 6.90 and this resulted in very poor performance. Following is a comparison log:



MY PROGRAM BUILD WITH
ODAC 5.55.1.26 FOR DEPLHI 7

>>>> TrovaCli: 1: CC10096: 18.28.04.626
>>>> TrovaCli: 2: CC10096: 18.28.04.626
>>>> TrovaCli: 3: CC10096: 18.28.04.626
>>>> TrovaArt: 1: POMP1000: 18.28.10.593
>>>> TrovaArt: 2: POMP1000: 18.28.10.602
>>>> TrovaArt: 3: POMP1000: 18.28.10.602
>>>> DeterminaPrzList: start: POMP1000: 18.28.10.636
>>>> ApplicaRegolePrzList: start: POMP1000: 18.28.10.636
>>>> ApplicaRegolePrzList: 1: POMP1000: 18.28.10.636
>>>> ApplicaRegolePrzList: 2: POMP1000: 18.28.10.636
>>>> ApplicaRegolePrzList: 3: POMP1000: 18.28.10.636
>>>> ApplicaRegolePrzList: 4: POMP1000: 18.28.10.636
>>>> ApplicaRegolePrzList: 5: POMP1000: 18.28.10.636
>>>> ApplicaRegola: start: POMP1000: 18.28.10.636
>>>> TrovaValoreChiave: start: ITMMASTER: ITMREF_0: 18.28.10.636
>>>> TrovaValoreChiave: 1: ITMMASTER: ITMREF_0: 18.28.10.636
>>>> TrovaValoreChiave: 2: ITMMASTER: ITMREF_0: 18.28.10.644
>>>> TrovaValoreChiave: end: ITMMASTER: ITMREF_0: 18.28.10.644
>>>> TrovaPrzList: start: 1HCETR: 18.28.10.644
>>>> TrovaPrzList: 1: 1HCETR: 18.28.10.644
>>>> TrovaPrzList: 2: 1HCETR: 18.28.10.644
>>>> TrovaPrzList: end: 1HCETR: 18.28.10.644
>>>> ApplicaRegola: end: POMP1000: 18.28.10.644
>>>> ApplicaRegolePrzList: 6: POMP1000: 18.28.10.644
etc.

THE SAME PROGRAM BUILD WITH
ODAC 6.90.0.60 FOR DEPLHI 7

>>>> TrovaCli: 1: CC10096: 18.22.17.464
>>>> TrovaCli: 2: CC10096: 18.22.17.480
>>>> TrovaCli: 3: CC10096: 18.22.17.480
>>>> TrovaArt: 1: POMP1000: 18.22.22.498
>>>> TrovaArt: 2: POMP1000: 18.22.22.506
>>>> TrovaArt: 3: POMP1000: 18.22.22.506
>>>> DeterminaPrzList: start: POMP1000: 18.22.22.592
>>>> ApplicaRegolePrzList: start: POMP1000: 18.22.22.592
>>>> ApplicaRegolePrzList: 1: POMP1000: 18.22.22.592
>>>> ApplicaRegolePrzList: 2: POMP1000: 18.22.22.592
>>>> ApplicaRegolePrzList: 3: POMP1000: 18.22.22.613
>>>> ApplicaRegolePrzList: 4: POMP1000: 18.22.22.613
>>>> ApplicaRegolePrzList: 5: POMP1000: 18.22.22.613
>>>> ApplicaRegola: start: POMP1000: 18.22.22.613
>>>> TrovaValoreChiave: start: ITMMASTER: ITMREF_0: 18.22.22.613
>>>> TrovaValoreChiave: 1: ITMMASTER: ITMREF_0: 18.22.22.613
>>>> TrovaValoreChiave: 2: ITMMASTER: ITMREF_0: 18.22.22.620
>>>> TrovaValoreChiave: end: ITMMASTER: ITMREF_0: 18.22.22.620
>>>> TrovaPrzList: start: 1HCETR: 18.22.22.620
>>>> TrovaPrzList: 1: 1HCETR: 18.22.22.620
>>>> TrovaPrzList: 2: 1HCETR: 18.22.22.628
>>>> TrovaPrzList: end: 1HCETR: 18.22.22.628
>>>> ApplicaRegola: end: POMP1000: 18.22.22.628
>>>> ApplicaRegolePrzList: 6: POMP1000: 18.22.22.628



Note for example lines

>>>> ApplicaRegolePrzList: 2 ...
>>>> ApplicaRegolePrzList: 3 ...

These lines had been printed out just before and after opening a query. As you can see, the opening time increases from less than 1 millisec to almost 20 millisecs. The query executes a simple select against a synonimous that in turn refers to a view; this view includes columns from tables that are inside another database in the same Oracle server. Performance issue seems not to appear while accessing plain tables.

Using direct mode instead of Oracle client technology while accessing database does not change the performance in any apprentiable way.

Could you please help me? The customer is very upset with the performance of the new ODAC and I have to find a solution.

Silvano

Code details

Posted: Tue 12 Oct 2010 08:40
by sondei
Following is the code that produced the logs:



unit USqlUtils;

interface
uses
Classes, DB, MemDS, DBAccess, Ora, OraSmart;

const
MS_ACCESS = 1;
ORACLE = 2;

SQL_DIALECT = ORACLE;
IL_SERIALIZABLE_SUPPORTED = (SQL_DIALECT = ORACLE);

function TableNameFromSql(Expr: String): String;

function SqlQuotedColName(ColName: String): String;
function SqlAlias(ColName: String): String;
function SqlQuotedStr(Expr: String): String;

function SqlDefault(Expr1, Expr2: String): String;
function SqlSubstr(Expr: String; Start, Len: Integer): String;
function SqlConcat(Expr1, Expr2: String): String;
function SqlFormatIntDate(Expr: String): String;

procedure InitQuery(Query: TSmartQuery; SqlStr: String); overload;
procedure InitQuery(Query: TOraQuery; SqlStr: String); overload;
procedure RefreshQuery(Query: TSmartQuery);

function ReadField(DataSet: TDataSet; FieldName: String; DefValue: Variant): Variant;


implementation
uses
UDebugForm, UUtils, SysUtils, Math, StrUtils;

// ********************************************************************************************
// TableNameFromSql
// ********************************************************************************************

function TableNameFromSql(Expr: String): String;
const
TOKEN = 'FROM';
TOKEN_LEN = 4;
var
i, j, Len: Integer;
Str: String;
begin
Result := '';
Str := UpperCase(Expr);
Len := Length(Str);

i := Pos(TOKEN, Str);
if i = 0 then Exit;

Inc(i, TOKEN_LEN);
while (i <= Len) and (Str <= ' ') do Inc(i);

j := i;
if (j < Len) then Inc(j);
while (j <= Len) and (Str[j] in ['A'..'Z', '0'..'9', '_']) do Inc(j);

Result := Copy(Expr, i, j - i);
end;

// ********************************************************************************************
// SqlQuotedColName
// SqlAlias
// SqlQuotedStr
//
// SqlDefault
// SqlSubstr
// SqlConcat
// SqlFormatIntDate
// ********************************************************************************************

function SqlQuotedColName(ColName: String): String;
begin
case SQL_DIALECT of
MS_ACCESS: Result := '[' + ColName + ']';
ORACLE: Result := ColName;
end;
end;

function SqlAlias(ColName: String): String;
begin
case SQL_DIALECT of
MS_ACCESS: Result := ColName;
ORACLE: Result := '"' + ColName + '"';
end;
end;

function SqlQuotedStr(Expr: String): String;
begin
Result := QuotedStr(Expr);
end;

function SqlDefault(Expr1, Expr2: String): String;
begin
case SQL_DIALECT of
MS_ACCESS: Result := 'Iif(IsNull(' + Expr1 + '),' + Expr2 + ',' + Expr1 + ')';
ORACLE: Result := 'NVL(' + Expr1 + ',' + Expr2 + ')';
end;
end;

function SqlSubstr(Expr: String; Start, Len: Integer): String;
begin
case SQL_DIALECT of
MS_ACCESS: Result := 'MID(' + Expr + ',' + IntToStr(Start - 1) + ',' + IntToStr(Len) + ')';
ORACLE: Result := 'SUBSTR(' + Expr + ',' + IntToStr(Start) + ',' + IntToStr(Len) + ')';
end;
end;

function SqlConcat(Expr1, Expr2: String): String;
begin
case SQL_DIALECT of
MS_ACCESS: Result := '(' + Expr1 + ' & ' + Expr2 + ')';
ORACLE: Result := 'CONCAT(' + Expr1 + ',' + Expr2 + ')';
end;
end;

function SqlFormatIntDate(Expr: String): String;
var
DExpr, DMExpr, DMYExpr: String;
begin
DExpr := SqlSubstr(Expr, 7, 2);
DMExpr := SqlConcat(SqlConcat(DExpr, '''-'''), SqlSubStr(Expr, 5, 2));
DMYExpr := SqlConcat(SqlConcat(DMExpr, '''-'''), SqlSubStr(Expr, 1, 4));

Result := DMYExpr;
end;

// ********************************************************************************************
// InitQuery
// RefreshQuery
// ********************************************************************************************

procedure InitQuery(Query: TSmartQuery; SqlStr: String);
begin
Query.Close;
Query.Params.Clear;
Query.SQL.Clear;

Query.LocalUpdate := False;
Query.CachedUpdates := False;

// Evita problemi di performance scoperti in ODAC 6.90.0.60
Query.Options.DefaultValues := False;
Query.Options.ExtendedFieldsInfo := False;
Query.Options.QueryRecCount := False;
Query.Options.RequiredFields := False;

Query.SQL.Add(SqlStr);
end;

procedure InitQuery(Query: TOraQuery; SqlStr: String);
begin
Query.Close;
Query.Params.Clear;
Query.SQL.Clear;

Query.LocalUpdate := False;
Query.CachedUpdates := False;

// Evita problemi di performance scoperti in ODAC 6.90.0.60
Query.Options.DefaultValues := False;
Query.Options.ExtendedFieldsInfo := False;
Query.Options.QueryRecCount := False;

Query.SQL.Add(SqlStr);
end;

procedure RefreshQuery(Query: TSmartQuery);
var
Bk: String;
begin
Bk := Query.Bookmark;
Query.Close();
Query.Open();
Query.Bookmark := Bk;
end;

// ********************************************************************************************
// ReadField
// ********************************************************************************************

function ReadField(DataSet: TDataSet; FieldName: String; DefValue: Variant): Variant;
begin
try
if (DataSet = nil) or (DataSet.IsEmpty) or DataSet.FieldByName(FieldName).IsNull then
Result := DefValue
else
Result := DataSet.FieldByName(FieldName).Value;
except
on E: Exception do Result := DefValue;
end;
end;

end.

Code details

Posted: Tue 12 Oct 2010 08:42
by sondei
Following are the utility procedures used to initialize query objects:




procedure InitQuery(Query: TSmartQuery; SqlStr: String);
begin
Query.Close;
Query.Params.Clear;
Query.SQL.Clear;

Query.LocalUpdate := False;
Query.CachedUpdates := False;

// Evita problemi di performance scoperti in ODAC 6.90.0.60
Query.Options.DefaultValues := False;
Query.Options.ExtendedFieldsInfo := False;
Query.Options.QueryRecCount := False;
Query.Options.RequiredFields := False;

Query.SQL.Add(SqlStr);
end;

procedure InitQuery(Query: TOraQuery; SqlStr: String);
begin
Query.Close;
Query.Params.Clear;
Query.SQL.Clear;

Query.LocalUpdate := False;
Query.CachedUpdates := False;

// Evita problemi di performance scoperti in ODAC 6.90.0.60
Query.Options.DefaultValues := False;
Query.Options.ExtendedFieldsInfo := False;
Query.Options.QueryRecCount := False;

Query.SQL.Add(SqlStr);
end;

Code details

Posted: Tue 12 Oct 2010 08:45
by sondei
Following is the code that produced the logs:



unit USqlList;

interface
uses
UAppTypes, Ora, OraSmart, kbmMemTable;

procedure ValorizzaSpricLinkMemTablePerList(IdAz, CodDiv, CodCli, SitoSped: String);

// In caso d'eccezione torna -1
procedure DeterminaPrzList(CodArt: String; var PrzList: TPrzList);


implementation
uses
UDebugForm, UAppConsts, UUtils, USqlUtils, UAppUtils, UOrdDataModule, Classes, SysUtils,
DateUtils, USqlPickUp;

// ********************************************************************************************
// ValorizzaSpricLinkMemTablePerList
// ********************************************************************************************

procedure ValorizzaSpricLinkMemTablePerList(IdAz, CodDiv, CodCli, SitoSped: String);
var
CodDivNew, SitoVend: String;
begin
if Trim(CodDiv) = DB_COD_DIV_TRI then
CodDivNew := 'HC'
else if Trim(CodDiv) = DB_COD_DIV_COS then
CodDivNew := 'SC'
else
CodDivNew := 'VAR';

TrascodDaTabAObjExtR(OrdDataModule.QueryPerList, 10, IdAz, SitoVend);

with OrdDataModule do
begin
SpricLinkMemTablePerList.EmptyTable;
SpricLinkMemTablePerList.Insert;

SpricLinkMemTablePerList.FieldByName('CLE_0').Value := '';
SpricLinkMemTablePerList.FieldByName('SOHTYP_0').Value := '';
SpricLinkMemTablePerList.FieldByName('CPY_0').Value := IdAz;
SpricLinkMemTablePerList.FieldByName('SALFCY_0').Value := SitoSped;
SpricLinkMemTablePerList.FieldByName('BPCINV_0').Value := CodCli;
SpricLinkMemTablePerList.FieldByName('BPCGRU_0').Value := CodCli;
SpricLinkMemTablePerList.FieldByName('PJT_0').Value := '';
SpricLinkMemTablePerList.FieldByName('PTE_0').Value := '';
SpricLinkMemTablePerList.FieldByName('TSCCOD_0').Value := '';
SpricLinkMemTablePerList.FieldByName('TSCCOD_1').Value := '';
SpricLinkMemTablePerList.FieldByName('TSCCOD_2').Value := '';
SpricLinkMemTablePerList.FieldByName('TSCCOD_3').Value := '';
SpricLinkMemTablePerList.FieldByName('TSCCOD_4').Value := '';
SpricLinkMemTablePerList.FieldByName('BPTNUM_0').Value := '';
SpricLinkMemTablePerList.FieldByName('MDL_0').Value := '';
SpricLinkMemTablePerList.FieldByName('STOFCY_0').Value := '';
SpricLinkMemTablePerList.FieldByName('TSICOD_0').Value := '';
SpricLinkMemTablePerList.FieldByName('TSICOD_1').Value := '';
SpricLinkMemTablePerList.FieldByName('TSICOD_2').Value := '';
SpricLinkMemTablePerList.FieldByName('TSICOD_3').Value := '';
SpricLinkMemTablePerList.FieldByName('TSICOD_4').Value := '';
SpricLinkMemTablePerList.FieldByName('PCK_0').Value := '';
SpricLinkMemTablePerList.FieldByName('USEPLC_0').Value := '';
SpricLinkMemTablePerList.FieldByName('PNTITMREF_0').Value := '';
SpricLinkMemTablePerList.FieldByName('CUSORDREF_0').Value := 0;
SpricLinkMemTablePerList.FieldByName('VACBPR_0').Value := '';
SpricLinkMemTablePerList.FieldByName('FOCITM_0').Value := 0;
SpricLinkMemTablePerList.FieldByName('CLCAMT1_0').Value := 0.0;
SpricLinkMemTablePerList.FieldByName('CLCAMT2_0').Value := 0.0;
SpricLinkMemTablePerList.FieldByName('LINTYP_0').Value := 0;
SpricLinkMemTablePerList.FieldByName('LINTYP_A_0').Value := 0;
SpricLinkMemTablePerList.FieldByName('LINTYP_B_0').Value := 0;
SpricLinkMemTablePerList.FieldByName('LINTYP_C_0').Value := 0;

// Intersocietà: flag non usato nei listini rilevanti per SFA
SpricLinkMemTablePerList.FieldByName('BETCPY_0').Value := 0;

SpricLinkMemTablePerList.FieldByName('ZFATHER_0').Value := '';
SpricLinkMemTablePerList.FieldByName('ZFATHER_1').Value := '';
SpricLinkMemTablePerList.FieldByName('ZFATHER_2').Value := '';
SpricLinkMemTablePerList.FieldByName('ZFATHER_3').Value := '';
SpricLinkMemTablePerList.FieldByName('ZFATHER_4').Value := '';
SpricLinkMemTablePerList.FieldByName('ZFATHER_5').Value := '';
SpricLinkMemTablePerList.FieldByName('ZFATHER_6').Value := '';
SpricLinkMemTablePerList.FieldByName('ZFATHER_7').Value := '';
SpricLinkMemTablePerList.FieldByName('ZCODDIV_0').Value := CodDivNew;
SpricLinkMemTablePerList.FieldByName('Z_TPAGENTE_0').Value := '';
SpricLinkMemTablePerList.FieldByName('REPNUM_0').Value := '';
SpricLinkMemTablePerList.FieldByName('ZAGECORR_0').Value := 0;
SpricLinkMemTablePerList.FieldByName('ORIFCY_0').Value := SitoVend;

SpricLinkMemTablePerList.Post;
end;
end;

// ********************************************************************************************
// DeterminaPrzList
// ********************************************************************************************

function TrovaPrzList(Query: TOraQuery; Selettore: String; N: Integer; ValoriChiave:
Array of String; Date: TDateTime; ValorizzaPrzBase, ValorizzaMolt: Boolean;
var PrzList: TPrzList): Integer;
var
SqlStr: String;
I: Integer;
begin
DebugForm.PrintLn('>>>> TrovaPrzList: start: ' + Selettore + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));

SqlStr :=
' SELECT '
+ ' PRI_0, '
+ ' DCGVAL_0, '
+ ' DCGVAL_1, '
+ ' DCGVAL_2, '
+ ' DCGVAL_3 '
+ ' FROM '
+ ' M_COR_SPRICLIST '
+ ' WHERE '
+ ' PLI_0 = :PPli '
+ ' AND TO_CHAR(PLISTRDAT_0,''YYYYMMDD'') = TO_CHAR(SYSDATE,''YYYYMMDD'') ';

for I := 0 to 4 do
if I >>> TrovaPrzList: 1: ' + Selettore + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
Query.Open;
DebugForm.PrintLn('>>>> TrovaPrzList: 2: ' + Selettore + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
Result := Query.RecordCount;

if not Query.Eof then
begin
if ValorizzaPrzBase then
if Result = 1 then
PrzList.ZprBase := Query.FieldByName('PRI_0').AsFloat
else
begin
PrzList.ZprBase := 0;
PrzList.Ambig := True;
end;

if ValorizzaMolt then
begin
PrzList.ZMult1 := Query.FieldByName('DCGVAL_0').AsFloat;
PrzList.ZMult2 := Query.FieldByName('DCGVAL_1').AsFloat;
PrzList.ZMult3 := Query.FieldByName('DCGVAL_2').AsFloat;
PrzList.ZMult4 := Query.FieldByName('DCGVAL_3').AsFloat;
end;
end;

Query.Close;

except
on E: Exception do
begin
GestisciEccez(E);
Result := -1;
Exit;
end;
end;

if not(ValorizzaPrzBase or ValorizzaMolt) then Result := 0;

DebugForm.PrintLn('>>>> TrovaPrzList: end: ' + Selettore + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
end;

function TrovaValoreChiave(Query: TOraQuery; NomeTabella, NomeCampo: String; NomiCampiChiave,
ValoriCampiChiave: Array of String; var ValoreCampo: String): Integer;
var
SqlStr: String;
I, N: Integer;
begin
DebugForm.PrintLn('>>>> TrovaValoreChiave: start: ' + NomeTabella + ': ' + NomeCampo + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));

N := High(NomiCampiChiave);

SqlStr :=
' SELECT '
+ ' ' + NomeCampo
+ ' FROM '
+ ' M_COR_' + NomeTabella
+ ' WHERE ';

for I := 0 to N do
if I = 0 then
SqlStr := SqlStr + ' ' + NomiCampiChiave + ' = :P' + IntToStr(I)
else
SqlStr := SqlStr + ' AND ' + NomiCampiChiave + ' = :P' + IntToStr(I);

try
InitQuery(Query, SqlStr);

for I := 0 to N do
Query.Params.ParamByName('P' + IntToStr(I)).Value := ValoriCampiChiave;

DebugForm.PrintLn('>>>> TrovaValoreChiave: 1: ' + NomeTabella + ': ' + NomeCampo + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
Query.Open;
DebugForm.PrintLn('>>>> TrovaValoreChiave: 2: ' + NomeTabella + ': ' + NomeCampo + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
Result := Query.RecordCount;

if not Query.Eof then ValoreCampo := Query.FieldByName(NomeCampo).AsString;
Query.Close;

except
on E: Exception do
begin
GestisciEccez(E);
Result := -1;
Exit;
end;
end;

DebugForm.PrintLn('>>>> TrovaValoreChiave: end: ' + NomeTabella + ': ' + NomeCampo + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
end;

function ApplicaRegola(RegoleQuery, Query: TOraQuery; CodArt: String; SpricLinkMemTable:
TkbmMemTable; ValorizzaPrzBase, ValorizzaMolt: Boolean; var PrzList: TPrzList): Boolean;
var
CodCli: String;
NomiTabellaDaRegole: Array[0..4] of String;
NomiCampoDaRegole: Array[0..4] of String;
IndiciCampoDaRegole: Array[0..4] of String;
I, N: Integer;
NomeTabellaDaRegole, NomeCampoDaRegole: String;
NomiCampoRicerca, ValoriCampoRicerca: Array of String;
ValoriChiave: Array[0..4] of String;
Selettore: String;
begin
DebugForm.PrintLn('>>>> ApplicaRegola: start: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));

CodCli := SpricLinkMemTable.FieldByName('BPCINV_0').Value;

// Estrazione, dal record set delle regole, di N chiave: BPRNUM_0 (codice cliente nel caso di listini/provvigioni)
// BPCUSTOMER -> chiave: BPCNUM_0 (codice cliente)
// ITMMASTER -> chiave: ITMREF_0 (codice articolo)
//
// Nota. La tabella BPARTNER è un segmento di estensione sia per la tabella
// clienti, sia per la tabella agenti. La chiave di accesso BPRNUM_0 da passare
// dipende dai contesti, nel caso di listini e provvigioni è sempre il codice
// cliente.
//
if NomeTabellaDaRegole = 'BPARTNER' then
begin
SetLength(NomiCampoRicerca, 1);
NomiCampoRicerca[0] := 'BPRNUM_0';
SetLength(ValoriCampoRicerca, 1);
ValoriCampoRicerca[0] := CodCli;
end
else if NomeTabellaDaRegole = 'BPCUSTOMER' then
begin
SetLength(NomiCampoRicerca, 1);
NomiCampoRicerca[0] := 'BPCNUM_0';
SetLength(ValoriCampoRicerca, 1);
ValoriCampoRicerca[0] := CodCli;
end
else if NomeTabellaDaRegole = 'ITMMASTER' then
begin
SetLength(NomiCampoRicerca, 1);
NomiCampoRicerca[0] := 'ITMREF_0';
SetLength(ValoriCampoRicerca, 1);
ValoriCampoRicerca[0] := CodArt;
end
else
begin
NomiCampoRicerca := nil;
ValoriCampoRicerca := nil;
end;

if NomiCampoRicerca nil then
begin
if TrovaValoreChiave(Query, NomeTabellaDaRegole, NomeCampoDaRegole,
NomiCampoRicerca, ValoriCampoRicerca, ValoriChiave) 0);

DebugForm.PrintLn('>>>> ApplicaRegola: end: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
end;

procedure ApplicaRegolePrzList(RegoleQuery, Query: TOraQuery; CodArt: String;
SpricLinkMemTable: TkbmMemTable; IndiceRicorsione: Integer; var PrzList: TPrzList);
var
CodDiv: String;
SqlStr: String;
ValorizzaPrzBase, ValorizzaMolt: Boolean;
Causale: Integer;
RecuperaMoltInSecondaPassata: Boolean;
begin
DebugForm.PrintLn('>>>> ApplicaRegolePrzList: start: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));

try
//CodDiv := SpricLinkMemTable.FieldByName('ZCODDIV_0').Value;
CodDiv := '';

SqlStr :=
' SELECT '
+ ' PLI_0, '
+ ' FIL_0, FIL_1, FIL_2, FIL_3, FIL_4, '
+ ' FLD_0, FLD_1, FLD_2, FLD_3, FLD_4, '
+ ' CRIIND_0, CRIIND_1, CRIIND_2, CRIIND_3, CRIIND_4, '
+ ' PRIREN_0 '
+ ' FROM '
+ ' M_COR_SPRICCONF '
+ ' WHERE '
+ ' COMPRO_0 = 2 '
+ ' AND PLI_0 LIKE ''' + IntToStr(IndiceRicorsione) + CodDiv + '%'''
+ ' ORDER BY PIO_0 ';

ValorizzaPrzBase := False;
ValorizzaMolt := False;
RecuperaMoltInSecondaPassata := False;

DebugForm.PrintLn('>>>> ApplicaRegolePrzList: 1: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
InitQuery(RegoleQuery, SqlStr);
DebugForm.PrintLn('>>>> ApplicaRegolePrzList: 2: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
RegoleQuery.Open;
DebugForm.PrintLn('>>>> ApplicaRegolePrzList: 3: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));

// Iterazione record set delle regole da applicare
while not RegoleQuery.Eof do
begin
DebugForm.PrintLn('>>>> ApplicaRegolePrzList: 4: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
if IndiceRicorsione = 1 then
begin
Causale := RegoleQuery.FieldByName('PRIREN_0').AsInteger;
if Causale = 1 then
begin
ValorizzaPrzBase := True;
ValorizzaMolt := False;
RecuperaMoltInSecondaPassata := True;
end
else if Causale = 3 then
begin
ValorizzaPrzBase := True;
ValorizzaMolt := True;
RecuperaMoltInSecondaPassata := False;
end;
end
else if IndiceRicorsione = 2 then
begin
ValorizzaPrzBase := False;
ValorizzaMolt := True;
RecuperaMoltInSecondaPassata := False;
end;

DebugForm.PrintLn('>>>> ApplicaRegolePrzList: 5: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
if ApplicaRegola(RegoleQuery, Query, CodArt, SpricLinkMemTable, ValorizzaPrzBase,
ValorizzaMolt, PrzList) then Break;
DebugForm.PrintLn('>>>> ApplicaRegolePrzList: 6: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
RegoleQuery.Next;
end;

RegoleQuery.Close;

if RecuperaMoltInSecondaPassata then ApplicaRegolePrzList(RegoleQuery, Query, CodArt,
SpricLinkMemTable, 2, PrzList);

except
on E: Exception do
begin
GestisciEccez(E);
Exit;
end;
end;

DebugForm.PrintLn('>>>> ApplicaRegolePrzList: end: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
end;

procedure DeterminaPrzList(CodArt: String; var PrzList: TPrzList);
begin
DebugForm.PrintLn('>>>> DeterminaPrzList: start: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));

with OrdDataModule do
begin
DefaultaPrzList(PrzList);
ApplicaRegolePrzList(RegoleQueryPerList, QueryPerList, CodArt, SpricLinkMemTablePerList,
1, PrzList);

PrzList.Prz := PrzList.ZprBase;

if PrzList.ZMult1 0 then PrzList.Prz := PrzList.Prz * (1 - PrzList.ZMult1 / 100.0);
if PrzList.ZMult2 0 then PrzList.Prz := PrzList.Prz * (1 + PrzList.ZMult2 / 100.0);
if PrzList.ZMult3 0 then PrzList.Prz := PrzList.Prz * (1 - PrzList.ZMult3 / 100.0);
if PrzList.ZMult4 0 then PrzList.Prz := PrzList.Prz * (1 + PrzList.ZMult4 / 100.0);

PrzList.Prz := Arrotonda(PrzList.Prz, 2);
end;

DebugForm.PrintLn('>>>> DeterminaPrzList: end: ' + CodArt + ': ' + FormatDateTime('hh:nn:ss.zzz', Now()));
end;

end.

Posted: Tue 12 Oct 2010 09:44
by AlexP
Hello,

To prevent misprints from my side when copying your code, please send the complete project so that I could reproduce the problem to alexp*devart*com.