Merge pull request #333 from anderbelluno/dev

Ajuste na uRESTDWBasic e uRESTDWFphttpBase
OpenSourceCommunityBrasil · May 1, 2023 · b50e09e · b50e09e
2 parents 41558d2 + ab90d06
commit b50e09e
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 5 deletions.
diff --git a/CORE/Source/Basic/uRESTDWBasic.pas b/CORE/Source/Basic/uRESTDWBasic.pas
@@ -3045,10 +3045,19 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions);
  If vDefaultPage.Count > 0 Then
  vReplyString := vDefaultPage.Text
  Else
- vReplyString := TServerStatusHTML;
- vErrorCode := 200;
- ContentType := 'text/html';
- End
+ if vErrorMessage <> EmptyStr then
+ begin
+ vReplyString := vErrorMessage;
+ vErrorCode := 401;
+ ContentType := 'text/html';
+ end
+ else
+ begin
+ vReplyString := TServerStatusHTML;
+ vErrorCode := 200;
+ ContentType := 'text/html';
+ End
+ end
  Else
  Begin
  If vEncoding = esUtf8 Then

diff --git a/CORE/Source/Sockets/Fphttp/uRESTDWFphttpBase.pas b/CORE/Source/Sockets/Fphttp/uRESTDWFphttpBase.pas
@@ -128,10 +128,39 @@ procedure TRESTDWFphttpServicePooler.ExecRequest(Sender: TObject;
  procedure ParseHeader;
  var
  I: Integer;
- begin
+ s: string;
+ sl: TStringList;
+
+ begin
+ sl := nil;
+
  HeaderList.NameValueSeparator:= ':';
  for I := 0 to Pred(ARequest.FieldCount) do
  HeaderList.AddPair(ARequest.FieldNames[I], ARequest.FieldValues[I] );
+
+ for I := 0 to Pred(ARequest.CustomHeaders.Count) do
+ HeaderList.AddPair(ARequest.CustomHeaders.Names[I], ARequest.CustomHeaders.ValueFromIndex[I] );
+
+ s := ARequest.GetHTTPVariable(hvURL);
+ sl := TStringList.Create;
+ try
+ if (Pos('?', s) > 0)then
+ begin
+ s := StringReplace(s, '?', '', [rfReplaceAll]);
+ s := StringReplace(s, '/', '', []);
+ sl.Delimiter := '&';
+ sl.StrictDelimiter := True;
+ sl.DelimitedText := s;
+ for i := 0 to sl.Count - 1 do
+ begin
+ s := sl[i];
+ if Pos('=', s) > 0 then
+ HeaderList.AddPair(Copy(s, 1, Pos('=', s) - 1) , Copy(s, Pos('=', s) + 1, Length(s) - Pos('=', s)));
+ end;
+ end;
+ finally
+ FreeAndNil(sl);
+ end;
  end;
 
  procedure SetReplyCORS;