program sdac;{$APPTYPE CONSOLE}{$R *.res}uses Horse, Horse.Jhonson, JOSE.Core.JWT, JOSE.Core.Builder, Horse.compression, // Horse.HandleException, Horse.OctetStream, JOSE.Context, System.JSON, System.SysUtils, System.StrUtils, System.NetEncoding, System.IOUtils, system.Threading, System.Classes, system.DateUtils, System.Variants, system.TypInfo, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Phys.ODBCDef, FireDAC.Phys.ODBCBase, FireDAC.Phys.ODBC, Data.DB, FireDAC.Comp.DataSet, FireDAC.Stan.StorageJSON, FireDAC.Stan.StorageBin, FireDAC.Moni.Base, FireDAC.Moni.FlatFile, FireDAC.Stan.StorageXML, FireDAC.Comp.Client, FireDAC.Phys.MSSQLDef, FireDAC.Phys.MSSQL, FireDAC.ConsoleUI.Wait, Firedac.ConsoleUI.Script, FireDAC.Stan.Intf, Web.HTTPApp, UAuthorization in '..\CommonUnits\UAuthorization.pas', uDataContext in '..\CommonUnits\uDataContext.pas', UFunctions in '..\CommonUnits\UFunctions.pas', uHealthy in '..\CommonUnits\uHealthy.pas', uhttpRequest in '..\CommonUnits\uhttpRequest.pas', ulog in '..\CommonUnits\ulog.pas', UApiClass in '..\CommonUnits\UApiClass.pas', UAPIJson in '..\CommonUnits\UAPIJson.pas', Uglobal in 'Uglobal.pas', uRESTObjects in '..\CommonUnits\uRESTObjects.pas', uMethod in 'uMethod.pas', SSIASDPSScript in 'SSIASDPSScript.pas', uDMC in 'uDMC.pas' {DMC: TDataModule}, synacode in 'synacode.pas', synafpc in 'synafpc.pas';const{$IFDEF LINUX} hefFlogFile = 'scad_Except_log%.txt';{$ELSE} hefFlogFile = 'C:\Temp\scad_Except_log%.txt';{$ENDIF}Function DataRequest(MS: TMemorystream): TMemorystream;var Data: tfdmemtable; stf: TfdStorageformat; command: string; q: tfdquery; c: tfdconnection; rt: tfdmemtable; sf: tstringfield; inf: tintegerfield; bf: tblobfield; dis, dfs: tdatetime; diq, dfq: tdatetime; procedure preparereturn(ContextName: String); var dbtype, server, dbname, user, password:string; begin C := TfdConnection.create(nil); getDataContext(ContextName, dbtype, server, dbname, user, password); C.ResourceOptions.SilentMode := true; C.DriverName := dbtype; C.Params.Values['Server'] := server; C.Params.Values['DataBase'] := dbname; C.Params.Values['User_name'] := user; C.Params.Values['Password'] := password;{$IFNDEF WINDOWS} with C.FormatOptions.MapRules.Add do begin SourceDataType := dtAnsiString; TargetDataType := dtWideString; end; C.FormatOptions.StrsTrim2Len := true;{$ENDIF} if ContextName <> 'AOSS' then begin C.Params.Values['User_name'] := Data.Fieldbyname('Username').asstring; C.Params.Values['Password'] := Data.Fieldbyname('Password').asstring; end; q := tfdquery.Create(nil); q.FetchOptions.Mode := fmAll; q.AutoCalcFields := false; q.Connection := c; end;begin try log('Datarequest'); dis := now; result := TMemorystream.Create; rt := tfdmemtable.Create(nil); inf := tintegerfield.Create(rt); inf.Fieldname := 'Result'; inf.DataSet := rt; inf := tintegerfield.Create(rt); inf.Fieldname := 'ServerTime'; inf.DataSet := rt; inf := tintegerfield.Create(rt); inf.Fieldname := 'Querytime'; inf.DataSet := rt; sf := tstringfield.Create(rt); sf.Fieldname := 'ResultMessage'; sf.Size := 1000; sf.DataSet := rt; bf := tblobfield.Create(rt); bf.Fieldname := 'Data'; bf.DataSet := rt; rt.Open; MS.Position := 0; Data := tfdmemtable.Create(nil); try Data.LoadFromStream(MS); // writeln('Request Size :'+ms.Size.ToString); MS.clear; except on e: Exception do begin log('error:' + e.Message); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := e.Message; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, sfjson); // sfbinary result.Position := 0; exit; end; end; if not Data.IsEmpty then begin command := uppercase(Data.Fieldbyname('ReturnType').asstring); if (command <> 'SFBINARY') and (command <> 'SFJSON') then begin log('Incorrect return type'); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := 'Return Type must SFBINARY or SFJSON'; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, sfjson); // sfbinary result.Position := 0; exit; end; if command = 'SFBINARY' then stf := sfBinary else if command = 'SFJSON' then stf := sfjson; // dis := now; log('ReturnType:' + command); command := Data.Fields[2].asstring; if command = 'GETDATA' then begin if Data.Fields[6].AsInteger > 0 then begin log('From Cache ' + Data.Fields[4].asstring); result := PrepareReuse(Data.Fields[3].asstring, Data.Fields[4].asstring, Data.Fields[6].AsInteger, Data.Fields[7].asstring, Data.Fields[8].asstring, stf); log('Direct=' + Data.Fields[5].asstring); if Data.Fields[5].asstring = '0' then begin rt.insert; rt.Fields[0].AsInteger := 1; rt.Fields[2].AsInteger := MilliSecondsBetween(diq, dfq); tblobfield(rt.Fields[4]).LoadFromStream(result); rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; end; end else begin preparereturn(Data.Fields[3].asstring); // try q.SQL.clear; q.SQL.Add(Data.Fields[4].asstring); try diq := now; c.Open; q.Open; dfq := now; log('result is open'); except on e: Exception do begin log('error:' + e.Message); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := e.Message; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Fields[2].AsInteger := MilliSecondsBetween(diq, dfq); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; exit; end; end; q.SaveToStream(result, stf); q.close; c.close; result.Position := 0; log('result size:' + result.Size.ToString); log('Direct=' + Data.Fields[5].asstring); if Data.Fields[5].asstring = '0' then begin rt.insert; rt.Fields[0].AsInteger := 1; rt.Fields[2].AsInteger := MilliSecondsBetween(diq, dfq); tblobfield(rt.Fields[4]).LoadFromStream(result); rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; end; { finally if assigned(q) then freeandnil(q); if assigned(c) then freeandnil(c); if assigned(rt) then freeandnil(rt); end; } end; end else if command = 'POSTDATA' then begin preparereturn(Data.Fields[3].asstring); log('PostData'); tblobfield(Data.Fields[5]).SaveToStream(result); result.Position := 0; q.SQL.clear; q.SQL.Add(Data.Fields[4].asstring); q.LoadFromStream(result); if q.ChangeCount > 0 then begin try diq := now; q.ApplyUpdates(0); dfq := now; rt.insert; rt.Fields[0].AsInteger := 1; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Fields[2].AsInteger := MilliSecondsBetween(diq, dfq); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; exit; except on e: Exception do begin log('error:' + e.Message); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := e.Message; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; exit; end; end; end else begin log('NoChangeCount'); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := 'NoChangeCount'; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; exit; end; end; end else begin log('NoData'); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := 'NoData'; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, sfjson); result.Position := 0; end; finally if assigned(rt) then freeandnil(rt); if assigned(MS) then freeandnil(MS); if assigned(Data) then freeandnil(Data); if assigned(c) then freeandnil(c); if assigned(q) then freeandnil(q); end; dfs := now;end;begin ReportMemoryLeaksOnShutdown := True; // ReportMemoryLeaksOnShutdown := True; wDolog := True; // SetMMLogFileName('c:\temp\log.txt');log('-------------------------------------------------------------------'); THorse.Use(compression()); // Must come before Jhonson middleware THorse.Use(Jhonson); // Log('Use Horse.HanhleException'); // THorse.Use(HandleException); THorse.Use(OctetStream); log('Initializing SDAC_DRIVER'); InitializeDataContext; appconfig := GetContext('SDAC_API'); log('Exposing:dataget'); THorse.Post('/dataget', Authorization, procedure(Req: THorseRequest; Res: THorseResponse; Next: TProc) begin var wr: twebrequest; wr := THorseHackRequest(Req).GetWebRequest; if wr.ContentLength > 0 then begin var MS: TMemorystream; var mr: TMemorystream; var LWebResponse: TWebResponse; MS := TMemorystream.Create; MS.WriteData(wr.RawContent, wr.ContentLength); MS.Seek(0, 0); mr := DataRequest(MS); LWebResponse := THorseHackResponse(Res).GetWebResponse; LWebResponse.ContentType := 'application/octet-stream'; Res.Send<Tstream>(mr).Status(thttpstatus.OK); end else begin Res.Send<TJsonObject>(TJsonObject.ParseJSONValue ('{"Return":"Incorrect data"}') as TJsonObject) .Status(thttpstatus.badrequest); end; end); log('Exposing:auth'); THorse.Get('/auth', procedure(Req: THorseRequest; Res: THorseResponse; Next: TProc) var LToken: TJWT; jso: TJsonObject; jsop: tjsonpair; AppID: String; SecureKey: String; database: string; Apass, Auser: string; rt: string; begin log('Auth'); if (Req.headers['Content-Type'] <> 'application/json') then raise Exception.Create('Content-Type is not application/json'); jso := TJsonObject.ParseJSONValue(Req.Body) as TJsonObject; for jsop in jso do begin if jsop.JsonString.Value = 'Application-Id' then AppID := jsop.JsonValue.Value else if jsop.JsonString.Value = 'Secure-Key' then SecureKey := jsop.JsonValue.Value else if jsop.JsonString.Value = 'Database' then database := jsop.JsonValue.Value else if jsop.JsonString.Value = 'Password' then Apass := jsop.JsonValue.Value else if jsop.JsonString.Value = 'UserName' then Auser := jsop.JsonValue.Value end; if (AppID = '') then raise Exception.Create('Application ID not Found.'); if (SecureKey = '') then raise Exception.Create('SecureKey not Found'); if gck(SecureKey) <> AppID then raise Exception.Create('Invalid Security Key'); LToken := TJWT.Create; LToken.Claims.Issuer := 'S.D.A.C.API_OP_APP_Build_v001'; LToken.Claims.subject := Criptografa(jso.ToString, 3); LToken.Claims.Expiration := IncMinute(now, 10); rt := TJOSE.SHA256CompactToken('@k%9ID', LToken).asstring; if rt <> '' then begin Res.Send<TJsonObject>(SetCompleteReturn(200, 'OK', rt, nil)) .Status(thttpstatus.OK); end else begin Res.Send<TJsonObject>(SetCompleteReturn(400, 'Method not resultvalue', '', nil)).Status(thttpstatus.badrequest); end; end); THorse.Listen(65200);end.Em sex., 21 de mai. de 2021 às 08:06, Vinicius Sanchez <***@***.***> escreveu:

//Código Simplificado mas fácil de olhar```delphiprogram sdacm;{$APPTYPE CONSOLE}{$R *.res}uses Horse, Horse.Jhonson, Horse.compression, Horse.OctetStream, System.JSON, System.SysUtils, System.Classes, system.DateUtils, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Phys.ODBCDef, FireDAC.Phys.ODBCBase, FireDAC.Phys.ODBC, Data.DB, FireDAC.Comp.DataSet, FireDAC.Stan.StorageJSON, FireDAC.Stan.StorageBin, FireDAC.Moni.Base, FireDAC.Moni.FlatFile, FireDAC.Stan.StorageXML, FireDAC.Comp.Client, FireDAC.Phys.MSSQLDef, FireDAC.Phys.MSSQL, FireDAC.ConsoleUI.Wait, Firedac.ConsoleUI.Script, FireDAC.Stan.Intf, Web.HTTPApp, Horse.HTTP;Function DataRequest(MS: TMemorystream): TMemorystream;var Data: tfdmemtable; stf: TfdStorageformat; command: string; q: tfdquery; c: tfdconnection; rt: tfdmemtable; sf: tstringfield; inf: tintegerfield; bf: tblobfield; dis, dfs: tdatetime; diq, dfq: tdatetime; procedure preparereturn(ContextName: String); var dbtype, server, dbname, user, password:string; begin C := TfdConnection.create(nil); C.ResourceOptions.SilentMode := true; C.DriverName := 'MSSQL'; C.Params.Values['Server'] := '172.16.128.24'; C.Params.Values['DataBase'] := 'aasi';{$IFNDEF WINDOWS} with C.FormatOptions.MapRules.Add do begin SourceDataType := dtAnsiString; TargetDataType := dtWideString; end; C.FormatOptions.StrsTrim2Len := true;{$ENDIF} C.Params.Values['User_name'] := Data.Fieldbyname('Username').asstring; C.Params.Values['Password'] := Data.Fieldbyname('Password').asstring; q := tfdquery.Create(nil); q.FetchOptions.Mode := fmAll; q.AutoCalcFields := false; q.Connection := c; end;begin try // log('Datarequest'); dis := now; result := TMemorystream.Create; rt := tfdmemtable.Create(nil); inf := tintegerfield.Create(rt); inf.Fieldname := 'Result'; inf.DataSet := rt; inf := tintegerfield.Create(rt); inf.Fieldname := 'ServerTime'; inf.DataSet := rt; inf := tintegerfield.Create(rt); inf.Fieldname := 'Querytime'; inf.DataSet := rt; sf := tstringfield.Create(rt); sf.Fieldname := 'ResultMessage'; sf.Size := 1000; sf.DataSet := rt; bf := tblobfield.Create(rt); bf.Fieldname := 'Data'; bf.DataSet := rt; rt.Open; MS.Position := 0; Data := tfdmemtable.Create(nil); try Data.LoadFromStream(MS); // writeln('Request Size :'+ms.Size.ToString); MS.clear; except on e: Exception do begin // log('error:' + e.Message); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := e.Message; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, sfjson); // sfbinary result.Position := 0; exit; end; end; if not Data.IsEmpty then begin command := uppercase(Data.Fieldbyname('ReturnType').asstring); if (command <> 'SFBINARY') and (command <> 'SFJSON') then begin // log('Incorrect return type'); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := 'Return Type must SFBINARY or SFJSON'; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, sfjson); // sfbinary result.Position := 0; exit; end; if command = 'SFBINARY' then stf := sfBinary else if command = 'SFJSON' then stf := sfjson; // dis := now; // log('ReturnType:' + command); command := Data.Fields[2].asstring; if command = 'GETDATA' then begin preparereturn(Data.Fields[3].asstring); // try q.SQL.clear; q.SQL.Add(Data.Fields[4].asstring); try diq := now; c.Open; q.Open; dfq := now; // log('result is open'); except on e: Exception do begin // log('error:' + e.Message); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := e.Message; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Fields[2].AsInteger := MilliSecondsBetween(diq, dfq); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; exit; end; end; q.SaveToStream(result, stf); q.close; c.close; result.Position := 0; // log('result size:' + result.Size.ToString); // log('Direct=' + Data.Fields[5].asstring); if Data.Fields[5].asstring = '0' then begin rt.insert; rt.Fields[0].AsInteger := 1; rt.Fields[2].AsInteger := MilliSecondsBetween(diq, dfq); tblobfield(rt.Fields[4]).LoadFromStream(result); rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; end; end else if command = 'POSTDATA' then begin preparereturn(Data.Fields[3].asstring); // log('PostData'); tblobfield(Data.Fields[5]).SaveToStream(result); result.Position := 0; q.SQL.clear; q.SQL.Add(Data.Fields[4].asstring); q.LoadFromStream(result); if q.ChangeCount > 0 then begin try diq := now; q.ApplyUpdates(0); dfq := now; rt.insert; rt.Fields[0].AsInteger := 1; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Fields[2].AsInteger := MilliSecondsBetween(diq, dfq); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; exit; except on e: Exception do begin // log('error:' + e.Message); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := e.Message; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; exit; end; end; end else begin // log('NoChangeCount'); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := 'NoChangeCount'; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, stf); result.Position := 0; exit; end; end; end else begin // log('NoData'); rt.insert; rt.Fields[0].AsInteger := 0; rt.Fields[3].asstring := 'NoData'; rt.Fields[1].AsInteger := MilliSecondsBetween(dis, now); rt.Post; result.clear; rt.SaveToStream(result, sfjson); result.Position := 0; end; finally if assigned(rt) then freeandnil(rt); if assigned(MS) then freeandnil(MS); if assigned(Data) then freeandnil(Data); if assigned(c) then freeandnil(c); if assigned(q) then freeandnil(q); end; dfs := now;end;begin { FastMM4. } ReportMemoryLeaksOnShutdown := True; THorse.Use(compression()); // Must come before Jhonson middleware THorse.Use(Jhonson); THorse.Use(OctetStream); THorse.Post('/dataget', procedure(Req: THorseRequest; Res: THorseResponse; Next: TProc) begin var wr: twebrequest; wr := THorseHackRequest(Req).GetWebRequest; if wr.ContentLength > 0 then begin var MS: TMemorystream; var mr: TMemorystream; var LWebResponse: TWebResponse; MS := TMemorystream.Create; MS.WriteData(wr.RawContent, wr.ContentLength); MS.Seek(0, 0); mr := DataRequest(MS); LWebResponse := THorseHackResponse(Res).GetWebResponse; LWebResponse.ContentType := 'application/octet-stream'; Res.Send<Tstream>(mr).Status(thttpstatus.OK); end else begin Res.Send<TJsonObject>(TJsonObject.ParseJSONValue ('{"Return":"Incorrect data"}') as TJsonObject) .Status(thttpstatus.badrequest); end; end); THorse.Listen(65200);end.```

memoryleak que deixei de propósito no oncreate do form[image: image.png]