Files
HDCApi/uDataMod.pas
2025-05-21 21:14:32 +02:00

618 lines
16 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,
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 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;
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;
{
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_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 + '=True');
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_ODBC_ODBCAdvanced + '=TrustServerCertificate=yes');
if (FDManager.FindConnection(sqlPoolName)=nil) then
begin
FDManager.AddConnectionDef (sqlPoolName, 'MSSQL', oPars, true);
if (FDManager.State<>dmsInactive) then
Sleep(0);
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;
// if (dbConnOleDB) then
// sqlMSSQLDrv.ODBCDriver:= '';
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:= sqlConn.Params.DelimitedText;
sqlConn.Open;
except on E:Exception do
begin
result:= E.Message;
{$IFDEF DEBUG}
Writeln('Chyba spojeni - ' + E.ClassName, ': ', result);
{$ENDIF}
end;
end; // try
finally
if (oPars<>nil) then
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.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
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;
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
// CoInitialize(nil);
finalization
// CoUninitialize;
end.