Po hlavnich upravach sdileni sponeni a uvolnovani connection poolu

This commit is contained in:
2026-04-13 12:20:09 +02:00
parent a62b608cfd
commit 1258a27a4e
16 changed files with 2006 additions and 1324 deletions

View File

@ -9,7 +9,7 @@ uses
Data.DB, FireDAC.Comp.Client, FireDAC.Comp.UI, FireDAC.Phys.MSSQLDef,
FireDAC.Phys.ODBCBase, FireDAC.Phys.MSSQL, FireDAC.Stan.Param, FireDAC.DatS,
FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Comp.DataSet, FireDAC.Stan.Consts,
Winapi.ActiveX,
Winapi.ActiveX, System.RegularExpressions,
MVCFramework.Logger,
Quick.Logger, Quick.Threads, Quick.Logger.Provider.Files;
@ -44,6 +44,7 @@ type
function SQLRecordExists (sqlText: string): Boolean;
function SQLColumnExists (const tabName: string; const colName: string): Boolean;
function SQLIDsToString (const tabName: string=''; where: string=''): string;
function SQLIsSafe (const S: string): boolean;
function SQLGetString (sqlCmd: string=''; sqlConnLoc: TFDConnection=nil): string;
function StreamToString (const M: TStream): string;
@ -57,6 +58,8 @@ type
var
datMod: TdatMod;
ConnDef: IFDStanConnectionDef;
ConnInit: Boolean = false;
ConnInitLock: TObject;
implementation
@ -91,7 +94,7 @@ uses System.StrUtils, Data.Win.ADODB,
procedure TdatMod.DataModuleDestroy(Sender: TObject);
procedure TdatMod.DataModuleDestroy (Sender: TObject);
begin
if (sqlConnParams<>nil) then
sqlConnParams.Free;
@ -156,90 +159,13 @@ uses System.StrUtils, Data.Win.ADODB,
dbConnOleDB:= false;
{
drvList:= TStringList.Create;
try
GetProviderNames(drvList);
{$IFDEF DEBUG}
{
if (drvList.Count>0) then
begin
Writeln(CRLF+'Registrovane drivery:');
for idx:=0 to drvList.Count-1 do
Writeln(drvList.Strings[idx]);
end;
Writeln('');
{$ENDIF}
{
if (drvList.IndexOf('MSOLEDBSQL') >= 0) then
mamOleDb:= true;
if (drvList.IndexOf('MSOLEDBSQL19') >= 0) then
dbEncConn:= true;
if not(mamOleDb) or (odbc) then
begin
mamOleDb:= false;
idx:= -1;
if (drvList.Find('ODBC Driver 17', idx)) then
drvName2:= drvList.Strings[idx];
if (drvList.Find('ODBC Driver 18', idx)) then
begin
drvName2:= drvList.Strings[idx];
dbEncConn:= true;
end;
if (drvList.Find('ODBC Driver 19', idx)) then
begin
drvName2:= drvList.Strings[idx];
dbEncConn:= true;
end;
end;
sqlMSSQLDrv.ODBCDriver:= drvName2;
if (drvName.Contains('ODBC')) then
drvName:= 'ODBC';
// sqlMSSQLDrv.DriverID:= drvName;
dbConnOleDB:= mamOleDb;
{$IFDEF DEBUG}
{ Writeln('Vybrany driver: ' + sqlMSSQLDrv.ODBCDriver);
{$ENDIF}
{
finally
drvList.Free;
end;
}
if not(sqlConn.Connected) and (dbServer<>'') and (dbName<>'') then
begin
try
sqlConnParams:= TStringList.Create;
sqlConnParams.Clear;
oPars:= TStringList.Create;
try
// sqlConn.Params.Clear;
// sqlConn.DriverName:= drvName;
// sqlConn.Params.Add(S_FD_ConnParam_Common_DriverID + '=' + drvName);
sqlConnParams.Add(S_FD_ConnParam_Common_DriverID + '=MSSQL');
sqlConnParams.Add(S_FD_ConnParam_Common_Server + '=' + dbServer);
sqlConnParams.Add(S_FD_ConnParam_Common_Port + '=' + dbPort.ToString);
sqlConnParams.Add(S_FD_ConnParam_Common_Database + '=' + dbName);
sqlConnParams.Add(S_FD_ConnParam_Common_UserName + '=' + dbUser);
sqlConnParams.Add(S_FD_ConnParam_Common_Password + '=' + dbPwd);
sqlConnParams.Add(S_FD_ConnParam_Common_OSAuthent + '=No');
sqlConnParams.Add(S_FD_ConnParam_Common_MetaDefSchema + '=dbo');
sqlConnParams.Add(S_FD_ConnParam_Common_LoginTimeout + '=15');
sqlConnParams.Add(S_FD_ConnParam_MSSQL_MARS + '=Yes');
// sqlConnParams.Add(S_FD_ConnParam_Common_Pooled + '=True');
// sqlConnParams.Add(S_FD_ConnParam_Common_Pool_MaximumItems + '=100');
sqlConnParams.Add(S_FD_ConnParam_Common_ExtendedMetadata + '=True');
sqlConnParams.Add(S_FD_ConnParam_Common_ApplicationName + '=hdcdzAPIsvc2');
sqlConnParams.Add(S_FD_ConnParam_ODBC_ODBCAdvanced + '=TrustServerCertificate=yes');
oPars.Add(S_FD_ConnParam_Common_DriverID + '=MSSQL');
// oPars.Add(S_FD_ConnParam_Common_DriverID + '=MSSQL'); // je definovan v AddConnectionDef
oPars.Add(S_FD_ConnParam_Common_Server + '=' + dbServer);
oPars.Add(S_FD_ConnParam_Common_Port + '=' + dbPort.ToString);
oPars.Add(S_FD_ConnParam_Common_Database + '=' + dbName);
@ -249,42 +175,58 @@ uses System.StrUtils, Data.Win.ADODB,
oPars.Add(S_FD_ConnParam_Common_MetaDefSchema + '=dbo');
oPars.Add(S_FD_ConnParam_Common_LoginTimeout + '=15');
oPars.Add(S_FD_ConnParam_MSSQL_MARS + '=Yes');
oPars.Add(S_FD_ConnParam_Common_ExtendedMetadata + '=True');
oPars.Add(S_FD_ConnParam_Common_ExtendedMetadata + '=False'); // True jen pri pouziti AutoGenerate SQL / CachedUpdates / UpdateObject
oPars.Add(S_FD_ConnParam_Common_ApplicationName + '=hdcdzAPIsvc');
oPars.Add(S_FD_ConnParam_Common_Pooled + '=True');
oPars.Add(S_FD_ConnParam_Common_Pool_MaximumItems + '=100');
oPars.Add(S_FD_ConnParam_Common_Pool_MaximumItems + '=300');
oPars.Add(S_FD_ConnParam_Common_Pool_ExpireTimeout + '=30000'); // FireDAC v intervalu 30 sekund testuje platnost spojeni, jestli to SQL server neukoncil
oPars.Add(S_FD_ConnParam_Common_Pool_CleanupTimeout + '=90000'); // FireDAC v intervalu 90 sekund cisti nepouzivana spojeni
oPars.Add(S_FD_ConnParam_ODBC_ODBCAdvanced + '=TrustServerCertificate=yes');
// oPars.Add('CommandTimeout=120');
if (dbEncConn) then
oPars.Add(S_FD_ConnParam_MSSQL_Encrypt + '=Yes');
if (FDManager.FindConnection(sqlPoolName)=nil) then
if not(ConnInit) then
begin
FDManager.AddConnectionDef (sqlPoolName, 'MSSQL', oPars, true);
if (FDManager.State<>dmsInactive) then
Sleep(0);
TMonitor.Enter(ConnInitLock);
try
if not(ConnInit) then
begin
if (FDManager.ConnectionDefs.FindConnectionDef(sqlPoolName) = nil) then
FDManager.AddConnectionDef(sqlPoolName, 'MSSQL', oPars);
if (FDManager.State = dmsInactive) then
FDManager.Open;
ConnInit := True;
end;
finally
TMonitor.Exit (ConnInitLock);
end;
end;
FDManager.Open;
// sqlConn.Params.SetStrings(oPars);
sqlConn.ConnectionDefName:= sqlPoolName;
sqlQry1.ConnectionName:= sqlConn.ConnectionDefName;
sqlQry2.ConnectionName:= sqlConn.ConnectionDefName;
sqlQry3.ConnectionName:= sqlConn.ConnectionDefName;
sqlQry10.ConnectionName:= sqlConn.ConnectionDefName;
sqlQry11.ConnectionName:= sqlConn.ConnectionDefName;
sqlQry1.Connection:= sqlConn;
sqlQry2.Connection:= sqlConn;
sqlQry3.Connection:= sqlConn;
sqlQry10.Connection:= sqlConn;
sqlQry11.Connection:= sqlConn;
// if (dbConnOleDB) then
// sqlMSSQLDrv.ODBCDriver:= '';
connStr:= '';
if (dbEncConn) then
begin
if (dbConnOleDB) then
connStr:= 'Encrypt=True;TrustServerCertificate=True;UseEncryptionForData=True'
connStr:= ';Encrypt=True;TrustServerCertificate=True;UseEncryptionForData=True'
else
connStr:= 'Encrypt=yes;TrustServerCertificate=yes;Encrypt=yes';
connStr:= ';Encrypt=yes;TrustServerCertificate=yes;Encrypt=yes';
// sqlConn.Params.Add(S_FD_ConnParam_ODBC_ODBCAdvanced + '=' + connStr);
end;
connStr:= FDManager.ConnectionDefs.ConnectionDefByName(sqlPoolName).Params.Text + connStr;
connStr:= sqlConn.Params.DelimitedText;
sqlConn.Open;
sqlConn.ExecSQL('SET LOCK_TIMEOUT 60000'); // čekej max 60 sekund na lock, ne nekonecne jako je default (-1)
except on E:Exception do
begin
result:= E.Message;
@ -294,8 +236,8 @@ uses System.StrUtils, Data.Win.ADODB,
end;
end; // try
finally
if (oPars<>nil) then
oPars.Free;
// sqlConnParams.Free;
oPars.Free;
end; // try
end;
end;
@ -458,19 +400,37 @@ uses System.StrUtils, Data.Win.ADODB,
function TdatMod.SQLIsSafe (const S: string): boolean;
var UpperS: string;
begin
result:= TRegEx.IsMatch (S, '^[A-Za-z0-9_ \(\)=<>!\.,]+$', [roIgnoreCase]);
if not result then
Exit;
UpperS := UpperCase(S);
// zakázaná klíčová slova
if TRegEx.IsMatch(UpperS, '\b(SELECT|INSERT|UPDATE|DELETE|DROP|EXEC|UNION)\b') then
Exit (False);
result := True;
end;
function TdatMod.SQLIDsToString (const tabName: string = ''; where: string = ''): string;
var lSQL, s, t: string;
c: boolean;
lQry: TFDQuery;
sqlConnX: TFDConnection;
begin
result:= '';
result := '';
try
if (self.sqlConn.Connected) then
begin
s:= '';
t:= tabName;
s := '';
t := tabName;
if not(t.Contains('dbo.')) and not(t.Contains('dbo].')) then
t:= '[' + t;
if not(t.EndsWith(']')) then
@ -479,8 +439,8 @@ uses System.StrUtils, Data.Win.ADODB,
t:= '[dbo].' + t;
sqlConnX:= TFDConnection.Create(nil);
sqlConnX.ConnectionDefName:= sqlPoolName;
sqlConnX := TFDConnection.Create(nil);
sqlConnX.ConnectionDefName := sqlPoolName;
try
sqlConnX.Open;
finally
@ -491,15 +451,23 @@ uses System.StrUtils, Data.Win.ADODB,
begin
lQry:= TFDQuery.Create(nil);
try
lQry.Connection:= sqlConnX;
result := '';
lQry.Connection := sqlConnX;
where:= where.Replace(';', '').Replace('--', '').Trim; // sanitace podminky
lSQL:= 'SELECT STRING_AGG(ID,'','') AS IDs FROM ' + t + IfThen(where<>'', ' WHERE ' + where, '');
try
lQry.Open(lSQL);
result:= lQry.FieldByName('IDs').AsString;
except on E:Exception do
result:= '';
end;
if not(SQLIsSafe(where)) then
lSQL:= '';
if (lSQL<>'') then
begin
try
lQry.Open (lSQL);
result := lQry.FieldByName('IDs').AsString;
except on E:Exception do
result := '';
end;
end;
finally
lQry.Free;
end;
@ -608,10 +576,12 @@ uses System.StrUtils, Data.Win.ADODB,
initialization
ConnInitLock := TObject.Create;
// CoInitialize(nil);
finalization
ConnInitLock.Free;
// CoUninitialize;
end.