Consumo de memória por request. #187
Unanswered
Arlindo-koch
asked this question in
Q&A
Replies: 7 comments 5 replies
-
|
Coloca teu código aí para vermos! |
Beta Was this translation helpful? Give feedback.
0 replies
-
|
Existem muitas pessoas utilizando o Horse, e sem problemas de memória. Certamente vai ser alguma coisa que está escapando no seu código, como disse o @dliocode se você puder compartilhar seu código para ver se tem algo de errado, ou então, ativar o report memory leak no seu servidor e ver se não está tendo vazamento de memória. |
Beta Was this translation helpful? Give feedback.
0 replies
-
|
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 result
value',
'', nil)).Status(thttpstatus.badrequest);
end;
end);
THorse.Listen(65200);
end.
Em sex., 21 de mai. de 2021 às 08:06, Vinicius Sanchez <
***@***.***> escreveu:
… Existem muitas pessoas utilizando o Horse, e sem problemas de memória.
Certamente vai ser alguma coisa que está escapando no seu código, como
disse o @dliocode <https://github.com/dliocode> se você puder
compartilhar seu código para ver se tem algo de errado, ou então, ativar o
report memory leak no seu servidor e ver se não está tendo vazamento de
memória.
—
You are receiving this because you authored the thread.
Reply to this email directly, view it on GitHub
<#187 (comment)>,
or unsubscribe
<https://github.com/notifications/unsubscribe-auth/AS2EE5Y5EOR542FF2B6C5G3TOY5CHANCNFSM45I47CPQ>
.
|
Beta Was this translation helpful? Give feedback.
1 reply
-
|
Tome muito cuidado com funções que criam objetos internamente e os devolvem, pois quem recebeu o objeto terá a obrigação de destruí-lo. Isto torna extremamente complicado encontrar vazamentos de memória quando o sistema começa a crescer e tiver muitas funções como esta: Function DataRequest(MS: TMemorystream): TMemorystream; O ideal seria ter uma função que apenas preenchesse o objeto já criado, no caso ficaria algo como: Quem chamasse a função deveria fazer algo como Parece que o vazamento de memória foi criado por você. Quando criou |
Beta Was this translation helpful? Give feedback.
-
|
//Código Simplificado mas fácil de olhar
```delphi
program 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.
```
|
Beta Was this translation helpful? Give feedback.
0 replies
-
|
Eu fiz um teste bem rápido agora enviando um arquivo inválido pra ele, e não deu erro de MemoryLeak.. O que eu vou recomendar para você é: Criar uma aplicação em VCL, coloca todos os dados nele, ativa o ReportMemoryLeaksOnShutdown, faz um teste enviando apenas 1 registro; Depois de obter o retorno fecha o app da VCL e verifique se dá algum erro, caso sim, mande uma foto do erro aqui no Git. |
Beta Was this translation helpful? Give feedback.
0 replies
-
|
memoryleak que deixei de propósito no oncreate do form
[image: image.png]
…--------------------------------2021/5/21
10:46:44--------------------------------
A memory block has been leaked. The size is: 36
This block was allocated by thread 0x3590, and the stack trace (return
addresses) at the time was:
407162 [System.pas][System][@getmem$qqri][4829]
40955B [System.pas][System][TObject.NewInstance][17611]
409D5A [System.pas][System][@ClassCreate$qqrpvzc][19004]
409640 [System.pas][System][TObject.Create][17670]
589584
[Vcl.Controls.pas][Vcl.Controls][Controls.TWinControl.GetClientRect][12598]
*6FC7A8 [Unit1.pas][Unit1][TForm1.FormCreate][32]*
62E894 [Vcl.Forms.pas][Vcl.Forms][Forms.TCustomForm.GetClientRect][4391]
62DCA7 [Vcl.Forms.pas][Vcl.Forms][Forms.TCustomForm.DoCreate][3986]
62D883 [Vcl.Forms.pas][Vcl.Forms][Forms.TCustomForm.AfterConstruction][3867]
409DC8 [System.pas][System][@AfterConstruction$qqrxp14System.TObject][19053]
62D834 [Vcl.Forms.pas][Vcl.Forms][Forms.TCustomForm.Create][3857]
The block is currently used for an object of class:
System.Classes.TMemoryStream
The allocation number is: 2562
Current memory dump of 256 bytes starting at pointer address 7F8709A0:
B8 53 45 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 39
96 8C 79 80 80 80 80
80 80 80 80 80 80 80 80 00 00 00 00 01 05 87 7F 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00
E4 05 00 00 D1 71 40 00 AB E8 40 00 5A 5E 51 00 C9 1F 51 00 2B 3B 51 00 12
C6 5D 00 8E BA 5D 00
DE BE 5D 00 D0 56 5D 00 FD D0 62 00 AC D4 62 00 90 35 00 00 90 35 00 00 7E
71 40 00 6C EB 40 00
79 E7 40 00 68 B1 41 00 7D B1 41 00 5A 5E 51 00 F5 BC 5E 00 6F 96 40 00 37
D0 5D 00 49 01 59 00
40 1D 59 00 18 00 00 00 00 00 00 00 73 12 7F 86 88 CC 94 00 80 80 80 80 80
80 80 80 80 80 80 80
80 80 80 80 80 80 80 80 8C ED 80 79 80 80 80 80 80 80 80 80 80 80 80 80 00
00 00 00 51 0F 87 7F
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 D1 CE 03 00 62 71 40 00 17
E5 42 00 25 E5 42 00
¸ S E . . . . . . . . . . . . . . . . . . . . . 9
– Œ y € € € €
€ € € € € € € € . . . . . . ‡ . . . . . . . . . .
. . . . . .
ä . . . Ñ q @ . « è @ . Z ^ Q . É . Q . + ; Q . .
Æ ] . Ž º ] .
Þ ¾ ] . Ð V ] . ý Ð b . ¬ Ô b . 5 . . 5 . . ~ q
@ . l ë @ .
y ç @ . h ± A . } ± A . Z ^ Q . õ ¼ ^ . o – @ . 7
Ð ] . I . Y .
@ . Y . . . . . . . . . s . † ˆ Ì ” . € € € € € €
€ € € € € €
€ € € € € € € € Œ í € y € € € € € € € € € € € € .
. . . Q . ‡
. . . . . . . . . . . . . . . . Ñ Î . . b q @ . .
å B . % å B .
--------------------------------2021/5/21
10:46:44--------------------------------
This application has leaked memory. The small block leaks are (excluding
expected leaks registered by pointer):
21 - 36 bytes: System.Classes.TMemoryStream x 1
Note: Memory leak detail is logged to a text file in the same folder as
this application. To disable this memory leak check, undefine
"EnableMemoryLeakReporting".
program Project2;
uses
FastMM4 in '..\Componentes\FastMM4\FastMM4.pas',
Vcl.Forms,
Unit1 in 'Unit1.pas' {Form1},
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;
Application.CreateForm(TForm1, Form1);
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);
Application.Run;
end.
Em sex., 21 de mai. de 2021 às 10:25, Danilo Lucas ***@***.***>
escreveu:
Eu fiz um teste bem rápido agora enviando um arquivo inválido pra ele, e
não deu erro de MemoryLeak..
O que eu vou recomendar para você é:
Criar uma aplicação em VCL, coloca todos os dados nele, ativa o
ReportMemoryLeaksOnShutdown, faz um teste enviando apenas 1 registro;
Depois de obter o retorno fecha o app da VCL e verifique se dá algum erro,
caso sim, mande uma foto do erro aqui no Git.
—
You are receiving this because you authored the thread.
Reply to this email directly, view it on GitHub
<#187 (comment)>,
or unsubscribe
<https://github.com/notifications/unsubscribe-auth/AS2EE54XVLXYC2AEWSHVKN3TOZNOLANCNFSM45I47CPQ>
.
|
Beta Was this translation helpful? Give feedback.
4 replies
-
|
|
Beta Was this translation helpful? Give feedback.
-
|
Ao Abrir o Server carrega pouca memória. |
Beta Was this translation helpful? Give feedback.
-
|
Calculei aproximadamente 4 mb por cliente conectado, que ao meu ver, se não tem cliente usando deveriam ser devolvidos ao SO. |
Beta Was this translation helpful? Give feedback.
-
|
Caso alguém puder me ajudar. posso abrir um zoom ou skype para compartilhar meu pc e ver de perto o abacaxi. |
Beta Was this translation helpful? Give feedback.
-
|
Tive um problema parecido mas foi erro meu, eu tinha uma função que retornava um JSONARRAY nessa função eu criava um objeto (não era necessário) resolvi apenas com um Result := query.ToJsonnarray; |
Beta Was this translation helpful? Give feedback.
0 replies
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
-
Ola. Fiz um simples servidor usando o Horse para retornar um json de dados. porem o servidor não libera memória para o SO
conforme vão solicitando dados o servidor não libera memória. assim sempre aumenta o consumo.
chega uma hora que o app do servidor da problemas.
temos alguma coisa para fazer para liberar a memória.
além de claro destruir os objetos criados em runtime?
Beta Was this translation helpful? Give feedback.
All reactions