588 lines
15 KiB
ObjectPascal
588 lines
15 KiB
ObjectPascal
unit uDataMod;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option,
|
|
FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
|
|
FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.VCLUI.Wait,
|
|
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, System.RegularExpressions,
|
|
MVCFramework.Logger,
|
|
Quick.Logger, Quick.Threads, Quick.Logger.Provider.Files;
|
|
|
|
|
|
const
|
|
{$I globalConsts.inc}
|
|
|
|
type
|
|
TdatMod = class(TDataModule)
|
|
sqlConn: TFDConnection;
|
|
sqlWaitCur: TFDGUIxWaitCursor;
|
|
sqlMSSQLDrv: TFDPhysMSSQLDriverLink;
|
|
sqlQry1: TFDQuery;
|
|
sqlQry2: TFDQuery;
|
|
sqlQry3: TFDQuery;
|
|
sqlQry10: TFDQuery;
|
|
sqlQry11: TFDQuery;
|
|
qryZpracPrijataData: TFDQuery;
|
|
procedure DataModuleDestroy(Sender: TObject);
|
|
private
|
|
constructor Create (AOwner: TComponent); override;
|
|
function InterniConnectDB (odbc:Boolean=false; pool:Boolean=true): string;
|
|
public
|
|
dbName, dbServer, dbUser, dbPwd, cfgComp: string;
|
|
dbPort: integer;
|
|
dbEncConn, dbConnOleDB, chL: boolean;
|
|
sqlConnParams: TStringList;
|
|
Logger: TLogFileProvider;
|
|
function ConnectServer: boolean;
|
|
function ErrorStatusJsonText (const errText: string): string;
|
|
function SQLTableExists (const tabName: string): Boolean;
|
|
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;
|
|
function MemoryStreamToString (const M: TMemoryStream): string;
|
|
function MemoryStreamToAnsiString (const M: TMemoryStream): AnsiString;
|
|
|
|
procedure CreateLogger (fileName: string='');
|
|
procedure LogInfo (eTyp: Quick.Logger.TEventType; const msg: string);
|
|
end;
|
|
|
|
var
|
|
datMod: TdatMod;
|
|
ConnDef: IFDStanConnectionDef;
|
|
ConnInit: Boolean = false;
|
|
ConnInitLock: TObject;
|
|
|
|
|
|
implementation
|
|
{%CLASSGROUP 'Vcl.Controls.TControl'}
|
|
{$R *.dfm}
|
|
uses System.StrUtils, Data.Win.ADODB,
|
|
System.JSON.Builders, System.JSON.Writers, System.JSON.Types, JsonDataObjects,
|
|
uWinService;
|
|
|
|
|
|
|
|
|
|
constructor TdatMod.Create (AOwner: TComponent);
|
|
begin
|
|
inherited Create (AOwner);
|
|
CreateLogger;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TdatMod.CreateLogger (fileName: string='');
|
|
begin
|
|
if (fileName='') then
|
|
fileName:= 'hdcDZApi.log';
|
|
Logger:= TLogFileProvider.Create;
|
|
Logger.AutoFlush:= true;
|
|
Logger.FileName:= ExtractFilePath(ParamStr(0)) + fileName;
|
|
Logger.Init;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TdatMod.DataModuleDestroy (Sender: TObject);
|
|
begin
|
|
if (sqlConnParams<>nil) then
|
|
sqlConnParams.Free;
|
|
end;
|
|
|
|
|
|
|
|
function TdatMod.StreamToString (const M: TStream): string;
|
|
var s: TStringStream;
|
|
begin
|
|
result:= '';
|
|
if (M<>nil) then
|
|
begin
|
|
s:= TStringStream.Create;
|
|
try
|
|
s.CopyFrom (M, 0);
|
|
result:= s.DataString;
|
|
finally
|
|
s.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TdatMod.MemoryStreamToString (const M: TMemoryStream): string;
|
|
begin
|
|
SetString(Result, PWideChar(M.Memory), M.Size div SizeOf(Char));
|
|
end;
|
|
|
|
|
|
|
|
function TdatMod.MemoryStreamToAnsiString (const M: TMemoryStream): AnsiString;
|
|
begin
|
|
SetString (Result, PAnsiChar(M.Memory), M.Size);
|
|
end;
|
|
|
|
|
|
|
|
procedure TdatMod.LogInfo (eTyp: Quick.Logger.TEventType; const msg: string);
|
|
begin
|
|
logItem.EventType:= eTyp;
|
|
logItem.EventDate:= now;
|
|
logItem.Msg:= msg;
|
|
Logger.WriteLog(logItem);
|
|
end;
|
|
|
|
|
|
|
|
function TdatMod.InterniConnectDB (odbc: Boolean = False; pool: Boolean = True): string;
|
|
var drvList: TStringList;
|
|
errMsg, connStr, drvName, drvName2: string;
|
|
mamOdbc, mamOleDb: Boolean;
|
|
idx: integer;
|
|
maxNum: byte;
|
|
oPars: TStrings; // TFDPhysMSSQLConnectionDefParams;
|
|
begin
|
|
result:= '';
|
|
mamOdbc:= false;
|
|
mamOleDb:= false;
|
|
drvName:= 'MSSQL';
|
|
drvName2:= 'SQL Server';
|
|
|
|
dbConnOleDB:= false;
|
|
|
|
|
|
if not(sqlConn.Connected) and (dbServer<>'') and (dbName<>'') then
|
|
begin
|
|
try
|
|
oPars:= TStringList.Create;
|
|
try
|
|
// 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);
|
|
oPars.Add(S_FD_ConnParam_Common_UserName + '=' + dbUser);
|
|
oPars.Add(S_FD_ConnParam_Common_Password + '=' + dbPwd);
|
|
oPars.Add(S_FD_ConnParam_Common_OSAuthent + '=No');
|
|
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 + '=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 + '=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 not(ConnInit) then
|
|
begin
|
|
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;
|
|
|
|
// sqlConn.Params.SetStrings(oPars);
|
|
sqlConn.ConnectionDefName:= sqlPoolName;
|
|
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'
|
|
else
|
|
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;
|
|
|
|
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;
|
|
{$IFDEF DEBUG}
|
|
Writeln('Chyba spojeni - ' + E.ClassName, ': ', result);
|
|
{$ENDIF}
|
|
end;
|
|
end; // try
|
|
finally
|
|
// sqlConnParams.Free;
|
|
oPars.Free;
|
|
end; // try
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TdatMod.ConnectServer: Boolean;
|
|
var drvList: TStringList;
|
|
errMsg, connStr, drvName, drvName2: string;
|
|
mamOdbc, mamOleDb: Boolean;
|
|
idx: integer;
|
|
maxNum: byte;
|
|
begin
|
|
try
|
|
errMsg:= InterniConnectDB (false);
|
|
if (errMsg.Contains('ogin failed for us')) or (errMsg.Contains('ogin failed')) then
|
|
errMsg:= InterniConnectDB (true);
|
|
|
|
if (errMsg<>'') then
|
|
LogInfo (etWarning, 'Chyba spojeni: ' + errMsg);
|
|
except on E:Exception do
|
|
errMsg:= E.Message;
|
|
end;
|
|
|
|
result:= (errMsg='');
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
function TdatMod.ErrorStatusJsonText (const errText: string): string;
|
|
var b: TJSONObjectBuilder;
|
|
w: TJsonTextWriter;
|
|
sB: TStringBuilder;
|
|
sW: TStringWriter;
|
|
p: TJSONCollectionBuilder.TPairs;
|
|
o: TJSONObject;
|
|
begin
|
|
o:= TJSONObject.Create;
|
|
sB:= TStringBuilder.Create;
|
|
sW:= TStringWriter.Create(sB);
|
|
w:= TJsonTextWriter.Create(sW);
|
|
w.Formatting:= TJsonFormatting.Indented;
|
|
b:= TJSONObjectBuilder.Create(w);
|
|
// b.BeginObject.BeginArray('status').BeginObject.Add('status', status).EndObject.EndArray.EndObject;
|
|
p:= b.BeginObject.Add('status', errText);
|
|
p.EndObject;
|
|
|
|
o.FromJSON(sB.ToString);
|
|
result:= o.ToString;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TdatMod.SQLTableExists (const tabName: string): Boolean;
|
|
var lSQL, s, t: string;
|
|
lQry: TFDQuery;
|
|
sqlConnX: TFDConnection;
|
|
c: boolean;
|
|
begin
|
|
result:= false;
|
|
|
|
sqlConnX:= TFDConnection.Create(nil);
|
|
sqlConnX.ConnectionDefName:= sqlPoolName;
|
|
// sqlConnX.DriverName:= 'MSSQL';
|
|
try
|
|
sqlConnX.Open;
|
|
finally
|
|
end;
|
|
c:= sqlConnX.Connected;
|
|
|
|
if (c) then
|
|
begin
|
|
s:= '';
|
|
t:= tabName.Replace('[', '', [rfReplaceAll]).Replace(']', '', [rfReplaceAll]);
|
|
if (t.ToLower.Contains('dbo.')) then
|
|
begin
|
|
s:= 'dbo';
|
|
t:= t.Replace('dbo.', '', [rfIgnoreCase]);
|
|
end;
|
|
lSQL:= 'SELECT 1 AS A FROM INFORMATION_SCHEMA.COLUMNS c WHERE c.TABLE_NAME=N' + t.QuotedString + IfThen(s<>'', ' AND c.TABLE_SCHEMA=N' + s.QuotedString, '');
|
|
lQry:= TFDQuery.Create(nil);
|
|
try
|
|
lQry.Connection:= sqlConnX;
|
|
try
|
|
lQry.Open(lSQL);
|
|
result:= (lQry.RecordCount>0);
|
|
// Log.Info('SQLTableExists OK', 'uDataMod');
|
|
except on E:Exception do
|
|
begin
|
|
Log.Warn('Chyba SQLTableExists: ' + E.Message + CRLF + lSQL, 'uDataMod');
|
|
result:= false;
|
|
end;
|
|
end;
|
|
finally
|
|
lQry.Free;
|
|
end;
|
|
end;
|
|
|
|
sqlConnX.Close;
|
|
sqlConnX.Free;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
function TdatMod.SQLRecordExists (sqlText: string): boolean;
|
|
var lSQL, s, t: string;
|
|
lQry: TFDQuery;
|
|
sqlConnX: TFDConnection;
|
|
c: boolean;
|
|
begin
|
|
result:= false;
|
|
|
|
sqlConnX:= TFDConnection.Create(nil);
|
|
sqlConnX.Params:= sqlConn.Params;
|
|
try
|
|
sqlConnX.Open;
|
|
finally
|
|
end;
|
|
c:= sqlConnX.Connected;
|
|
|
|
sqlText:= sqlText.Replace(';', '').Replace('--', '');
|
|
|
|
if (c) and (sqlText<>'') then
|
|
begin
|
|
lQry:= TFDQuery.Create(nil);
|
|
if (sqlConnX<>nil) then
|
|
lQry.Connection:= sqlConnX
|
|
else
|
|
lQry.Connection:= sqlConn;
|
|
try
|
|
try
|
|
lQry.Open(sqlText);
|
|
result:= (lQry.RecordCount>0);
|
|
except on E:Exception do
|
|
begin
|
|
Log.Warn('Chyba SQLRecordExists: ' + E.Message + CRLF + lSQL, 'uDataMod');
|
|
result:= false;
|
|
end;
|
|
end;
|
|
finally
|
|
lQry.Free;
|
|
end;
|
|
end;
|
|
|
|
if (sqlConnX<>nil) then
|
|
begin
|
|
sqlConnX.Close;
|
|
sqlConnX.Free;
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
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 := '';
|
|
|
|
try
|
|
if (self.sqlConn.Connected) then
|
|
begin
|
|
s := '';
|
|
t := tabName;
|
|
if not(t.Contains('dbo.')) and not(t.Contains('dbo].')) then
|
|
t:= '[' + t;
|
|
if not(t.EndsWith(']')) then
|
|
t:= t + ']';
|
|
if not(t.Contains('dbo.')) and not(t.Contains('dbo].')) then
|
|
t:= '[dbo].' + t;
|
|
|
|
|
|
sqlConnX := TFDConnection.Create(nil);
|
|
sqlConnX.ConnectionDefName := sqlPoolName;
|
|
try
|
|
sqlConnX.Open;
|
|
finally
|
|
end;
|
|
c:= sqlConnX.Connected;
|
|
|
|
if (c) then
|
|
begin
|
|
lQry:= TFDQuery.Create(nil);
|
|
try
|
|
result := '';
|
|
lQry.Connection := sqlConnX;
|
|
where:= where.Replace(';', '').Replace('--', '').Trim; // sanitace podminky
|
|
lSQL:= 'SELECT STRING_AGG(ID,'','') AS IDs FROM ' + t + IfThen(where<>'', ' WHERE ' + where, '');
|
|
|
|
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;
|
|
|
|
sqlConnX.Close;
|
|
end;
|
|
|
|
sqlConnX.Free;
|
|
end;
|
|
except on E:Exception do
|
|
LogInfo (Quick.Logger.etInfo, 'In SQLIDsToString error: ' + E.Message);
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TdatMod.SQLColumnExists (const tabName: string; const colName: string): Boolean;
|
|
var lSQL, s, t: string;
|
|
lQry: TFDQuery;
|
|
c: boolean;
|
|
sqlConnX: TFDConnection;
|
|
begin
|
|
result:= false;
|
|
|
|
sqlConnX:= TFDConnection.Create(nil);
|
|
sqlConnX.ConnectionDefName:= sqlPoolName;
|
|
c:= sqlConnX.Connected;
|
|
|
|
if (c) then
|
|
begin
|
|
s:= '';
|
|
t:= tabName.Replace('[', '', [rfReplaceAll]).Replace(']', '', [rfReplaceAll]);
|
|
if (t.ToLower.Contains('dbo.')) then
|
|
begin
|
|
s:= 'dbo';
|
|
t:= t.Replace('dbo.', '', [rfIgnoreCase]);
|
|
end;
|
|
|
|
lQry:= TFDQuery.Create(nil);
|
|
try
|
|
lQry.Connection:= sqlConnX;
|
|
lSQL:= 'SELECT 1 AS A FROM INFORMATION_SCHEMA.COLUMNS c WHERE c.TABLE_NAME=N' + t.QuotedString + IfThen(s<>'', ' AND c.TABLE_SCHEMA=N' + s.QuotedString, '');
|
|
lSQL:= lSQL + ' AND c.COLUMN_NAME=N' + colName.QuotedString;
|
|
try
|
|
lQry.Open(lSQL);
|
|
result:= (lQry.RecordCount>0);
|
|
except on E:Exception do
|
|
begin
|
|
Log.Warn('Chyba SQLColumnExists: ' + E.Message + CRLF + lSQL, 'uDataMod');
|
|
result:= false;
|
|
end;
|
|
end;
|
|
finally
|
|
lQry.Free;
|
|
end;
|
|
sqlConnX.Close;
|
|
end;
|
|
|
|
sqlConnX.Free;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TdatMod.SQLGetString (sqlCmd: string=''; sqlConnLoc: TFDConnection=nil): string;
|
|
var lSQL, s, t: string;
|
|
lQry: TFDQuery;
|
|
c: boolean;
|
|
sqlConnX: TFDConnection;
|
|
begin
|
|
result:= '';
|
|
|
|
if (sqlConnLoc<>nil) then
|
|
sqlConnX:= sqlConnLoc
|
|
else
|
|
begin
|
|
sqlConnX:= TFDConnection.Create(nil);
|
|
sqlConnX.ConnectionDefName:= sqlPoolName;
|
|
end;
|
|
|
|
|
|
lQry:= TFDQuery.Create(nil);
|
|
try
|
|
lQry.Connection:= sqlConnX;
|
|
try
|
|
lQry.Open(sqlCmd);
|
|
result:= lQry.Fields.Fields[0].AsString;
|
|
except on E:Exception do
|
|
begin
|
|
Log.Warn('Chyba SQLGetString: ' + E.Message + CRLF + lSQL, 'uDataMod');
|
|
end;
|
|
end;
|
|
finally
|
|
lQry.Free;
|
|
end;
|
|
|
|
if (sqlConnLoc=nil) then
|
|
begin
|
|
sqlConnX.Close;
|
|
FreeAndNil (sqlConnX);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
initialization
|
|
ConnInitLock := TObject.Create;
|
|
// CoInitialize(nil);
|
|
|
|
|
|
finalization
|
|
ConnInitLock.Free;
|
|
// CoUninitialize;
|
|
|
|
end.
|