unit uSvc_Base; interface uses System.Generics.Collections, System.SysUtils, WinApi.ActiveX, JsonDataObjects, uCommons, uDataMod, uHeoObj_Base; const {$I globalConsts.inc} tblPrijataJsonData = '[dbo].[_hdc_ph_PrijataJsonData]'; type // Typ funkce pro kopírování jednoho objektu TCopyFunction = reference to function(const Source: T): T; TServiceBase = class abstract strict protected FDM: TdatMod; public constructor Create (AdmMain: TdatMod); virtual; destructor Destroy; virtual; function GetTabCols (schema: string='dbo'; tabName: string=''; tabAlias: string=''; vratPocitane: Boolean=true; exceptCols: string=''; limitColCount: Integer=0; inclVarbinMax: boolean=false): string; function GetTabColsArray (schema: string='dbo'; tabName: string = ''; tabAlias: string=''; vratPocitane: Boolean=true): TArray; function TabColsArrayRemove (inArray: TArray; const delColName: string): boolean; function GetTabExtCols (schema: string='dbo'; tabName: string=''; tabAlias: string=''; vratPocitane: Boolean=true): string; function sanitizeSQLString (s: string): string; procedure DeepCopyList(SourceList, DestList: TObjectList; CopyFunc: TCopyFunction); function SQLTableExists (schema: string=''; tabName: string=''): boolean; function SQLColumnExists (schema: string=''; tabName: string=''; colName: string=''): boolean; function SQLGeneralTest (sqlText: string): boolean; function NewUUID32: string; procedure Commit; procedure Rollback; procedure StartTransaction; end; TObecnyService = class(TServiceBase) public function DoTesty: TJSONObject; procedure ZapisJsonDoHeliosu (jsonData: string; var respString: string); procedure ImportTaskuDZ; virtual; end; var verText, verText2: string; verMoje: Int64; implementation uses System.StrUtils, System.Classes, System.RegularExpressions, FireDAC.Stan.Option, FireDAC.Comp.Client, FireDAC.Stan.Param, MVCFramework.FireDAC.Utils, MVCFramework.DataSet.Utils, MVCFramework.Serializer.Commons, FireDAC.Stan.Consts, System.JSON.Builders, System.JSON.Writers, System.JSON.Types, Winapi.Windows, helTabsBIDs; function GetFileVersion2 (sFileName:string): string; var VerInfoSize: DWORD; VerInfo: Pointer; VerValueSize: DWORD; VerValue: PVSFixedFileInfo; Dummy: DWORD; begin VerInfoSize := GetFileVersionInfoSize (PChar(sFileName), Dummy); GetMem(VerInfo, VerInfoSize); GetFileVersionInfo (PChar(sFileName), 0, VerInfoSize, VerInfo); VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize); with VerValue^ do begin Result := IntToStr(dwFileVersionMS shr 16); Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF); Result := Result + '.' + IntToStr(dwFileVersionLS shr 16); Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF); end; FreeMem(VerInfo, VerInfoSize); end; { TServiceBase } procedure TServiceBase.Commit; begin // FDM.sqlConn.Commit; end; destructor TServiceBase.Destroy; begin if (FDM<>nil) then FreeAndNil (FDM); inherited; end; constructor TServiceBase.Create (AdmMain: TdatMod); // var s: string; begin inherited Create; FDM:= AdmMain; { with FDM do try sqlConn.Params.Clear; sqlConn.Params.Add(S_FD_ConnParam_Common_DriverID + '=MSSQL'); sqlConn.Params.Add(S_FD_ConnParam_Common_Server + '=' + datMod.dbServer); sqlConn.Params.Add(S_FD_ConnParam_Common_Port + '=' + datMod.dbPort.ToString); sqlConn.Params.Add(S_FD_ConnParam_Common_Database + '=' + datMod.dbName); sqlConn.Params.Add(S_FD_ConnParam_Common_UserName + '=' + datMod.dbUser); sqlConn.Params.Add(S_FD_ConnParam_Common_Password + '=' + datMod.dbPwd); sqlConn.Params.Add(S_FD_ConnParam_Common_OSAuthent + '=No'); sqlConn.Params.Add(S_FD_ConnParam_Common_MetaDefSchema + '=dbo'); sqlConn.Params.Add(S_FD_ConnParam_Common_ApplicationName + '=hdcAPIsvc'); // sqlConn.Open; except on E:Exception do end; } // s:= FDM.sqlConn.Params.DelimitedText; end; function TServiceBase.NewUUID32: string; var GUID: TGUID; begin CoCreateGuid(GUID); SetLength(Result, 32); StrLFmt(PChar(Result), 32,'%.8x%.4x%.4x%.2x%.2x%.2x%.2x%.2x%.2x%.2x%.2x', [Guid.D1, Guid.D2, Guid.D3, Guid.D4[0], Guid.D4[1], Guid.D4[2], Guid.D4[3], Guid.D4[4], Guid.D4[5], Guid.D4[6], Guid.D4[7]]); end; procedure TServiceBase.DeepCopyList(SourceList, DestList: TObjectList; CopyFunc: TCopyFunction); var i: Integer; begin for i := 0 to SourceList.Count - 1 do begin // Pro každý objekt v seznamu zavoláme funkci, která vrátí jeho kopii DestList.Add(CopyFunc(SourceList[i])); end; end; function TServiceBase.sanitizeSQLString (s: string): string; begin result:= s.Replace(' ', '').Replace(';', '').Replace('--', '').Replace(' OR', '').Trim; end; function TServiceBase.SQLGeneralTest (sqlText: string): Boolean; var lSQL: string; lQry: TFDQuery; sqlConnX: TFDConnection; begin result:= false; sqlConnX:= TFDConnection.Create(nil); sqlConnX.ConnectionDefName:= sqlPoolName; lQry:= TFDQuery.Create(nil); try try lQry.Connection:= sqlConnX; lQry.Open(sqlText); if (lQry.RecordCount>0) then result:= true; except end; finally lQry.Free; end; sqlConnX.Close; sqlConnX.Free; end; function TServiceBase.SQLColumnExists (schema: string=''; tabName: string=''; colName: string=''): boolean; var lSQL: string; lQry: TFDQuery; sqlConnX: TFDConnection; begin result:= false; if (colName='') or (schema.Contains('.')) then begin colName:= tabName; tabName:= schema; schema:= ''; end; tabName:= tabName.Trim; if (ContainsText(tabName, '[dbo].')) then begin schema:= 'dbo'; tabName:= tabName.Replace('[dbo].', ''); end; if (ContainsText(tabName, 'dbo.')) then begin schema:= 'dbo'; tabName:= tabName.Replace('dbo.', ''); end; if (schema='') then schema:= 'dbo'; schema:= schema.Replace('[', '').Replace(']', ''); tabName:= tabName.Replace('[', '').Replace(']', ''); lSQL:= 'SELECT 1 FROM (SELECT 1 AS A) X WHERE COL_LENGTH(N' + (schema + '.' + tabName).QuotedString + ', N' + colName.QuotedString + ') IS NOT NULL'; sqlConnX:= TFDConnection.Create(nil); sqlConnX.ConnectionDefName:= sqlPoolName; lQry:= TFDQuery.Create(nil); try try lQry.Connection:= sqlConnX; lQry.Open(lSQL); if (lQry.RecordCount=1) then result:= true; except end; finally lQry.Free; end; sqlConnX.Close; sqlConnX.Free; end; function TServiceBase.SQLTableExists (schema: string=''; tabName: string=''): boolean; var lSQL: string; lQry: TFDQuery; sqlConnX: TFDConnection; begin result:= false; tabName:= tabName.Trim; if (ContainsText(tabName, '[dbo].')) then begin schema:= 'dbo'; tabName:= tabName.Replace('[dbo].', ''); end; if (ContainsText(tabName, 'dbo.')) then begin schema:= 'dbo'; tabName:= tabName.Replace('dbo.', ''); end; if (schema='') then schema:= 'dbo'; schema:= schema.Replace('[', '').Replace(']', ''); tabName:= tabName.Replace('[', '').Replace(']', ''); lSQL:= 'SELECT t.[name] FROM sys.tables t INNER JOIN sys.schemas s ON (s.schema_id=t.schema_id) WHERE s.name=N' + schema.QuotedString; lSQL:= lSQL + ' AND t.[name]=N' + tabName.QuotedString; sqlConnX:= TFDConnection.Create(nil); sqlConnX.ConnectionDefName:= sqlPoolName; lQry:= TFDQuery.Create(nil); try try lQry.Connection:= sqlConnX; lQry.Open(lSQL); if (lQry.RecordCount=1) then result:= true; except end; finally lQry.Free; end; sqlConnX.Close; sqlConnX.Free; end; function TServiceBase.TabColsArrayRemove (inArray: TArray; const delColName: string): boolean; var i: integer; begin result:= false; for i:=0 to Length(inArray) do if (inArray[i]=delColName) then begin Delete(inArray, i, 1); result:= true; Break; end; end; function TServiceBase.GetTabColsArray (schema: string='dbo'; tabName: string = ''; tabAlias: string=''; vratPocitane: Boolean=true): TArray; var lSQL, cols: string; lQry: TFDQuery; sqlConnX: TFDConnection; sqlVer: smallint; a: TArray; begin SetLength(a, 0); cols:= ''; tabName:= tabName.Trim; if (ContainsText(tabName, '[dbo].')) then begin schema:= 'dbo'; tabName:= tabName.Replace('[dbo].', ''); end; if (ContainsText(tabName, 'dbo.')) then begin schema:= 'dbo'; tabName:= tabName.Replace('dbo.', ''); end; if (schema='') then schema:= 'dbo'; schema:= schema.Replace('[', '').Replace(']', ''); tabName:= tabName.Replace('[', '').Replace(']', ''); if (SQLTableExists(schema, tabName)) then begin lSQL:= 'SELECT SERVERPROPERTY(''ProductMajorVersion'') AS SQLVer'; sqlConnX:= TFDConnection.Create(nil); sqlConnX.ConnectionDefName:= sqlPoolName; lQry:= TFDQuery.Create(nil); try try lQry.Connection:= sqlConnX; lQry.Open(lSQL); if (lQry.RecordCount>0) then begin sqlVer:= lQry.FieldByName('SQLVer').AsInteger; if (sqlVer<=13) then lSQL:= 'STUFF((SELECT ' + IfThen(tabAlias='', '', 'N''' + tabAlias + '.''') + ' + [name]+N'',''' else lSQL:= 'STRING_AGG(' + IfThen(tabAlias='', '', 'N''' + tabAlias + '.''') + ' + [name], N'','') AS Cols'; lSQL:= 'SELECT ' + lSQL + ' FROM sys.columns WHERE OBJECT_ID=OBJECT_ID(N' + QuotedStr(schema + '.' + tabname) + ', N''U'')'; if not(vratPocitane) then lSQL:= lSQL + ' AND is_computed=0'; if (sqlVer<=13) then lSQL:= lSQL + ' FOR XML PATH(''''),TYPE).value(''.'',''varchar(MAX)''),1,0,'''') AS Cols'; lQry.Open(lSQL); if (lQry.RecordCount>0) then begin cols:= lQry.FieldByName('Cols').AsString; if (RightStr(cols,1)=',') then cols:= LeftStr(cols, Length(cols)-1); end; a:= SplitString(cols, ','); end; except end; finally lQry.Free; end; sqlConnX.Close; sqlConnX.Free; end; result:= a; end; function TServiceBase.GetTabCols (schema: string='dbo'; tabName: string = ''; tabAlias: string=''; vratPocitane: Boolean=true; exceptCols: string=''; limitColCount: Integer=0; inclVarbinMax: boolean=false): string; var lSQL: string; lQry: TFDQuery; sqlConnX: TFDConnection; sqlVer: smallint; colExt: TStringList; i: Integer; begin result:= ''; tabName:= tabName.Trim; if (ContainsText(tabName, '[dbo].')) then begin schema:= 'dbo'; tabName:= tabName.Replace('[dbo].', ''); end; if (ContainsText(tabName, 'dbo.')) then begin schema:= 'dbo'; tabName:= tabName.Replace('dbo.', ''); end; if (schema='') then schema:= 'dbo'; schema:= schema.Replace('[', '').Replace(']', ''); tabName:= tabName.Replace('[', '').Replace(']', ''); exceptCols:= 'SystemRowVersionExt,' + exceptCols; if (RightStr(exceptCols,1)=',') then exceptCols:= LeftStr(exceptCols, Length(exceptCols)-1); if (SQLTableExists (schema, tabName)) then begin exceptCols:= exceptCols.Replace(' ',''); colExt:= TStringList.Create; if (exceptCols<>'') then begin while (exceptCols.Contains(',')) do begin colExt.Add(LeftStr(exceptCols, exceptCols.IndexOf(','))); exceptCols:= MidStr(exceptCols, exceptCols.IndexOf(',')+2, Length(exceptCols)); end; if not(exceptCols.Contains(',')) then colExt.Add(exceptCols); end; lSQL:= 'SELECT SERVERPROPERTY(''ProductMajorVersion'') AS SQLVer'; sqlConnX:= TFDConnection.Create(nil); sqlConnX.ConnectionDefName:= sqlPoolName; lQry:= TFDQuery.Create(nil); try lQry.Connection:= sqlConnX; try lQry.Open(lSQL); if (lQry.RecordCount>0) then begin sqlVer:= lQry.FieldByName('SQLVer').AsInteger; lSQL:= 'SELECT [name] FROM sys.columns WHERE OBJECT_ID=OBJECT_ID(N' + QuotedStr(schema + '.' + tabname) + ', N''U'')'; if not(inclVarbinMax) then lSQL:= lSQL + ' AND [system_type_id]<>165 AND [max_length]<>-1'; // varbinary(max) if (colExt.Count>0) then begin lSQL:= lSQL + ' AND [name] NOT IN ('; for i:=0 to (colExt.Count-1) do lSQL:= lSQL + 'N' + colExt.Strings[i].QuotedString + ','; lSQL:= LeftStr(lSQL, Length(lSQL)-1) + ')'; end; lQry.Open(lSQL); if (lQry.RecordCount>0) then begin lQry.First; if (limitColCount=0) then limitColCount:= 999; i:= 1; while not(lQry.Eof) and (limitColCount>=i) do begin result:= result + IfThen(tabAlias='', '', tabAlias + '.') + lQry.FieldByName('name').AsString + ','; Inc(i); lQry.Next; end; end; if (RightStr(result,1)=',') then result:= LeftStr(result, Length(result)-1); { if (sqlVer<=13) then lSQL:= 'STUFF((SELECT ' + IfThen(tabAlias='', '', 'N''' + tabAlias + '.''') + ' + [name]+N'',''' else lSQL:= 'STRING_AGG(' + IfThen(tabAlias='', '', 'N''' + tabAlias + '.''') + ' + [name], N'','') AS Cols'; lSQL:= 'SELECT ' + lSQL + ' FROM sys.columns WHERE OBJECT_ID=OBJECT_ID(N' + QuotedStr(schema + '.' + tabname) + ', N''U'')'; if not(vratPocitane) then lSQL:= lSQL + ' AND is_computed=0'; if (colExt.Count>0) then begin lSQL:= lSQL + ' AND [name] NOT IN ('; for i:=0 to (colExt.Count-1) do lSQL:= lSQL + 'N' + colExt.Strings[i].QuotedString + ','; lSQL:= LeftStr(lSQL, Length(lSQL)-1) + ')'; end; if (sqlVer<=13) then lSQL:= lSQL + ' FOR XML PATH(''''),TYPE).value(''.'',''varchar(MAX)''),1,0,'''') AS Cols'; lQry.Open(lSQL); if (lQry.RecordCount>0) then begin result:= lQry.FieldByName('Cols').AsString; if (RightStr(result,1)=',') then result:= LeftStr(result, Length(result)-1); end; } end; except end; finally lQry.Free; end; colExt.Free; sqlConnX.Close; sqlConnX.Free; end; if (result='') or (tabName='') then result:= '1 AS X'; end; function TServiceBase.GetTabExtCols (schema: string='dbo'; tabName: string = ''; tabAlias: string=''; vratPocitane: Boolean=true): string; var lSQL: string; lQry: TFDQuery; sqlConnX: TFDConnection; begin result:= ''; tabName:= tabName.Trim; if (ContainsText(tabName, '[dbo].')) then begin schema:= 'dbo'; tabName:= tabName.Replace('[dbo].', ''); end; if (ContainsText(tabName, 'dbo.')) then begin schema:= 'dbo'; tabName:= tabName.Replace('dbo.', ''); end; if (schema='') then schema:= 'dbo'; schema:= schema.Replace('[', '').Replace(']', ''); tabName:= tabName.Replace('[', '').Replace(']', ''); if (RightStr(tabName,4)<>'_EXT') then tabName:= tabName + '_EXT'; if (SQLTableExists(schema, tabName)) then begin lSQL:= 'SELECT STRING_AGG(' + IfThen(tabAlias='', '', 'N''' + tabAlias + '.''') + ' + [name], N'','') AS Cols FROM sys.columns WHERE OBJECT_ID=OBJECT_ID(N' + QuotedStr(schema + '.' + tabname) + ')'; if not(vratPocitane) then lSQL:= lSQL + ' AND is_computed=0'; sqlConnX:= TFDConnection.Create(nil); sqlConnX.ConnectionDefName:= sqlPoolName; lQry:= TFDQuery.Create(nil); try try lQry.Connection:= sqlConnX; lQry.Open(lSQL); if (lQry.RecordCount>0) then result:= lQry.FieldByName('Cols').AsString; except end; finally lQry.Free; end; sqlConnX.Close; sqlConnX.Free; end; if (result='') or (tabName='') then result:= '1 AS X'; end; procedure TServiceBase.Rollback; begin // FDM.sqlConn.Rollback; end; procedure TServiceBase.StartTransaction; begin // FDM.sqlConn.StartTransaction; end; { TObecnyService} procedure TObecnyService.ImportTaskuDZ; begin end; function TObecnyService.DoTesty: TJSONObject; var status, server, dbname, org: string; i: integer; b: TJSONObjectBuilder; w: TJsonTextWriter; sB: TStringBuilder; sW: TStringWriter; p: TJSONCollectionBuilder.TPairs; sqlConnX: TFDConnection; lQry: TFDQuery; begin result:= TJSONObject.Create; status:= 'NOT OK'; // kontrola verze pluginu verText:= GetFileVersion2 (GetModuleName(HInstance)); if Length(verText)=12 then verText:= LeftStr(verText,9) + '0' + RightStr(verText,3); verText2:= verText.Replace('.', ''); if (Length(verText2)=10) then verText2:= '0' + LeftStr(verText2,1) + '0' + RightStr(verText2, 9); verMoje:= verText2.ToInt64; dbname:= FDM.sqlConn.Params.Database; server:= ''; i:= FDM.sqlConn.Params.IndexOf(S_FD_ConnParam_Common_Server); if (i>-1) then server:= FDM.sqlConn.Params.Strings[i]; try try if not(FDM.sqlConn.Connected) then FDM.sqlConn.Open; status:= 'OK'; except end; finally end; org:= ''; sqlConnX:= TFDConnection.Create(nil); lQry:= TFDQuery.Create(nil); try try sqlConnX.ConnectionDefName:= sqlPoolName; lQry.Connection:= sqlConnX; lQry.Open('SELECT Nazev FROM ' + tblCOrg + ' WHERE CisloOrg=0'); org:= lQry.FieldByName('Nazev').AsString; except end; finally lQry.Free; end; sqlConnX.Close; sqlConnX.Free; 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', status); if (server<>'') then p.Add('server', server); p.Add('db', dbname); p.Add('ver', verMoje.ToString); p.Add('nazevOrg', org); p.EndObject; result.FromJSON(sB.ToString); // result.S['out']:= status; end; procedure TObecnyService.ZapisJsonDoHeliosu (jsonData: string; var respString: string); var lSQL, taskStr, strTmp, strTmp2, code, rs, guidIdent: string; guid: TGUID; objekt, akce: string; j, t, a, v: JsonDataObjects.TJSONObject; i, ii, taskDZId, taskId, intTemp, idJSON: integer; jeOld: boolean; lQry: TFDQuery; sqlConnX: TFDConnection; lSQL2, srcNazev, errMsg: string; rsrc: TResourceStream; ms: TMemoryStream; arrDefs: TStringList; function LoadStringFromStream (const AStream: TStream): String; var lenX: Integer; begin AStream.Seek(0,0); lenX:= AStream.Size - AStream.Position; SetLength(Result, lenX); if (lenX>0) then AStream.ReadBuffer(Result[1], lenX); end; function MemoryStreamToAnsiString (const M: TMemoryStream): AnsiString; begin SetString(Result, PAnsiChar(M.Memory), M.Size); end; begin idJSON:= 0; respString:= '['; jsonData:= jsonData.Trim; if (jsonData<>'') then begin lQry:= TFDQuery.Create(nil); try lQry.Connection:= FDM.sqlConn; try CoCreateGuid(guid); if (System.SysUtils.CreateGUID(guid)=S_OK) then guidIdent:= System.SysUtils.GUIDToString(guid) else guidIdent:= self.NewUUID32; lSQL:= 'INSERT ' + tblPrijataJsonData + ' (IdPHIdent, GUIDIdent, JSONData) SELECT 0, CONVERT(uniqueidentifier, N' + guidIdent.QuotedString + '), N' + jsonData.QuotedString; FDM.sqlConn.ExecSQL(lSQL); lSQL:= 'SELECT ID FROM ' + tblPrijataJsonData + ' WHERE GUIDIdent=CONVERT(uniqueidentifier, N' + guidIdent.QuotedString + ')'; lQry.Open(lSQL); if (lQry.RecordCount=1) then begin idJSON:= lQry.FieldByName('ID').AsInteger; respString:= 'OK'; end; except on E:Exception do begin respString:= 'NOT OK'; raise EServiceException.Create('Chyba zápisu JSON dat: ' + E.Message); end; end; finally FreeAndNil(lQry); end; j:= TJsonObject.Parse(jsonData) as JsonDataObjects.TJsonObject; try if (j<>nil) then begin if (j.Contains('akce')) then begin akce:= j.S['akce'].Trim; if (idJSON>0) and (akce<>'') then FDM.sqlConn.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET Akce=N' + akce.QuotedString + ' WHERE ID=' + idJSON.ToString); { for i:=0 to j['tasks'].Count-1 do begin try t:= j['tasks'].Items[i]; taskDZId:= t.I['id']; // j['tasks'].Items[i].I['id']; taskStr:= j['tasks'].Items[i].ObjectValue.ToString; except on E:Exception do end; end; } end; if (j.Contains('action')) then begin akce:= j.S['action'].Trim; if (idJSON>0) and (akce<>'') then FDM.sqlConn.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET Akce=N' + akce.QuotedString + ' WHERE ID=' + idJSON.ToString); end; if (j.Contains('object')) then begin objekt:= j.S['object'].Trim; if (idJSON>0) and (objekt<>'') then FDM.sqlConn.ExecSQL('UPDATE ' + tblPrijataJsonData + ' SET Objekt=N' + objekt.QuotedString + ' WHERE ID=' + idJSON.ToString); end; end; finally j.Free; end; end else respString:= 'NOT OK - nemám data'; respString:= '[' +respString + ']'; end; end.