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.