Skip to content

Commit

Permalink
Merge pull request #332 from anderbelluno/dev
Browse files Browse the repository at this point in the history
Ajustes internos uRESTDWFphttpBase
  • Loading branch information
mobius1qwe committed May 1, 2023
2 parents c2d9e5b + 1d8f555 commit 41558d2
Showing 1 changed file with 56 additions and 16 deletions.
72 changes: 56 additions & 16 deletions CORE/Source/Sockets/Fphttp/uRESTDWFphttpBase.pas
Original file line number Diff line number Diff line change
Expand Up @@ -114,11 +114,11 @@ procedure TRESTDWFphttpServicePooler.ExecRequest(Sender: TObject;
StatusCode,
I : Integer;
vResponseHeader,
HeaderList : TStringList;
HeaderList,
CORSCustomHeaders : TStringList;
ResultStream,
ContentStringStream : TStream;
CORSCustomHeaders : TStrings;
Redirect : TRedirect;
vRedirect : TRedirect;

a : String;

Expand All @@ -134,6 +134,41 @@ procedure TRESTDWFphttpServicePooler.ExecRequest(Sender: TObject;
HeaderList.AddPair(ARequest.FieldNames[I], ARequest.FieldValues[I] );
end;

procedure SetReplyCORS;
var
i: Integer;
begin

// if ARequest.CustomHeaders then
//begin
if ARequest.CustomHeaders.Count > 0 then
begin
for i := 0 To ARequest.CustomHeaders.Count - 1 Do
vResponseHeader.AddPair(ARequest.CustomHeaders.Names[i],
ARequest.CustomHeaders.ValueFromIndex[i]);
end
else
vResponseHeader.AddPair('Access-Control-Allow-Origin', '*');

if Assigned(CORSCustomHeaders) then
begin
if CORSCustomHeaders.Count > 0 Then
begin
for i := 0 To CORSCustomHeaders.Count - 1 Do
vResponseHeader.AddPair(CORSCustomHeaders.Names[i], CORSCustomHeaders.ValueFromIndex[i]);
end;
end;

// end;
//end;
end;

procedure Redirect(Url: String);
begin
AResponse.SendRedirect(Url);
end;


begin
aUserName:= EmptyStr;
aPassword:= EmptyStr;
Expand All @@ -147,16 +182,17 @@ procedure TRESTDWFphttpServicePooler.ExecRequest(Sender: TObject;

ParseHeader;

//@vRedirect := @Redirect; { #todo -oAnderson : Verificar como funciona o Redirect. }
vContentType := ARequest.ContentType;
AuthRealm := '' ;
sCharSet := aRequest.AcceptCharset;
ErrorMessage := '';
vResponseString := '';
StatusCode := 200;

vResponseHeader := TStringList.Create;
ResultStream := TStream.Create;
CORSCustomHeaders := TStrings.Create;
vResponseHeader := TStringList.Create;
ResultStream := TStream.Create;
CORSCustomHeaders := TStringList.Create;
ContentStringStream := TStringStream.Create;
try
if CommandExec(TComponent(aRequest) , //AContext
Expand All @@ -183,13 +219,13 @@ procedure TRESTDWFphttpServicePooler.ExecRequest(Sender: TObject;
vResponseHeader , //ResponseHeaders
vResponseString , //ResponseString
ResultStream , //ResultStream
CORSCustomHeaders , //CORSCustomHeaders
Redirect //Redirect
TStrings(CORSCustomHeaders) , //CORSCustomHeaders
vRedirect //Redirect
) then
begin


//SetReplyCORS;
SetReplyCORS;
//AResponseInfo.AuthRealm := vAuthRealm;
AResponse.ContentType := vContentType;
If Encoding = esUtf8 Then
Expand All @@ -207,20 +243,23 @@ procedure TRESTDWFphttpServicePooler.ExecRequest(Sender: TObject;
Else
ResultStream := TStringStream.Create(ErrorMessage);
End;
If Assigned(ResultStream) Then

For I := 0 To vResponseHeader.Count -1 Do
AResponse.CustomHeaders.AddPair(vResponseHeader.Names [I],
vResponseHeader.Values[vResponseHeader.Names[I]]);
If vResponseHeader.Count > 0 Then
AResponse.SendHeaders;
//AResponse.WriteContent;

If Assigned(ResultStream) Then
Begin
AResponse.ContentStream := ResultStream;
AResponse.SendContent; //SendContent é necessário para devolver o conteúdo
AResponse.ContentStream := Nil;
AResponse.ContentLength := ResultStream.Size;
End;

For I := 0 To vResponseHeader.Count -1 Do
AResponse.CustomHeaders.AddPair(vResponseHeader.Names [I],
vResponseHeader.Values[vResponseHeader.Names[I]]);
If vResponseHeader.Count > 0 Then
AResponse.SendHeaders;
//AResponse.WriteContent;

end
else
begin
Expand Down Expand Up @@ -346,6 +385,7 @@ procedure TRESTDWFphttpServicePooler.SetActive(Value: boolean);
HttpAppSrv.Port:= ServicePort;
HttpAppSrv.OnRequest:= @ExecRequest;

{ #todo -oAnderson : O servidor para de responder quando o SSL é ativado. }
HttpAppSrv.UseSSL:= SSLUse;

if SSLUse and (SSLRootCertFile <> EmptyStr) then
Expand Down

0 comments on commit 41558d2

Please sign in to comment.